module Test.MLS.SubConversation where
import API.Galley
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Data.Set as Set
import MLS.Util
import Notifications
import SetupHelpers
import Test.MLS.One2One
import Testlib.Prelude
testJoinSubConv :: App ()
testJoinSubConv :: App ()
testJoinSubConv = 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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient 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 => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [ClientIdentity
bob1, ClientIdentity
bob2]
(String
_, Value
qcnv) <- HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [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
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
bob1 String
"conference"
Value
sub' <- Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
bob Value
qcnv String
"conference" 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
do
Value
tm <- Value
sub' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch_timestamp"
HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Epoch timestamp should not be null" (Value
tm Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null)
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit 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
testJoinOne2OneSubConv :: App ()
testJoinOne2OneSubConv :: App ()
testJoinOne2OneSubConv = 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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient 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 => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [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
ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup ClientIdentity
alice1 Value
one2OneConv
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [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
ClientIdentity -> String -> App Value -> App ()
forall keys.
(HasCallStack, MakesValue keys) =>
ClientIdentity -> String -> keys -> App ()
createOne2OneSubConv ClientIdentity
bob1 String
"conference" (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")
Value
sub' <- Value -> App Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
bob (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") String
"conference" 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
do
Value
tm <- Value
sub' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch_timestamp"
HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Epoch timestamp should not be null" (Value
tm Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null)
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit 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
testLeaveOne2OneSubConv :: One2OneScenario -> Leaver -> App ()
testLeaveOne2OneSubConv :: One2OneScenario -> Leaver -> App ()
testLeaveOne2OneSubConv One2OneScenario
scenario Leaver
leaver = 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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [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
ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup ClientIdentity
alice1 Value
one2OneConv
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [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
ClientIdentity -> String -> App Value -> App ()
forall keys.
(HasCallStack, MakesValue keys) =>
ClientIdentity -> String -> keys -> App ()
createOne2OneSubConv ClientIdentity
alice1 String
"conference" (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
bob1 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
let (ClientIdentity
leaverClient, Int
leaverIndex, ClientIdentity
remainingClient) = case Leaver
leaver of
Leaver
Alice -> (ClientIdentity
alice1, Int
0, ClientIdentity
bob1)
Leaver
Bob -> (ClientIdentity
bob1, Int
1, ClientIdentity
alice1)
ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
remainingClient ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
leaverClient
Value
msg <- HasCallStack =>
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
consumeMessage ClientIdentity
remainingClient Maybe MessagePackage
forall a. Maybe a
Nothing WebSocket
ws
Value
msg 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
leaverIndex
Value
msg 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
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 -> App MessagePackage
ClientIdentity -> App MessagePackage
createPendingProposalCommit ClientIdentity
remainingClient 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
testDeleteParentOfSubConv :: (HasCallStack) => Domain -> App ()
testDeleteParentOfSubConv :: HasCallStack => Domain -> App ()
testDeleteParentOfSubConv Domain
secondDomain = do
(Value
alice, String
tid, [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 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
secondDomain CreateUser
forall a. Default a => a
def
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bob]
[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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [ClientIdentity
alice1, ClientIdentity
bob1]
(String
_, Value
qcnv) <- HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [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
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
bob1 String
"conference"
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit 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
do
MessagePackage
mp <- HasCallStack => ClientIdentity -> String -> App MessagePackage
ClientIdentity -> String -> App MessagePackage
createApplicationMessage ClientIdentity
bob1 String
"hello, alice"
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ())
-> ((Response -> App ()) -> App ())
-> (Response -> App ())
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message) ((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
do
MessagePackage
mp <- HasCallStack => ClientIdentity -> String -> App MessagePackage
ClientIdentity -> String -> App MessagePackage
createApplicationMessage ClientIdentity
bob1 String
"hello, bob"
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ())
-> ((Response -> App ()) -> App ())
-> (Response -> App ())
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message) ((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
Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
bob ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ())
-> ((Response -> App ()) -> App ())
-> (Response -> App ())
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
MakesValue user) =>
team -> conv -> user -> App Response
deleteTeamConv String
tid Value
qcnv 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 -> 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
isConvDeleteNotif WebSocket
ws
do
MessagePackage
mp <- HasCallStack => ClientIdentity -> String -> App MessagePackage
ClientIdentity -> String -> App MessagePackage
createApplicationMessage ClientIdentity
bob1 String
"hello, alice"
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ())
-> ((Response -> App ()) -> App ())
-> (Response -> App ())
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message) ((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
404
case Domain
secondDomain of
Domain
OwnDomain -> 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-conversation"
Domain
OtherDomain -> 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-conversation-member"
do
MessagePackage
mp <- HasCallStack => ClientIdentity -> String -> App MessagePackage
ClientIdentity -> String -> App MessagePackage
createApplicationMessage ClientIdentity
alice1 String
"hello, bob"
App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ())
-> ((Response -> App ()) -> App ())
-> (Response -> App ())
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message) ((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
404
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-conversation"
testDeleteSubConversation :: (HasCallStack) => Domain -> App ()
testDeleteSubConversation :: HasCallStack => Domain -> App ()
testDeleteSubConversation Domain
otherDomain = do
[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
otherDomain]
Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
[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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient 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 => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
bob1
(String
_, Value
qcnv) <- HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [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
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
alice1 String
"conference1"
Value
sub1 <- Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
alice Value
qcnv String
"conference1" 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 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
deleteSubConversation Value
charlie Value
sub1 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
403
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
deleteSubConversation Value
alice Value
sub1 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
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
alice1 String
"conference2"
Value
sub2 <- Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
alice Value
qcnv String
"conference2" 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 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
deleteSubConversation Value
bob Value
sub2 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
Value
sub2' <- ClientIdentity -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation ClientIdentity
alice1 Value
qcnv String
"conference2" 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
sub2 Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` Value
sub2'
data Leaver = Alice | Bob
deriving stock ((forall x. Leaver -> Rep Leaver x)
-> (forall x. Rep Leaver x -> Leaver) -> Generic Leaver
forall x. Rep Leaver x -> Leaver
forall x. Leaver -> Rep Leaver x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Leaver -> Rep Leaver x
from :: forall x. Leaver -> Rep Leaver x
$cto :: forall x. Rep Leaver x -> Leaver
to :: forall x. Rep Leaver x -> Leaver
Generic)
testLeaveSubConv :: (HasCallStack) => Leaver -> App ()
testLeaveSubConv :: HasCallStack => Leaver -> App ()
testLeaveSubConv Leaver
leaver = do
[Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
clients :: [ClientIdentity]
clients@[ClientIdentity
alice1, ClientIdentity
bob1, ClientIdentity
bob2, 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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob, Value
bob, Value
charlie]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
charlie1]
App (String, Value) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (String, Value) -> App ()) -> App (String, Value) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
[Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bob, Value
charlie] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> 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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [Value
bob, 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
(WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (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]
wss
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
bob1 String
"conference"
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit 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
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
bob2 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
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
charlie1 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
let (ClientIdentity
firstLeaver, Int
idxFirstLeaver) = case Leaver
leaver of
Leaver
Bob -> (ClientIdentity
bob1, Int
0)
Leaver
Alice -> (ClientIdentity
alice1, Int
1)
let idxCharlie1 :: Int
idxCharlie1 = Int
3
let others :: [ClientIdentity]
others = (ClientIdentity -> Bool) -> [ClientIdentity] -> [ClientIdentity]
forall a. (a -> Bool) -> [a] -> [a]
filter (ClientIdentity -> ClientIdentity -> Bool
forall a. Eq a => a -> a -> Bool
/= ClientIdentity
firstLeaver) [ClientIdentity]
clients
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity]
others (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
firstLeaver
[(ClientIdentity, WebSocket)]
-> ((ClientIdentity, WebSocket) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ClientIdentity] -> [WebSocket] -> [(ClientIdentity, WebSocket)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ClientIdentity]
others [WebSocket]
wss) (((ClientIdentity, WebSocket) -> App ()) -> App ())
-> ((ClientIdentity, WebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(ClientIdentity
cid, WebSocket
ws) -> do
Value
msg <- HasCallStack =>
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
consumeMessage ClientIdentity
cid Maybe MessagePackage
forall a. Maybe a
Nothing WebSocket
ws
Value
msg 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
idxFirstLeaver
Value
msg 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
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets ([ClientIdentity] -> [ClientIdentity]
forall a. HasCallStack => [a] -> [a]
tail [ClientIdentity]
others) (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> 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 -> App MessagePackage
ClientIdentity -> App MessagePackage
createPendingProposalCommit ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
others) 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
(WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss
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 -> String -> App MessagePackage
ClientIdentity -> String -> App MessagePackage
createApplicationMessage ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
others) String
"good riddance" 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
sendAndConsumeMessage
(WebSocket -> App Value) -> [WebSocket] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isNewMLSMessageNotif) [WebSocket]
wss
do
Value
conv <- HasCallStack => ClientIdentity -> App Value
ClientIdentity -> App Value
getCurrentConv ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
others)
[Value]
mems <- Value
conv 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
[Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
mems Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
3
let others' :: [ClientIdentity]
others' = (ClientIdentity -> Bool) -> [ClientIdentity] -> [ClientIdentity]
forall a. (a -> Bool) -> [a] -> [a]
filter (ClientIdentity -> ClientIdentity -> Bool
forall a. Eq a => a -> a -> Bool
/= ClientIdentity
charlie1) [ClientIdentity]
others
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity]
others' (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
charlie1
[(ClientIdentity, WebSocket)]
-> ((ClientIdentity, WebSocket) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ClientIdentity] -> [WebSocket] -> [(ClientIdentity, WebSocket)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ClientIdentity]
others' [WebSocket]
wss) (((ClientIdentity, WebSocket) -> App ()) -> App ())
-> ((ClientIdentity, WebSocket) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(ClientIdentity
cid, WebSocket
ws) -> do
Value
msg <- HasCallStack =>
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
consumeMessage ClientIdentity
cid Maybe MessagePackage
forall a. Maybe a
Nothing WebSocket
ws
Value
msg 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
idxCharlie1
Value
msg 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
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 -> App MessagePackage
ClientIdentity -> App MessagePackage
createPendingProposalCommit ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
others') 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
do
Value
conv <- HasCallStack => ClientIdentity -> App Value
ClientIdentity -> App Value
getCurrentConv ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
others)
[Value]
mems <- Value
conv 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
[Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
mems Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
testCreatorRemovesUserFromParent :: App ()
testCreatorRemovesUserFromParent :: App ()
testCreatorRemovesUserFromParent = do
[Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
[ClientIdentity
alice1, ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
charlie1, ClientIdentity
charlie2] <- (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 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob, Value
bob, Value
charlie, Value
charlie]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
charlie1, ClientIdentity
charlie2]
(String
_, Value
qcnv) <- HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
Value
_ <- HasCallStack => ClientIdentity -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [Value
bob, 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
MLSState
parentState <- App MLSState
getMLSState
let subConvName :: String
subConvName = String
"conference"
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
alice1 String
subConvName
[ClientIdentity] -> (ClientIdentity -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
charlie1, ClientIdentity
charlie2] \ClientIdentity
c ->
HasCallStack =>
ClientIdentity -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
c 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
MLSState
childState <- App MLSState
getMLSState App MLSState -> App () -> App MLSState
forall a b. App a -> App b -> App a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MLSState -> App ()
setMLSState MLSState
parentState
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
alice1, ClientIdentity
charlie1, ClientIdentity
charlie2] \[WebSocket]
wss -> do
Value
removeCommitEvents <- HasCallStack =>
ClientIdentity -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
alice1 [ClientIdentity
bob1, ClientIdentity
bob2] 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
(MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
s -> MLSState
s {members = s.members Set.\\ Set.fromList [bob1, bob2]}
Value
removeCommitEvents Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-leave"
Value
removeCommitEvents Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events.0.data.reason" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"removed"
Value
removeCommitEvents Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events.0.from" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ClientIdentity
alice1.user
[WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss \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
isConvLeaveNotif WebSocket
ws
Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.reason" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"removed"
Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.from" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ClientIdentity
alice1.user
MLSState -> App ()
setMLSState MLSState
childState
let Int
idxBob1 :: Int = Int
1
Int
idxBob2 :: Int = Int
2
[(Int, WebSocket)] -> ((Int, WebSocket) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((,) (Int -> WebSocket -> (Int, WebSocket))
-> [Int] -> [WebSocket -> (Int, WebSocket)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
idxBob1, Int
idxBob2] [WebSocket -> (Int, WebSocket)]
-> [WebSocket] -> [(Int, WebSocket)]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [WebSocket]
wss) \(Int
idx, WebSocket
ws) -> do
Value
msg <-
HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch
do
\Value
n ->
Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Bool -> Bool) -> App (Maybe Bool) -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT App Bool -> App (Maybe Bool)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
Value
msg <- App Value -> MaybeT App Value
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 Value -> MaybeT App Value) -> App Value -> MaybeT App Value
forall a b. (a -> b) -> a -> b
$ Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data" App Value -> (App Value -> App ByteString) -> App ByteString
forall a b. a -> (a -> b) -> b
& App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString App ByteString -> (ByteString -> 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 => ClientIdentity -> ByteString -> App Value
ClientIdentity -> ByteString -> App Value
showMessage ClientIdentity
alice1
Bool -> MaybeT App ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT App ()) -> MaybeT App Bool -> MaybeT App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Bool -> MaybeT App Bool
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
Value -> App Bool
forall a. MakesValue a => a -> App Bool
isNewMLSMessageNotif Value
n
Value
prop <-
MaybeT App Value
-> (Value -> MaybeT App Value) -> Maybe Value -> MaybeT App Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaybeT App Value
forall a. MaybeT App a
forall (m :: * -> *) a. MonadPlus m => m a
mzero Value -> MaybeT App Value
forall a. a -> MaybeT App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> MaybeT App Value)
-> MaybeT App (Maybe Value) -> MaybeT App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App (Maybe Value) -> MaybeT App (Maybe Value)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
msg String
"message.content.body.Proposal"
App Bool -> MaybeT App Bool
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx) (Int -> Bool) -> App Int -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
prop Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Remove.removed" App Value -> (App Value -> App Int) -> App Int
forall a b. a -> (a -> b) -> b
& App Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt)
WebSocket
ws
Maybe ClientIdentity
-> (ClientIdentity -> App ByteString) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ WebSocket
ws.client ((ClientIdentity -> App ByteString) -> App ())
-> (ClientIdentity -> App ByteString) -> App ()
forall a b. (a -> b) -> a -> b
$ \ClientIdentity
consumer ->
Value
msg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data" App Value -> (App Value -> App ByteString) -> App ByteString
forall a b. a -> (a -> b) -> b
& App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString App ByteString -> (ByteString -> 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 => ClientIdentity -> ByteString -> App ByteString
ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ClientIdentity
consumer
(MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
s -> MLSState
s {members = s.members Set.\\ Set.fromList [bob1, bob2]}
Value
_ <- HasCallStack => ClientIdentity -> App MessagePackage
ClientIdentity -> App MessagePackage
createPendingProposalCommit 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 -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
bob Value
qcnv String
subConvName 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
>>= (Response -> (Response -> App ()) -> App ())
-> (Response -> App ()) -> Response -> App ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Response -> (Response -> App ()) -> App ()
forall a. HasCallStack => Response -> (Response -> App a) -> App a
withResponse \Response
resp ->
HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"access to the conversation for bob should be denied" (Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
403)
[Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
charlie, Value
alice] \Value
m -> do
Response
resp <- Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation Value
m Value
qcnv String
subConvName
HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"alice and charlie should have access to the conversation" (Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200)
[Value]
mems <- Response
resp.jsonBody Maybe 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
[Value]
mems [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ((String -> String -> Value -> App Value
renameField String
"id" String
"user_id" (Value -> App Value)
-> (ClientIdentity -> App Value) -> ClientIdentity -> App Value
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ClientIdentity -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make) (ClientIdentity -> App Value) -> [ClientIdentity] -> 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` [ClientIdentity
alice1, ClientIdentity
charlie1, ClientIdentity
charlie2])
testResendingProposals :: (HasCallStack) => App ()
testResendingProposals :: HasCallStack => App ()
testResendingProposals = do
[Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
[ClientIdentity
alice1, ClientIdentity
alice2, ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
bob3, 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
(InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def)
[Value
alice, Value
alice, Value
bob, Value
bob, Value
bob, Value
charlie]
(ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage [ClientIdentity
alice2, ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
bob3, ClientIdentity
charlie1]
(String
_, Value
conv) <- HasCallStack => ClientIdentity -> App (String, Value)
ClientIdentity -> App (String, Value)
createNewGroup ClientIdentity
alice1
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 -> [Value] -> App MessagePackage
ClientIdentity -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 [Value
alice, Value
bob, 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
HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
createSubConv ClientIdentity
alice1 String
"conference"
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
alice2 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
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
bob1 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
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
bob2 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
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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
bob3 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
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
bob1
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
bob2
HasCallStack => ClientIdentity -> App ()
ClientIdentity -> App ()
leaveCurrentConv ClientIdentity
bob3
MLSState
mls <- App MLSState
getMLSState
[ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets (ClientIdentity
charlie1 ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: Set ClientIdentity -> [ClientIdentity]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MLSState
mls.members) \[WebSocket]
wss -> 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 -> Maybe ByteString -> App MessagePackage
ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ClientIdentity
charlie1 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
[WebSocket] -> (WebSocket -> App [()]) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss \WebSocket
ws -> do
Int -> App () -> App [()]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
Value
msg <- HasCallStack =>
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value
consumeMessage (Maybe ClientIdentity -> ClientIdentity
forall a. HasCallStack => Maybe a -> a
fromJust WebSocket
ws.client) Maybe MessagePackage
forall a. Maybe a
Nothing WebSocket
ws
Value
msg 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
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 -> App MessagePackage
ClientIdentity -> App MessagePackage
createPendingProposalCommit 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
sub <- ClientIdentity -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation ClientIdentity
alice1 Value
conv String
"conference" 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
let members :: [Value]
members =
(ClientIdentity -> Value) -> [ClientIdentity] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
( \ClientIdentity
cid ->
[Pair] -> Value
object
[ String
"client_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
cid.client,
String
"user_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
cid.user,
String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
cid.domain
]
)
[ClientIdentity
alice1, ClientIdentity
alice2, ClientIdentity
charlie1]
Value
sub Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value]
members