module Test.MLS.SubConversation where

import API.Galley
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Data.Map as Map
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 (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]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def 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 -> 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
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
bob1 String
"conference"

  -- bob adds his first client to the subconversation
  Value
sub' <- Value -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
bob ConvId
convId 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
  ConvId
subConvId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
sub'
  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)

  -- now alice joins with her own client
  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
subConvId 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 (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 (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

  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
  Ciphersuite
-> ConvId -> ClientIdentity -> String -> App Value -> App ()
forall keys.
(HasCallStack, MakesValue keys) =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> keys -> App ()
createOne2OneSubConv Ciphersuite
forall a. Default a => a
def ConvId
one2OneConvId ClientIdentity
bob1 String
"conference" (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")

  -- bob adds his first client to the subconversation
  Value
sub' <- Value -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
bob ConvId
one2OneConvId 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
  ConvId
subConvId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
sub'
  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)

  -- now alice joins with her own client
  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
subConvId 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
  -- set up 1-1 conversation
  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
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
  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
  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

  -- create and join subconversation
  Ciphersuite
-> ConvId -> ClientIdentity -> String -> App Value -> App ()
forall keys.
(HasCallStack, MakesValue keys) =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> keys -> App ()
createOne2OneSubConv Ciphersuite
forall a. Default a => a
def ConvId
one2OneConvId ClientIdentity
alice1 String
"conference" (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")
  ConvId
subConvId <- Value -> ConvId -> String -> App ConvId
forall user.
(MakesValue user, HasCallStack) =>
user -> ConvId -> String -> App ConvId
getSubConvId Value
bob ConvId
one2OneConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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

  -- one of the two clients leaves
  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 => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId ClientIdentity
leaverClient
    Value
msg <- HasCallStack =>
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
consumeMessage ConvId
subConvId Ciphersuite
forall a. Default a => a
def 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

  -- the other client commits the pending proposal
  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
subConvId 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 (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]
  (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
alice1, ClientIdentity
bob1]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def 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 -> 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

  -- bob creates a subconversation and adds his own client
  HasCallStack =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
bob1 String
"conference"
  ConvId
subConvId <- Value -> ConvId -> String -> App ConvId
forall user.
(MakesValue user, HasCallStack) =>
user -> ConvId -> String -> App ConvId
getSubConvId Value
bob ConvId
convId String
"conference"

  -- alice joins with her own client
  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
subConvId 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

  -- bob sends a message to the subconversation
  do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
subConvId 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

  -- alice sends a message to the subconversation
  do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
subConvId 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

  -- alice deletes main conversation
  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 (ConvId -> Value
convIdToQidObject ConvId
convId) 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

  -- bob fails to send a message to the subconversation
  do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
subConvId 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"

  -- alice fails to send a message to the subconversation
  do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
subConvId 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 (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 <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def 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 -> 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

  HasCallStack =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
alice1 String
"conference1"
  Value
sub1 <- Value -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
alice ConvId
convId 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 =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
alice1 String
"conference2"
  Value
sub2 <- Value -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
alice ConvId
convId 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 -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation ClientIdentity
alice1 ConvId
convId 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 (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, Value
charlie]
  (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, ClientIdentity
charlie1]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def 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 -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [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 =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
bob1 String
"conference"
  ConvId
subConvId <- Value -> ConvId -> String -> App ConvId
forall user.
(MakesValue user, HasCallStack) =>
user -> ConvId -> String -> App ConvId
getSubConvId Value
bob ConvId
convId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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

  -- a member leaves the subconversation
  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 => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId 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 =>
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
consumeMessage ConvId
subConvId Ciphersuite
forall a. Default a => a
def 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
    -- a member commits the pending proposal
    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
subConvId ([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

    -- send an application 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 -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
subConvId ([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

  -- check that only 3 clients are left in the subconv
  do
    Value
conv <- HasCallStack => ConvId -> ClientIdentity -> App Value
ConvId -> ClientIdentity -> App Value
getConv ConvId
subConvId ([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

  -- charlie1 leaves
  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 => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId 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 =>
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
consumeMessage ConvId
subConvId Ciphersuite
forall a. Default a => a
def 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

  -- a member commits the pending proposal
  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
subConvId ([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

  -- check that only 2 clients are left in the subconv
  do
    Value
conv <- HasCallStack => ConvId -> ClientIdentity -> App Value
ConvId -> ClientIdentity -> App Value
getConv ConvId
subConvId ([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]
  [(String, Value)] -> App () -> App ()
forall user a.
MakesValue user =>
[(String, user)] -> App a -> App a
addUsersToFailureContext [(String
"alice", Value
alice), (String
"bob", Value
bob), (String
"charlie", Value
charlie)] (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    [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 (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, 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 => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
charlie1, ClientIdentity
charlie2]
    ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

    Value
_ <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [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

    -- save the state of the parent group
    let subConvName :: String
subConvName = String
"conference"
    HasCallStack =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
convId ClientIdentity
alice1 String
subConvName
    ConvId
subConvId <- Value -> ConvId -> String -> App ConvId
forall user.
(MakesValue user, HasCallStack) =>
user -> ConvId -> String -> App ConvId
getSubConvId Value
alice ConvId
convId String
"conference"

    [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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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

    [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 -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
alice1 ConvId
convId [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
          { convs =
              Map.adjust
                (\MLSConv
conv -> MLSConv
conv {members = conv.members Set.\\ Set.fromList [bob1, bob2]})
                convId
                s.convs
          }

      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

      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 =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
forall a. Default a => a
def 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 =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
subConvId Ciphersuite
forall a. Default a => a
def ClientIdentity
consumer

      -- remove bob from the child state
      (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 = conv.members Set.\\ Set.fromList [bob1, bob2]})
                subConvId
                s.convs
          }

      Value
_ <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
subConvId 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 -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
bob ConvId
convId 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 -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
m ConvId
convId 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
      (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
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 => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity
alice2, ClientIdentity
bob1, ClientIdentity
bob2, ClientIdentity
bob3, ClientIdentity
charlie1]

  ConvId
conv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def 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 -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
conv [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 =>
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
Ciphersuite -> ConvId -> ClientIdentity -> String -> App ()
createSubConv Ciphersuite
forall a. Default a => a
def ConvId
conv ClientIdentity
alice1 String
"conference"
  ConvId
subConvId <- Value -> ConvId -> String -> App ConvId
forall user.
(MakesValue user, HasCallStack) =>
user -> ConvId -> String -> App ConvId
getSubConvId Value
alice ConvId
conv 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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 => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId ClientIdentity
bob1
  HasCallStack => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId ClientIdentity
bob2
  HasCallStack => ConvId -> ClientIdentity -> App ()
ConvId -> ClientIdentity -> App ()
leaveConv ConvId
subConvId ClientIdentity
bob3

  MLSConv
subConv <- HasCallStack => ConvId -> App MLSConv
ConvId -> App MLSConv
getMLSConv ConvId
subConvId
  [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 MLSConv
subConv.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 =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
subConvId 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

    -- consume proposals after backend resends them
    [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 =>
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
consumeMessage ConvId
subConvId Ciphersuite
forall a. Default a => a
def (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 => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
subConvId 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 -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation ClientIdentity
alice1 ConvId
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