module Test.MLS.One2One where
import API.Brig
import API.Galley
import Control.Concurrent.Async
import Control.Concurrent.MVar
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Read as T
import MLS.Util
import Notifications
import SetupHelpers
import Test.Version
import Testlib.Prelude
import Testlib.VersionedFed
testGetMLSOne2OneLocalV5 :: (HasCallStack) => App ()
testGetMLSOne2OneLocalV5 :: HasCallStack => App ()
testGetMLSOne2OneLocalV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
let assertConvData :: a -> App ()
assertConvData a
conv = do
a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
Value
convId <-
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
conv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")
Value
conv 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_member"
Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv
Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
Value
conv2 <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
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
Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
convId
Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv2
testGetMLSOne2OneRemoteV5 :: (HasCallStack) => App ()
testGetMLSOne2OneRemoteV5 :: HasCallStack => App ()
testGetMLSOne2OneRemoteV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy 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
400
Response
resp.jsonBody Maybe 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
"mls-federated-one2one-not-supported"
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy 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
400
Response
resp.jsonBody Maybe 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
"mls-federated-one2one-not-supported"
testGetMLSOne2One :: (HasCallStack) => Domain -> App ()
testGetMLSOne2One :: HasCallStack => Domain -> App ()
testGetMLSOne2One Domain
bobDomain = do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
bobDomain]
String
bobDomainStr <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
bobDomain
let assertConvData :: a -> App ()
assertConvData a
conv = do
a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
a -> String -> App ()
forall a. (HasCallStack, MakesValue a) => a -> String -> App ()
assertFieldMissing a
conv String
"cipher_suite"
Value
mlsOne2OneConv <-
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
one2oneConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
String
convOwnerDomain <- 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
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id.domain"
let user :: Value
user = if String
convOwnerDomain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bobDomainStr then Value
bob else Value
alice
Value
ownerDomainPublicKeys <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys Value
user 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
Value
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
ownerDomainPublicKeys
Value
conv <- Value
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")
Value
conv 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_member"
Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
one2oneConv
Value
mlsOne2OneConv2 <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
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
Value
conv2 <- Value
mlsOne2OneConv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
mlsOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")
Value
mlsOne2OneConv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
mlsOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")
Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv2
testMLSOne2OneOtherMember :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneOtherMember :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneOtherMember One2OneScenario
scenario = do
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
do
Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
Value
bobOne2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice 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
Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
let assertOthers :: (HasCallStack, MakesValue other, MakesValue retrievedConv) => other -> retrievedConv -> App ()
assertOthers :: forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers other
other retrievedConv
retrievedConv = do
[Value]
othersObj <- retrievedConv
retrievedConv retrievedConv -> 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
Value
otherActual <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
othersObj
Value
otherActual Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (other
other other -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
[(Value, Value)] -> ((Value, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Value
alice, Value
bob), (Value
bob, Value
alice)] (((Value, Value) -> App ()) -> App ())
-> ((Value, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
self, Value
other) -> do
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
self Value
other App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
retrievedConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp 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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")
Value -> Value -> App ()
forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers Value
other Value
retrievedConv
Value -> App Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getConversation Value
self (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
retrievedConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
Value -> Value -> App ()
forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers Value
other Value
retrievedConv
testMLSOne2OneRemoveClientLocalV5 :: App ()
testMLSOne2OneRemoveClientLocalV5 :: App ()
testMLSOne2OneRemoveClientLocalV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
Value
conv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
alice 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
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId
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
alice1 ConvId
convId [Value
bob] 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
Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
bob ClientIdentity
bob1.client App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsAlice
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob)
ByteString
mlsMsg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data")
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
convId Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ByteString
mlsMsg
Value
parsedMsg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ByteString
mlsMsg
let leafIndexBob :: Int
leafIndexBob = Int
1
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
leafIndexBob
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.sender.External" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
testGetMLSOne2OneUnconnected :: (HasCallStack) => Domain -> App ()
testGetMLSOne2OneUnconnected :: HasCallStack => Domain -> App ()
testGetMLSOne2OneUnconnected Domain
otherDomain = do
[Value
alice, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
otherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Domain
domain -> Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
domain CreateUser
forall a. Default a => a
def
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
testMLSOne2OneBlocked :: (HasCallStack) => Domain -> App ()
testMLSOne2OneBlocked :: HasCallStack => Domain -> App ()
testMLSOne2OneBlocked Domain
otherDomain = do
[Value
alice, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
otherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ (Domain -> CreateUser -> App Value)
-> CreateUser -> Domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
postConnection Value
bob Value
alice App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
201
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
403
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice 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
403
testMLSOne2OneBlockedAfterConnected :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneBlockedAfterConnected :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneBlockedAfterConnected One2OneScenario
scenario = do
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
do
Value
bobConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice 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
Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
2 WebSocket
ws App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
403
MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
bob1 String
"hello, world, again"
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
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 -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message 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
Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
2 WebSocket
ws App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)
testMLSOne2OneUnblocked :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneUnblocked :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneUnblocked One2OneScenario
scenario = do
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
do
Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
Value
bobConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice 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
Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
403
(MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
s -> MLSState
s {convs = Map.adjust (\MLSConv
conv -> MLSConv
conv {members = Set.singleton bob1}) one2OneConvId s.convs}
ClientIdentity
bob2 <- 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
bob
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob2
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
bob1 ConvId
one2OneConvId [Value
bob] 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
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"accepted" App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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 -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
one2OneConvId ClientIdentity
alice1 Maybe ByteString
forall a. Maybe a
Nothing 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
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
bob1, ClientIdentity
bob2] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
alice1 String
"hello, I've always been here"
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage MessagePackage
mp
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
[WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode MessagePackage
mp.message)
testGetMLSOne2OneSameTeam :: App ()
testGetMLSOne2OneSameTeam :: App ()
testGetMLSOne2OneSameTeam = do
(Value
alice, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
Value
bob <- Value -> App Value
forall u. (HasCallStack, MakesValue u) => u -> App Value
addUserToTeam Value
alice
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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
data One2OneScenario
=
One2OneScenarioLocal
|
One2OneScenarioLocalConv
|
One2OneScenarioRemoteConv
instance TestCases One2OneScenario where
mkTestCases :: IO [TestCase One2OneScenario]
mkTestCases =
[TestCase One2OneScenario] -> IO [TestCase One2OneScenario]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=own]" One2OneScenario
One2OneScenarioLocal,
String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=other;conv=own]" One2OneScenario
One2OneScenarioLocalConv,
String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=other;conv=other]" One2OneScenario
One2OneScenarioRemoteConv
]
one2OneScenarioUserDomain :: One2OneScenario -> Domain
one2OneScenarioUserDomain :: One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
One2OneScenarioLocal = Domain
OwnDomain
one2OneScenarioUserDomain One2OneScenario
_ = Domain
OtherDomain
one2OneScenarioConvDomain :: One2OneScenario -> Domain
one2OneScenarioConvDomain :: One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioLocal = Domain
OwnDomain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioLocalConv = Domain
OwnDomain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioRemoteConv = Domain
OtherDomain
testMLSOne2One :: (HasCallStack) => Ciphersuite -> One2OneScenario -> App ()
testMLSOne2One :: HasCallStack => Ciphersuite -> One2OneScenario -> App ()
testMLSOne2One Ciphersuite
suite One2OneScenario
scenario = do
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
suite InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
suite ClientIdentity
alice1 Value
one2OneConv
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isWelcome :: a -> App Bool
isWelcome a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isWelcome WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
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 => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMemberJoinNotif WebSocket
ws
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
alice1 String
"hello, world"
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage MessagePackage
mp
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode MessagePackage
mp.message)
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 => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
one2OneConvId ClientIdentity
alice1 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
Value
one2OneConv' <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
(Int
suiteCode, Text
_) <- Either String (Int, Text) -> App (Int, Text)
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (Either String (Int, Text) -> App (Int, Text))
-> Either String (Int, Text) -> App (Int, Text)
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
T.hexadecimal (String -> Text
T.pack Ciphersuite
suite.code)
Value
one2OneConv' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
suiteCode
testMLSGhostOne2OneConv :: App ()
testMLSGhostOne2OneConv :: App ()
testMLSGhostOne2OneConv = do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
[ClientIdentity
alice1, ClientIdentity
bob1, ClientIdentity
bob2] <- (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
bob, Value
bob]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity
bob1, ClientIdentity
bob2]
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
MVar ()
doneVar <- IO (MVar ()) -> App (MVar ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> App (MVar ())) -> IO (MVar ()) -> App (MVar ())
forall a b. (a -> b) -> a -> b
$ IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
let checkConversation :: App ()
checkConversation =
IO (Maybe ()) -> App (Maybe ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
doneVar) App (Maybe ()) -> (Maybe () -> 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
Maybe ()
Nothing -> do
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getConversation Value
alice (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
Response
resp.status Int -> [Int] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchOneOf` [Int
404 :: Int, Int
403, Int
200]
App ()
checkConversation
Just ()
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
IO ()
checkConversationIO <- App () -> App (IO ())
forall a. App a -> App (IO a)
appToIO App ()
checkConversation
IO ()
createCommit <-
App () -> App (IO ())
forall a. App a -> App (IO a)
appToIO
(App () -> App (IO ())) -> App () -> App (IO ())
forall a b. (a -> b) -> a -> b
$ 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
alice1 ConvId
one2OneConvId [Value
bob]
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
IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO ()
checkConversationIO ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
a -> do
IO ()
createCommit
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneVar ()
Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
a
testMLSFederationV1ConvOnOldBackend :: App ()
testMLSFederationV1ConvOnOldBackend :: App ()
testMLSFederationV1ConvOnOldBackend = do
let cs :: Ciphersuite
cs = String -> Ciphersuite
Ciphersuite String
"0x0001"
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let createBob :: App Value
createBob = do
Value
bobCandidate <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser (Integer -> StaticDomain
StaticFedDomain Integer
1) CreateUser
forall a. Default a => a
def
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bobCandidate]
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bobCandidate App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
if Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
533
then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
bobCandidate
else App Value
createBob
Value
bob <- App Value
createBob
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
cs InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
cs ClientIdentity
alice1
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
fedError <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
533 Response
resp
Value
fedError 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
"federation-version-error"
Value
conv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice 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
ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
Value
keys <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys 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
Ciphersuite -> ClientIdentity -> Value -> Value -> App ()
forall conv keys.
(HasCallStack, MakesValue conv, MakesValue keys) =>
Ciphersuite -> ClientIdentity -> conv -> keys -> App ()
resetOne2OneGroupGeneric Ciphersuite
cs ClientIdentity
bob1 Value
conv Value
keys
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
bob1 ConvId
convId [Value
alice]
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
wsAlice
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
alice ClientIdentity
alice1.client App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsBob
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice)
ByteString
mlsMsg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data")
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
convId Ciphersuite
cs ClientIdentity
bob1 ByteString
mlsMsg
Value
parsedMsg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
cs ClientIdentity
bob1 ByteString
mlsMsg
let leafIndexAlice :: Int
leafIndexAlice = Int
1
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
leafIndexAlice
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.sender.External" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
testMLSFederationV1ConvOnNewBackend :: App ()
testMLSFederationV1ConvOnNewBackend :: App ()
testMLSFederationV1ConvOnNewBackend = do
let cs :: Ciphersuite
cs = String -> Ciphersuite
Ciphersuite String
"0x0001"
Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let createBob :: App Value
createBob = do
Value
bobCandidate <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser (Integer -> StaticDomain
StaticFedDomain Integer
1) CreateUser
forall a. Default a => a
def
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bobCandidate]
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bobCandidate App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
if Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200
then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
bobCandidate
else App Value
createBob
Value
bob <- App Value
createBob
[ClientIdentity
alice1, ClientIdentity
bob1] <- (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
cs InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
cs ClientIdentity
bob1
Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Value
fedError <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
533 Response
resp
Value
fedError 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
"federation-remote-error"
Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice 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
ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Value
conv <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
cs ClientIdentity
alice1 Value
one2OneConv
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
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 => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
wsBob
Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
bob ClientIdentity
bob1.client App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsAlice
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob)
ByteString
mlsMsg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data")
App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
one2OneConvId Ciphersuite
cs ClientIdentity
alice1 ByteString
mlsMsg
Value
parsedMsg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
cs ClientIdentity
alice1 ByteString
mlsMsg
let leafIndexBob :: Int
leafIndexBob = Int
1
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
leafIndexBob
Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.sender.External" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0