module Test.LegalHold where
import API.Brig
import API.BrigCommon as BrigC
import qualified API.BrigInternal as BrigI
import API.Common
import API.Galley
import API.GalleyInternal
import Control.Error (MaybeT (MaybeT), runMaybeT)
import Control.Lens ((.~), (^?), (^?!))
import Control.Monad.Reader (asks, local)
import Control.Monad.Trans.Class (lift)
import Data.Aeson.Lens
import qualified Data.ByteString.Char8 as BS8
import Data.ByteString.Lazy (LazyByteString)
import Data.List.Extra (trim)
import qualified Data.Map as Map
import qualified Data.ProtoLens as Proto
import Data.ProtoLens.Labels ()
import qualified Data.Set as Set
import qualified Data.Text as T
import GHC.Stack
import MLS.Util
import Network.Wai (Request (pathInfo, requestMethod))
import Notifications
import Numeric.Lens (hex)
import qualified Proto.Otr as Proto
import qualified Proto.Otr_Fields as Proto
import SetupHelpers
import Testlib.MockIntegrationService
import Testlib.Prekeys
import Testlib.Prelude
import UnliftIO (Chan, readChan, timeout)
testLHPreventAddingNonConsentingUsers :: (HasCallStack) => LhApiVersion -> App ()
testLHPreventAddingNonConsentingUsers :: HasCallStack => LhApiVersion -> App ()
testLHPreventAddingNonConsentingUsers LhApiVersion
v = do
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
(Value
owner, String
tid, [Value
alice, Value
alex]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value
george <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
Value
georgeQId <- Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
george
Value
hannes <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
Value
hannesQId <- Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
hannes
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
george, Value
hannes]
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alex, Value
george, Value
hannes]
Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [alex], team = Just tid}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george]
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
alex App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george]
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alex Value
conv AddMembers
forall a. Default a => a
def {users = [hannesQId]} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george, Value
hannes]
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
alex String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex]
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alex Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"not-connected"
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
where
checkConvHasOtherMembers :: (HasCallStack) => Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers :: HasCallStack => Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
u [Value]
us =
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
u Value
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
[Value]
mems <-
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others"
App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse \Value
m -> do
Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
[Value]
mems [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
us (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
testLHGetAndUpdateSettings :: (HasCallStack) => ImplicitConsent -> LhApiVersion -> App ()
testLHGetAndUpdateSettings :: HasCallStack => ImplicitConsent -> LhApiVersion -> App ()
testLHGetAndUpdateSettings ImplicitConsent
implicitConsent LhApiVersion
v = ImplicitConsent -> (String -> App ()) -> App ()
ensureLHFeatureConfigForServer ImplicitConsent
implicitConsent ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
dom -> do
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
(Value
owner, String
tid, [Value
alice]) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
dom Int
2
Value
stranger <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dom CreateUser
forall a. Default a => a
def
let getSettingsWorks :: (HasCallStack) => Value -> String -> App ()
getSettingsWorks :: HasCallStack => Value -> String -> App ()
getSettingsWorks Value
target String
status = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid Value
target) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status
getSettingsFails :: (HasCallStack) => Value -> App ()
getSettingsFails :: HasCallStack => Value -> App ()
getSettingsFails Value
target = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid Value
target) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-team-member"
HasCallStack => Value -> App ()
Value -> App ()
getSettingsFails Value
stranger
HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
owner String
"disabled"
HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
alice String
"disabled"
case ImplicitConsent
implicitConsent of
ImplicitConsent
ImplicitConsent -> do
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
ImplicitConsent
ExplicitConsent -> do
let payload :: Value
payload = [Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"]
String -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
API.GalleyInternal.setTeamFeatureConfig String
dom String
tid String
"legalhold" Value
payload App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
HasCallStack => Value -> App ()
Value -> App ()
getSettingsFails Value
stranger
HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
owner String
"not_configured"
HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
alice String
"not_configured"
let lhSettings :: Value
lhSettings = (String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner Value
lhSettings) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid Value
alice) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
App Value -> String -> App ()
forall a. (HasCallStack, MakesValue a) => a -> String -> App ()
assertFieldMissing Response
resp.json String
"label"
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"auth_token") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"auth_token")
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"base_url") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"base_url")
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_key" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString App String -> (String -> String) -> App String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> String
trim)
App String -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_key")
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"fingerprint" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString App String -> (String -> Int) -> App Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
App Int -> Int -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` (Int
0 :: Int)
testLHMessageExchange ::
(HasCallStack) =>
TaggedBool "clients1New" ->
TaggedBool "clients2New" ->
App ()
testLHMessageExchange :: HasCallStack =>
TaggedBool "clients1New" -> TaggedBool "clients2New" -> App ()
testLHMessageExchange (TaggedBool Bool
clients1New) (TaggedBool Bool
clients2New) = do
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
(Value
owner, String
tid, [Value
mem1, Value
mem2]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
let clientSettings :: Bool -> AddClient
clientSettings :: Bool -> AddClient
clientSettings Bool
allnew =
if Bool
allnew
then AddClient
forall a. Default a => a
def {acapabilities = Just ["legalhold-implicit-consent"]}
else AddClient
forall a. Default a => a
def {acapabilities = Nothing}
App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ App Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient (Value
mem1 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (Bool -> AddClient
clientSettings Bool
clients1New) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ App Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient (Value
mem2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (Bool -> AddClient
clientSettings Bool
clients2New) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
mem1 (CreateConv
defProteus {qualifiedUsers = [mem2], team = Just tid}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
let getClients :: Value -> App [Value]
getClients :: Value -> App [Value]
getClients Value
mem = do
Response
res <- Value -> Domain -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
getClientsQualified Value
mem Domain
OwnDomain Value
mem
Value
val <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
res
Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Value
val
assertMessageSendingWorks :: (HasCallStack) => App ()
assertMessageSendingWorks :: HasCallStack => App ()
assertMessageSendingWorks = do
[Value]
clients1 <- Value -> App [Value]
getClients Value
mem1
[Value]
clients2 <- Value -> App [Value]
getClients Value
mem2
[String]
clientIds1 <- (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId [Value]
clients1
[String]
clientIds2 <- (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId [Value]
clients2
QualifiedUserEntry
proteusRecipients <- Value -> [(Value, [String])] -> String -> App QualifiedUserEntry
forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients Value
mem1 [(Value
mem1, [String]
clientIds1), (Value
mem2, [String]
clientIds2)] String
"hey there"
let proteusMsg :: String -> QualifiedNewOtrMessage
proteusMsg String
senderClient =
forall msg. Message msg => msg
Proto.defMessage @Proto.QualifiedNewOtrMessage
QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& (ClientId -> Identity ClientId)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage
#sender ((ClientId -> Identity ClientId)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> ((Word64 -> Identity Word64) -> ClientId -> Identity ClientId)
-> (Word64 -> Identity Word64)
-> QualifiedNewOtrMessage
-> Identity QualifiedNewOtrMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64) -> ClientId -> Identity ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.client ((Word64 -> Identity Word64)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> Word64 -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
senderClient String -> Getting (Endo Word64) String Word64 -> Word64
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Word64) String Word64
forall a. Integral a => Prism' String a
Prism' String Word64
hex)
QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
QualifiedNewOtrMessage
QualifiedNewOtrMessage
[QualifiedUserEntry]
[QualifiedUserEntry]
#recipients ASetter
QualifiedNewOtrMessage
QualifiedNewOtrMessage
[QualifiedUserEntry]
[QualifiedUserEntry]
-> [QualifiedUserEntry]
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [QualifiedUserEntry
proteusRecipients]
QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
QualifiedNewOtrMessage
QualifiedNewOtrMessage
ClientMismatchStrategy'ReportAll
ClientMismatchStrategy'ReportAll
#reportAll ASetter
QualifiedNewOtrMessage
QualifiedNewOtrMessage
ClientMismatchStrategy'ReportAll
ClientMismatchStrategy'ReportAll
-> ClientMismatchStrategy'ReportAll
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientMismatchStrategy'ReportAll
forall msg. Message msg => msg
Proto.defMessage
sender :: [s] -> String
sender [s]
clients =
let senderClient :: s
senderClient = [s] -> s
forall a. HasCallStack => [a] -> a
head ([s] -> s) -> [s] -> s
forall a b. (a -> b) -> a -> b
$ (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\s
c -> s
c s -> Getting (First Value) s Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key (String -> Key
forall a. IsString a => String -> a
fromString String
"type") Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value -> Maybe Value
forall a. a -> Maybe a
Just (String -> Value
forall a. ToJSON a => a -> Value
toJSON String
"legalhold")) [s]
clients
in Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ s
senderClient s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key (String -> Key
forall a. IsString a => String -> a
fromString String
"id") ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String
Value -> App Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
mem1 (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (String -> QualifiedNewOtrMessage
proteusMsg ([Value] -> String
forall {s}. AsValue s => [s] -> String
sender [Value]
clients1)) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
Value -> App Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
mem2 (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (String -> QualifiedNewOtrMessage
proteusMsg ([Value] -> String
forall {s}. AsValue s => [s] -> String
sender [Value]
clients2)) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
App ()
HasCallStack => App ()
assertMessageSendingWorks
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
mem1 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
App ()
HasCallStack => App ()
assertMessageSendingWorks
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
mem2 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
App ()
HasCallStack => App ()
assertMessageSendingWorks
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
mem1 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
([Value] -> Int) -> App [Value] -> App Int
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value -> App [Value]
getClients Value
mem1) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
App ()
HasCallStack => App ()
assertMessageSendingWorks
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
mem2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
([Value] -> Int) -> App [Value] -> App Int
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value -> App [Value]
getClients Value
mem2) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
App ()
HasCallStack => App ()
assertMessageSendingWorks
data TestClaimKeys
= TCKConsentMissing
| TCKConsentAndNewClients
deriving (Int -> TestClaimKeys -> String -> String
[TestClaimKeys] -> String -> String
TestClaimKeys -> String
(Int -> TestClaimKeys -> String -> String)
-> (TestClaimKeys -> String)
-> ([TestClaimKeys] -> String -> String)
-> Show TestClaimKeys
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestClaimKeys -> String -> String
showsPrec :: Int -> TestClaimKeys -> String -> String
$cshow :: TestClaimKeys -> String
show :: TestClaimKeys -> String
$cshowList :: [TestClaimKeys] -> String -> String
showList :: [TestClaimKeys] -> String -> String
Show, (forall x. TestClaimKeys -> Rep TestClaimKeys x)
-> (forall x. Rep TestClaimKeys x -> TestClaimKeys)
-> Generic TestClaimKeys
forall x. Rep TestClaimKeys x -> TestClaimKeys
forall x. TestClaimKeys -> Rep TestClaimKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestClaimKeys -> Rep TestClaimKeys x
from :: forall x. TestClaimKeys -> Rep TestClaimKeys x
$cto :: forall x. Rep TestClaimKeys x -> TestClaimKeys
to :: forall x. Rep TestClaimKeys x -> TestClaimKeys
Generic)
data LHApprovedOrPending
= LHApproved
| LHPending
deriving (Int -> LHApprovedOrPending -> String -> String
[LHApprovedOrPending] -> String -> String
LHApprovedOrPending -> String
(Int -> LHApprovedOrPending -> String -> String)
-> (LHApprovedOrPending -> String)
-> ([LHApprovedOrPending] -> String -> String)
-> Show LHApprovedOrPending
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LHApprovedOrPending -> String -> String
showsPrec :: Int -> LHApprovedOrPending -> String -> String
$cshow :: LHApprovedOrPending -> String
show :: LHApprovedOrPending -> String
$cshowList :: [LHApprovedOrPending] -> String -> String
showList :: [LHApprovedOrPending] -> String -> String
Show, (forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x)
-> (forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending)
-> Generic LHApprovedOrPending
forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
from :: forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
$cto :: forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
to :: forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
Generic)
testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App ()
testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App ()
testLHClaimKeys LHApprovedOrPending
approvedOrPending TestClaimKeys
testmode = do
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
(Value
lowner, String
ltid, [Value
lmem]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
(Value
powner, String
ptid, [Value
pmem]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
ltid Value
lowner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
ltid Value
lowner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
ltid Value
lowner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
ltid Value
lowner Value
lmem App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
ltid (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let addc :: Maybe [String] -> App ()
addc Maybe [String]
caps = Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
pmem (Maybe [String] -> AddClient
settings Maybe [String]
caps) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
settings :: Maybe [String] -> AddClient
settings Maybe [String]
caps =
AddClient
forall a. Default a => a
def
{ prekeys = Just $ take 10 somePrekeysRendered,
lastPrekey = Just $ head someLastPrekeysRendered,
acapabilities = caps
}
in Maybe [String] -> App ()
addc (Maybe [String] -> App ()) -> Maybe [String] -> App ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"legalhold-implicit-consent"]
case TestClaimKeys
testmode of
TestClaimKeys
TCKConsentMissing -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TestClaimKeys
TCKConsentAndNewClients -> do
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
ptid Value
powner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
ptid Value
powner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
[String]
llhdevs :: [String] <- do
let getCls :: Value -> App [String]
getCls :: Value -> App [String]
getCls Value
mem = do
Response
res <- Value -> Domain -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
getClientsQualified Value
mem Domain
OwnDomain Value
mem
Value
val <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
res
[Value]
cls <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Value
val
Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [Value]
cls
Value -> App [String]
getCls Value
lmem
let assertResp :: (HasCallStack) => Response -> App ()
assertResp :: HasCallStack => Response -> App ()
assertResp Response
resp = case (TestClaimKeys
testmode, [String]
llhdevs) of
(TestClaimKeys
TCKConsentMissing, (String
_ : [String]
_)) -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"missing-legalhold-consent"
(TestClaimKeys
TCKConsentAndNewClients, (String
_ : [String]
_)) -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(TestClaimKeys
_, []) -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUsersPrekeyBundle Value
pmem (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")) HasCallStack => Response -> App ()
Response -> App ()
assertResp
case [String]
llhdevs of
[String
llhdev] ->
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
getUsersPrekeysClient Value
pmem (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
llhdev) HasCallStack => Response -> App ()
Response -> App ()
assertResp
[] ->
() -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
bad :: [String]
bad@(String
_ : String
_ : [String]
_) ->
String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"impossible -- more than one LH device: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
bad)
String
slmemdom <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.domain"
String
slmemid <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id"
let userClients :: Map String (Map String (Set String))
userClients = [(String, Map String (Set String))]
-> Map String (Map String (Set String))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
slmemdom, [(String, Set String)] -> Map String (Set String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
slmemid, [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
llhdevs)])]
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Map String (Map String (Set String)) -> App Response
forall caller userClients.
(HasCallStack, MakesValue caller, ToJSON userClients) =>
caller -> userClients -> App Response
getMultiUserPrekeyBundle Value
pmem Map String (Map String (Set String))
userClients) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Response -> App ()
Response -> App ()
assertResp
testLHAddClientManually :: App ()
testLHAddClientManually :: App ()
testLHAddClientManually = do
(Value
_owner, String
_tid, [Value
mem1]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
mem1 AddClient
forall a. Default a => a
def {ctype = "legalhold"}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
400 String
"client-error" Response
resp
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"LegalHold clients cannot be added manually. LegalHold must be enabled on this user by an admin"
testLHDeleteClientManually :: App ()
testLHDeleteClientManually :: App ()
testLHDeleteClientManually = do
(Value
_owner, String
_tid, [Value
mem1]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String
cid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
BrigI.addClient Value
mem1 AddClient
forall a. Default a => a
def {ctype = "legalhold"}) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value -> App String) -> App Value -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteClient Value
mem1 String
cid) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"client-error"
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"LegalHold clients cannot be deleted. LegalHold must be disabled on this user by an admin"
testLHRequestDevice :: LhApiVersion -> App ()
testLHRequestDevice :: LhApiVersion -> App ()
testLHRequestDevice LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
let reqNotEnabled :: Value -> Value -> App ()
reqNotEnabled Value
requester Value
requestee =
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
requester Value
requestee
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"legalhold-not-enabled"
Value -> Value -> App ()
reqNotEnabled Value
alice Value
bob
Value
lpk <- App Value
getLastPrekey
[Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
let statusShouldBe :: String -> App ()
statusShouldBe :: String -> App ()
statusShouldBe String
status =
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
requester -> do
Value -> Value -> App ()
reqNotEnabled Value
requester Value
bob
String -> App ()
statusShouldBe String
"no_consent"
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> App ()
statusShouldBe String
"disabled"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> App ()
statusShouldBe String
"pending"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
204
String -> App ()
statusShouldBe String
"pending"
[String
bobc1, String
bobc2] <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
[String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String
bobc1, String
bobc2] \String
client ->
Value -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotificationClient Value
bob String
client Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdRequestNotif App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
notif -> do
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
checkChan :: (HasCallStack) => Chan t -> (t -> App (Maybe a)) -> App a
checkChan :: forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan t
chan t -> App (Maybe a)
match = do
Int
tSecs <- (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Int -> Int) -> (Env -> Int) -> Env -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Int
timeOutSeconds)
App a -> (a -> App a) -> Maybe a -> App a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App a
forall a. HasCallStack => String -> App a
assertFailure String
"checkChan: timed out") a -> App a
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> App a) -> App (Maybe a) -> App a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> App a -> App (Maybe a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
tSecs do
let go :: App a
go = Chan t -> App t
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan t
chan App t -> (t -> App (Maybe a)) -> App (Maybe a)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> App (Maybe a)
match App (Maybe a) -> (Maybe a -> App a) -> App a
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App a -> (a -> App a) -> Maybe a -> App a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe App a
go a -> App a
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
App a
go
checkChanVal :: (HasCallStack) => Chan (t, LazyByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal :: forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (t, ByteString)
chan Value -> MaybeT App a
match = Chan (t, ByteString) -> ((t, ByteString) -> App (Maybe a)) -> App a
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (t, ByteString)
chan \(t
_, ByteString
bs) -> MaybeT App a -> App (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
App (Maybe Value) -> MaybeT App Value
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Value -> App (Maybe Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bs)) MaybeT App Value -> (Value -> MaybeT App a) -> MaybeT App a
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> MaybeT App a
match
testLHApproveDevice :: App ()
testLHApproveDevice :: App ()
testLHApproveDevice = do
(Value
alice, String
tid, [Value
bob, Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
Value
ollie <- do
Value
o <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
o Value
alice
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
o
Value
sandy <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
412 String
"legalhold-not-pending"
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
let uidsAndTidMatch :: Value -> MaybeT App ()
uidsAndTidMatch Value
val = do
String
actualTid <-
Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
val String
"team_id"
MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
String
actualUid <-
Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
val String
"user_id"
MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
String
bobUid <- App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App String -> MaybeT App String)
-> App String -> MaybeT App String
forall a b. (a -> b) -> a -> b
$ Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
Bool -> MaybeT App () -> MaybeT App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((String
actualTid, String
actualUid) (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
tid, String
bobUid)) do
MaybeT App ()
forall a. MaybeT App a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Chan (Request, ByteString) -> (Value -> MaybeT App ()) -> App ()
forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (Request, ByteString)
chan Value -> MaybeT App ()
uidsAndTidMatch
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
approveLegalHoldDevice' String
tid Value
alice Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
"wrong-password"
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
let matchAuthToken :: a -> MaybeT App String
matchAuthToken a
val =
a -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM a
val String
"refresh_token"
MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
Chan (Request, ByteString)
-> (Value -> MaybeT App String) -> App String
forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (Request, ByteString)
chan Value -> MaybeT App String
forall {a}. MakesValue a => a -> MaybeT App String
matchAuthToken
App String -> (String -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> String -> App Response
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> App Response
renewToken Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String
lhdId <- Value -> App String
forall user. MakesValue user => user -> App String
lhDeviceIdOf Value
bob
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
lhdId
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
App [String] -> ([String] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> App ()) -> [String] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \String
client ->
Value -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotificationClient Value
bob String
client Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientAddNotif App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
notif -> do
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.class" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
charlie] \Value
user -> do
Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
user Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdEnabledNotif App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
notif -> do
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
ollie, Value
sandy] \Value
outsider -> do
String
outsiderClient <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
outsider AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
Value -> String -> Maybe String -> (Value -> App Bool) -> App ()
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> Maybe String -> (Value -> App Bool) -> App ()
assertNoNotifications Value
outsider String
outsiderClient Maybe String
forall a. Maybe a
Nothing Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdEnabledNotif
testLHGetDeviceStatus :: LhApiVersion -> App ()
testLHGetDeviceStatus :: LhApiVersion -> App ()
testLHGetDeviceStatus LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
user -> do
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
user App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no_consent"
Value
lpk <- App Value
getLastPrekey
[Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer
MockServerSettings
forall a. Default a => a
def
do LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}
\(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"last_prekey"
App (Maybe Value) -> (Maybe Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Value -> App ()
forall a. HasCallStack => Maybe a -> App ()
assertNothing
MaybeT App Value -> App (Maybe Value)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (App Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Response
resp.json String
"client" MaybeT App Value -> (Value -> MaybeT App Value) -> MaybeT App Value
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> MaybeT App Value)
-> String -> Value -> MaybeT App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM String
"id")
App (Maybe Value) -> (Maybe Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Value -> App ()
forall a. HasCallStack => Maybe a -> App ()
assertNothing
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String
lhdId <- Value -> App String
forall user. MakesValue user => user -> App String
lhDeviceIdOf Value
bob
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
lhdId
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"legalhold-already-enabled"
setTimeoutTo :: Int -> Env -> Env
setTimeoutTo :: Int -> Env -> Env
setTimeoutTo Int
tSecs Env
env = Env
env {timeOutSeconds = tSecs}
testLHDisableForUser :: App ()
testLHDisableForUser :: App ()
testLHDisableForUser = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
String -> Value -> Value -> (String, Int) -> App ()
forall tid owner uid.
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid -> owner -> uid -> (String, Int) -> App ()
setUpLHDevice String
tid Value
alice Value
bob (String, Int)
lhDomAndPort
Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientAddNotif App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
notif -> do
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.class" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
bob Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"operation-denied"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
"fix ((\"the password always is \" <>) . show)"
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Bool -> MaybeT App () -> MaybeT App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
do
ByteString -> String
BS8.unpack Request
req.requestMethod
String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"POST"
Bool -> Bool -> Bool
&& Request
req.pathInfo
[Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"remove"])
MaybeT App ()
forall a. MaybeT App a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ (Env -> Env) -> App Value -> App Value
forall a. (Env -> Env) -> App a -> App a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Int -> Env -> Env
setTimeoutTo Int
90) do
Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientRemoveNotif
App Value -> App Value -> App Value
forall a b. App a -> App b -> App b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdDisabledNotif
String
bobId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
[Value]
lhClients <-
Value -> [String] -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
BrigI.getClientsFull Value
bob [String
bobId] App Response -> (Response -> App [Value]) -> App [Value]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
bobId
App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
App [Value] -> ([Value] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM \Value
val -> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"legalhold") (String -> Bool) -> App String -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
val Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
[Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty [Value]
lhClients
testLHEnablePerTeam :: LhApiVersion -> App ()
testLHEnablePerTeam :: LhApiVersion -> App ()
testLHEnablePerTeam LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
legalholdIsEnabled String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unlocked"
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> (String, Int) -> App ()
forall tid owner uid.
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid -> owner -> uid -> (String, Int) -> App ()
setUpLHDevice String
tid Value
alice Value
bob (String, Int)
lhDomAndPort
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
putLegalholdStatus String
tid Value
alice String
"disabled"
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"legalhold-whitelisted-only"
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
testLHGetMembersIncludesStatus :: LhApiVersion -> App ()
testLHGetMembersIncludesStatus :: LhApiVersion -> App ()
testLHGetMembersIncludesStatus LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
let statusShouldBe :: String -> App ()
statusShouldBe :: String -> App ()
statusShouldBe String
status = do
Value -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeamMembers Value
alice String
tid App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
[Value
bobMember] <-
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members"
App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM \Value
u -> do
String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> App String -> App (String -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user") App (String -> Bool) -> App String -> App Bool
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
Value
bobMember Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status
String -> App ()
statusShouldBe String
"no_consent"
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> App ()
statusShouldBe String
"no_consent"
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> App ()
statusShouldBe String
"disabled"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> App ()
statusShouldBe String
"pending"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> App ()
statusShouldBe String
"enabled"
testLHConnectionsWithNonConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithNonConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithNonConsentingUsers LhApiVersion
v = do
(Value
alice, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
Value
carl <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
Value
dee <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
Value
bobConvId <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
dee Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
Value
deeConvId <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
dee App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
alice String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
bob String
"missing-legalhold-consent"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
bob Value
alice String
"missing-legalhold-consent"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
bobConvId
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
dee String
"missing-legalhold-consent"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
dee Value
alice String
"missing-legalhold-consent"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
dee Value
deeConvId
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
carl Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
carl
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
alice String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
bob String
"accepted"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
bob Value
alice String
"accepted"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
bobConvId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
dee String
"pending"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
dee Value
alice String
"sent"
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
dee Value
deeConvId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
testLHConnectionsWithConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithConsentingUsers LhApiVersion
v = do
(Value
alice, String
teamA, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
(Value
bob, String
teamB, [Value
barbara]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
teamA Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
teamB Value
bob
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
teamA Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
teamA Value
alice Value
alice
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
teamA Value
alice String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
bob Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"accepted"
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
barbara
data GroupConvAdmin
= LegalholderIsAdmin
| PeerIsAdmin
| BothAreAdmins
deriving (Int -> GroupConvAdmin -> String -> String
[GroupConvAdmin] -> String -> String
GroupConvAdmin -> String
(Int -> GroupConvAdmin -> String -> String)
-> (GroupConvAdmin -> String)
-> ([GroupConvAdmin] -> String -> String)
-> Show GroupConvAdmin
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GroupConvAdmin -> String -> String
showsPrec :: Int -> GroupConvAdmin -> String -> String
$cshow :: GroupConvAdmin -> String
show :: GroupConvAdmin -> String
$cshowList :: [GroupConvAdmin] -> String -> String
showList :: [GroupConvAdmin] -> String -> String
Show, (forall x. GroupConvAdmin -> Rep GroupConvAdmin x)
-> (forall x. Rep GroupConvAdmin x -> GroupConvAdmin)
-> Generic GroupConvAdmin
forall x. Rep GroupConvAdmin x -> GroupConvAdmin
forall x. GroupConvAdmin -> Rep GroupConvAdmin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupConvAdmin -> Rep GroupConvAdmin x
from :: forall x. GroupConvAdmin -> Rep GroupConvAdmin x
$cto :: forall x. Rep GroupConvAdmin x -> GroupConvAdmin
to :: forall x. Rep GroupConvAdmin x -> GroupConvAdmin
Generic)
testLHNoConsentRemoveFromGroup :: LHApprovedOrPending -> GroupConvAdmin -> App ()
testLHNoConsentRemoveFromGroup :: LHApprovedOrPending -> GroupConvAdmin -> App ()
testLHNoConsentRemoveFromGroup LHApprovedOrPending
approvedOrPending GroupConvAdmin
admin = do
(Value
alice, String
tidAlice, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
(Value
bob, String
tidBob, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidAlice Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidAlice Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
[Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] \[WebSocket
aws, WebSocket
bws] -> do
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
(Value
convId, Value
qConvId) <- do
let (Value
inviter, String
tidInviter, Value
invitee, String
inviteeRole) = case GroupConvAdmin
admin of
GroupConvAdmin
LegalholderIsAdmin -> (Value
alice, String
tidAlice, Value
bob, String
"wire_member")
GroupConvAdmin
BothAreAdmins -> (Value
alice, String
tidAlice, Value
bob, String
"wire_admin")
GroupConvAdmin
PeerIsAdmin -> (Value
bob, String
tidBob, Value
alice, String
"wire_member")
let createConv :: CreateConv
createConv = CreateConv
defProteus {qualifiedUsers = [invitee], newUsersRole = inviteeRole, team = Just tidInviter}
Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
inviter CreateConv
createConv App Response
-> (Response -> App (Value, Value)) -> App (Value, Value)
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` case GroupConvAdmin
admin of
GroupConvAdmin
BothAreAdmins -> String
"wire_admin"
GroupConvAdmin
PeerIsAdmin -> String
"wire_member"
GroupConvAdmin
LegalholderIsAdmin -> String
"wire_member"
(,) (Value -> Value -> (Value, Value))
-> App Value -> App (Value -> (Value, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App (Value -> (Value, Value)) -> App Value -> App (Value, Value)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
[WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] \WebSocket
ws -> do
HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvCreateNotifNotSelf WebSocket
ws App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
pl -> Value
pl Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.conversation" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
convId
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
user ->
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
user Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidAlice Value
alice Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidAlice Value
alice String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidAlice Value
alice Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> String
"enabled"
LHApprovedOrPending
LHPending -> String
"pending"
case GroupConvAdmin
admin of
GroupConvAdmin
LegalholderIsAdmin -> do
case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
bob)
LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
GroupConvAdmin
PeerIsAdmin -> do
case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
alice)
LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
GroupConvAdmin
BothAreAdmins -> do
case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
bob)
LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= case LHApprovedOrPending
approvedOrPending of
LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
testLHHappyFlow :: LhApiVersion -> App ()
testLHHappyFlow :: LhApiVersion -> App ()
testLHHappyFlow LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
let statusShouldBe :: String -> App ()
statusShouldBe :: String -> App ()
statusShouldBe String
status =
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value
lpk <- App Value
getLastPrekey
[Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> App ()
statusShouldBe String
"disabled"
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> App ()
statusShouldBe String
"disabled"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
bob Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"operation-denied"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> App ()
statusShouldBe String
"pending"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
approveLegalHoldDevice' String
tid Value
alice Value
bob String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Value
_ <-
Response
resp.json
App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
`lookupField` String
"client.id"
App (Maybe Value) -> (Maybe Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"client id is present"
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk
testLHGetStatus :: LhApiVersion -> App ()
testLHGetStatus :: LhApiVersion -> App ()
testLHGetStatus LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
(Value
charlie, String
_tidCharlie, [Value
debora]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
Value
emil <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let check :: (HasCallStack) => (MakesValue getter, MakesValue target) => getter -> target -> String -> App ()
check :: forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check getter
getter target
target String
status = do
Value
profile <- getter -> target -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser getter
getter target
target App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
String
status String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
pStatus
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob, Value
charlie, Value
debora, Value
emil] \Value
u -> do
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
bob String
"no_consent"
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
emil String
"no_consent"
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob, Value
charlie, Value
debora, Value
emil] \Value
u -> do
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
bob String
"disabled"
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
debora Value
bob String
"pending"
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
debora Value
bob String
"enabled"
testLHCannotCreateGroupWithUsersInConflict :: LhApiVersion -> App ()
testLHCannotCreateGroupWithUsersInConflict :: LhApiVersion -> App ()
testLHCannotCreateGroupWithUsersInConflict LhApiVersion
v = do
(Value
alice, String
tidAlice, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
(Value
charlie, String
_tidCharlie, [Value
debora]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidAlice Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bob Value
charlie
Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bob Value
debora
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidAlice Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bob CreateConv
defProteus {qualifiedUsers = [charlie, alice], newUsersRole = "wire_member", team = Just tidAlice}
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidAlice Value
alice Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidAlice Value
alice String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidAlice Value
alice Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bob CreateConv
defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice}
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
testLHNoConsentCannotBeInvited :: (HasCallStack) => LhApiVersion -> App ()
testLHNoConsentCannotBeInvited :: HasCallStack => LhApiVersion -> App ()
testLHNoConsentCannotBeInvited LhApiVersion
v = do
(Value
legalholder, String
tidLH, Value
userLHNotActivated : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidLH Value
legalholder App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
(Value
peer, String
_tidPeer, [Value
peer2, Value
peer3]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
peer, Value
userLHNotActivated]
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
peer2, Value
userLHNotActivated]
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidLH Value
legalholder ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Value
cid <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
userLHNotActivated CreateConv
defProteus {qualifiedUsers = [legalholder], newUsersRole = "wire_admin", team = Just tidLH} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer], role = Just "wire_admin"}) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidLH Value
legalholder Value
legalholder App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidLH Value
legalholder Value
legalholder App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"pending"
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer2]}) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidLH (Value
legalholder Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidLH Value
legalholder Value
legalholder App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer3]}) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"not-connected"
testLHDisableBeforeApproval :: (HasCallStack) => LhApiVersion -> App ()
testLHDisableBeforeApproval :: HasCallStack => LhApiVersion -> App ()
testLHDisableBeforeApproval LhApiVersion
v = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
let getBob'sStatus :: App String
getBob'sStatus = (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
bob Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
App String
getBob'sStatus App String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"pending"
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword
App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
App String
getBob'sStatus App String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
testBlockLHForMLSUsers :: (HasCallStack) => App ()
testBlockLHForMLSUsers :: HasCallStack => App ()
testBlockLHForMLSUsers = do
(Value
charlie, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
[ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
charlie]
ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1
App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
charlie App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
charlie ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
charlie Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` do
HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"
testBlockClaimingKeyPackageForLHUsers :: (HasCallStack) => App ()
testBlockClaimingKeyPackageForLHUsers :: HasCallStack => App ()
testBlockClaimingKeyPackageForLHUsers = do
(Value
alice, String
tid, [Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
[ClientIdentity
alice1, ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
charlie]
String
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1
ConvId
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
Value
profile <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
String
pStatus String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
charlie
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"
testBlockCreateMLSConvForLHUsers :: (HasCallStack) => LhApiVersion -> App ()
testBlockCreateMLSConvForLHUsers :: HasCallStack => LhApiVersion -> App ()
testBlockCreateMLSConvForLHUsers LhApiVersion
v = do
(Value
alice, String
tid, [Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
[ClientIdentity
alice1, ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
charlie]
String
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
Value
profile <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
String
pStatus String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
(App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
alice]
App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp ->
HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"
Value
respJson <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getMLSOne2OneConversation Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 (ConvId -> App ()) -> App ConvId -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (Value
respJson Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
(App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
alice]
App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp ->
HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"
testLHApiV1 :: App ()
testLHApiV1 :: App ()
testLHApiV1 = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
V1) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"status"])
String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"initiate"])
let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob
String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"confirm"])
let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob
(Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> App (Maybe Value) -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
value Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
`lookupField` String
"client_id") App Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])
Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"remove"])
let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob
testNoCommonVersion :: App ()
testNoCommonVersion :: App ()
testNoCommonVersion = do
(Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
MockServerSettings
-> (Chan () -> LiftedApplication)
-> ((String, Int) -> Chan () -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan () -> LiftedApplication
lhMockNoCommonVersion \(String, Int)
lhDomAndPort Chan ()
_ -> do
String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
500
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"server-error"
data ImplicitConsent = ImplicitConsent | ExplicitConsent
deriving (ImplicitConsent -> ImplicitConsent -> Bool
(ImplicitConsent -> ImplicitConsent -> Bool)
-> (ImplicitConsent -> ImplicitConsent -> Bool)
-> Eq ImplicitConsent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImplicitConsent -> ImplicitConsent -> Bool
== :: ImplicitConsent -> ImplicitConsent -> Bool
$c/= :: ImplicitConsent -> ImplicitConsent -> Bool
/= :: ImplicitConsent -> ImplicitConsent -> Bool
Eq, Int -> ImplicitConsent -> String -> String
[ImplicitConsent] -> String -> String
ImplicitConsent -> String
(Int -> ImplicitConsent -> String -> String)
-> (ImplicitConsent -> String)
-> ([ImplicitConsent] -> String -> String)
-> Show ImplicitConsent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ImplicitConsent -> String -> String
showsPrec :: Int -> ImplicitConsent -> String -> String
$cshow :: ImplicitConsent -> String
show :: ImplicitConsent -> String
$cshowList :: [ImplicitConsent] -> String -> String
showList :: [ImplicitConsent] -> String -> String
Show, (forall x. ImplicitConsent -> Rep ImplicitConsent x)
-> (forall x. Rep ImplicitConsent x -> ImplicitConsent)
-> Generic ImplicitConsent
forall x. Rep ImplicitConsent x -> ImplicitConsent
forall x. ImplicitConsent -> Rep ImplicitConsent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImplicitConsent -> Rep ImplicitConsent x
from :: forall x. ImplicitConsent -> Rep ImplicitConsent x
$cto :: forall x. Rep ImplicitConsent x -> ImplicitConsent
to :: forall x. Rep ImplicitConsent x -> ImplicitConsent
Generic)
ensureLHFeatureConfigForServer :: ImplicitConsent -> (String -> App ()) -> App ()
ensureLHFeatureConfigForServer :: ImplicitConsent -> (String -> App ()) -> App ()
ensureLHFeatureConfigForServer ImplicitConsent
ImplicitConsent String -> App ()
app = do
Value
cfg <- Service -> App Value
readServiceConfig Service
Galley
(Value
cfg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings.featureFlags.legalhold") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"whitelist-teams-and-implicit-consent"
String -> App ()
app (String -> App ()) -> App String -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
ensureLHFeatureConfigForServer ImplicitConsent
ExplicitConsent String -> App ()
app =
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend (ServiceOverrides
forall a. Default a => a
def {galleyCfg = upd}) HasCallStack => String -> App ()
String -> App ()
app
where
upd :: Value -> App Value
upd = String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"settings.featureFlags.legalhold" String
"disabled-by-default"