{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-ambiguous-fields #-}

module Test.MLS where

import API.Brig (claimKeyPackages, deleteClient)
import API.Galley
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
import MLS.Util
import Notifications
import SetupHelpers
import Test.Version
import Testlib.Prelude
import Testlib.VersionedFed

testSendMessageNoReturnToSender :: (HasCallStack) => App ()
testSendMessageNoReturnToSender :: HasCallStack => App ()
testSendMessageNoReturnToSender = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
alice2, 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
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
alice2, 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
alice, 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

  -- alice1 sends a message to the conversation, all clients but alice1 receive
  -- the message
  [ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
alice1, ClientIdentity
alice2, ClientIdentity
bob1, ClientIdentity
bob2] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(WebSocket
wsSender : [WebSocket]
wss) -> do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alice1 String
"hello, bob"
    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
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (\Value
n -> Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add") WebSocket
ws
      Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> Text -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
Base64.encode MessagePackage
mp.message)
    (AssertionFailure -> App ()) -> App Value -> App ()
forall a.
HasCallStack =>
(AssertionFailure -> App ()) -> App a -> App ()
expectFailure (App () -> AssertionFailure -> App ()
forall a b. a -> b -> a
const (App () -> AssertionFailure -> App ())
-> App () -> AssertionFailure -> App ()
forall a b. (a -> b) -> a -> b
$ () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      (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
n ->
            (Bool -> Bool -> Bool) -> App Bool -> App Bool -> App Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
              Bool -> Bool -> Bool
(&&)
              (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add")
              (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> Text -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
Base64.encode MessagePackage
mp.message))
        )
        WebSocket
wsSender

testPastStaleApplicationMessage :: (HasCallStack) => Domain -> App ()
testPastStaleApplicationMessage :: HasCallStack => Domain -> App ()
testPastStaleApplicationMessage Domain
otherDomain = do
  [Value
alice, Value
bob, Value
charlie, Value
dave, Value
eve] <-
    [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
otherDomain, Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
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
charlie1]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  -- alice adds bob first
  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 prepares some application messages
  [MessagePackage
msg1, MessagePackage
msg2] <- Int -> App MessagePackage -> App [MessagePackage]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (App MessagePackage -> App [MessagePackage])
-> App MessagePackage -> App [MessagePackage]
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
bob1 String
"hi alice"

  -- alice adds charlie and dave with different commits
  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
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
  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
dave] 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's application messages still go through
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage ClientIdentity
bob1 MessagePackage
msg1.message App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

  -- alice adds eve
  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
eve] 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's application messages are now rejected
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage ClientIdentity
bob1 MessagePackage
msg2.message App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
409

testFutureStaleApplicationMessage :: (HasCallStack) => App ()
testFutureStaleApplicationMessage :: HasCallStack => App ()
testFutureStaleApplicationMessage = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
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
charlie1]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  -- alice adds bob
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ())
-> (MessagePackage -> App Value) -> MessagePackage -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle (MessagePackage -> App ()) -> App MessagePackage -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob]

  -- alice adds charlie and consumes the commit without sending it
  App MessagePackage -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App MessagePackage -> App ()) -> App MessagePackage -> 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
charlie]
  (MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
mls ->
    MLSState
mls
      { convs =
          Map.adjust
            ( \MLSConv
conv ->
                MLSConv
conv
                  { epoch = conv.epoch + 1,
                    members = Set.insert charlie1 conv.members,
                    memberUsers = Set.insert charlie1.qualifiedUserId conv.memberUsers,
                    newMembers = mempty
                  }
            )
            convId
            mls.convs
      }

  -- alice's application message is rejected
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (App Value -> App ())
-> (Response -> App Value) -> Response -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
409
    (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage ClientIdentity
alice1
    (ByteString -> App Response)
-> (MessagePackage -> ByteString) -> MessagePackage -> App Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.message)
    (MessagePackage -> App Response)
-> App MessagePackage -> App Response
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
alice1 String
"hi bob"

testMixedProtocolUpgrade :: (HasCallStack) => Domain -> App ()
testMixedProtocolUpgrade :: HasCallStack => Domain -> App ()
testMixedProtocolUpgrade 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, Value
charlie] <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (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, Value
charlie]

  ConvId
convId <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
      Value
alice
      CreateConv
defProteus
        { qualifiedUsers = [bob, charlie],
          team = Just tid,
          receiptMode = Just 7
        }
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
      App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mls") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
charlie] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
websockets -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (ConvId -> Value
convIdToQidObject ConvId
convId)
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mixed"

    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
websockets ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (\Value
value -> Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
value App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.protocol-update") WebSocket
ws
      Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mixed"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mixed"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
7

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
alice ConvId
convId String
"mixed") ((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
204

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"proteus") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"invalid") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400

testMixedProtocolNonTeam :: (HasCallStack) => Domain -> App ()
testMixedProtocolNonTeam :: HasCallStack => Domain -> App ()
testMixedProtocolNonTeam Domain
secondDomain = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
secondDomain]
  ConvId
convId <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [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
201
      App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testMixedProtocolAddUsers :: (HasCallStack) => Domain -> Ciphersuite -> App ()
testMixedProtocolAddUsers :: HasCallStack => Domain -> Ciphersuite -> App ()
testMixedProtocolAddUsers Domain
secondDomain Ciphersuite
suite = 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, Value
charlie] <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (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, Value
charlie]

  ConvId
convId <- do
    ConvId
convId <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], team = Just tid}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((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 Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
      App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json

  [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 {ciphersuites = [suite]}) [Value
alice, Value
bob]
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
suite ClientIdentity
alice1 ConvId
convId

  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1

  Value -> (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
    MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob]
    ByteString
welcome <- String -> Maybe ByteString -> App ByteString
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"should have welcome" MessagePackage
mp.welcome
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed MessagePackage
mp
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (\Value
n -> Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome") WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> Text -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
Base64.encode ByteString
welcome)

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
    (Int
suiteCode, Text
_) <- Either String (Int, Text) -> App (Int, Text)
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (Either String (Int, Text) -> App (Int, Text))
-> Either String (Int, Text) -> App (Int, Text)
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
T.hexadecimal (String -> Text
T.pack Ciphersuite
suite.code)
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
suiteCode

testMixedProtocolUserLeaves :: (HasCallStack) => Domain -> App ()
testMixedProtocolUserLeaves :: HasCallStack => Domain -> App ()
testMixedProtocolUserLeaves 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]

  ConvId
convId <- do
    ConvId
convId <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], team = Just tid}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((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 Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
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 ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json

  [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]
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId
  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

  MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob]
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed MessagePackage
mp

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
removeConversationMember Value
bob (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (\Value
n -> Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add") WebSocket
ws

    MLSConv
conv <- HasCallStack => ConvId -> App MLSConv
ConvId -> App MLSConv
getMLSConv ConvId
convId
    Value
msg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data") App ByteString -> (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 MLSConv
conv.ciphersuite ClientIdentity
alice1
    let leafIndexBob :: Int
leafIndexBob = Int
1
    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
leafIndexBob
    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

testMixedProtocolAddPartialClients :: (HasCallStack) => Domain -> App ()
testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App ()
testMixedProtocolAddPartialClients 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]

  ConvId
convId <- do
    ConvId
convId <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], team = Just tid}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((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 Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
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 ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json

  [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]
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId

  (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
bob1, ClientIdentity
bob2, ClientIdentity
bob2]

  -- create add commit for only one of bob's two clients
  do
    Value
bundle <- Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
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, ByteString)]
kps <- HasCallStack => Value -> App [(ClientIdentity, ByteString)]
Value -> App [(ClientIdentity, ByteString)]
unbundleKeyPackages Value
bundle
    (ClientIdentity, ByteString)
kp1 <- [(ClientIdentity, ByteString)] -> App (ClientIdentity, ByteString)
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (((ClientIdentity, ByteString) -> Bool)
-> [(ClientIdentity, ByteString)] -> [(ClientIdentity, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ClientIdentity -> ClientIdentity -> Bool
forall a. Eq a => a -> a -> Bool
== ClientIdentity
bob1) (ClientIdentity -> Bool)
-> ((ClientIdentity, ByteString) -> ClientIdentity)
-> (ClientIdentity, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientIdentity, ByteString) -> ClientIdentity
forall a b. (a, b) -> a
fst) [(ClientIdentity, ByteString)]
kps)
    MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
alice1 ConvId
convId [(ClientIdentity, ByteString)
kp1]
    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 => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed MessagePackage
mp

  -- this tests that bob's backend has a mapping of group id to the remote conv
  -- this test is only interesting when bob is on OtherDomain
  do
    Value
bundle <- Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1 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, ByteString)]
kps <- HasCallStack => Value -> App [(ClientIdentity, ByteString)]
Value -> App [(ClientIdentity, ByteString)]
unbundleKeyPackages Value
bundle
    (ClientIdentity, ByteString)
kp2 <- [(ClientIdentity, ByteString)] -> App (ClientIdentity, ByteString)
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (((ClientIdentity, ByteString) -> Bool)
-> [(ClientIdentity, ByteString)] -> [(ClientIdentity, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ClientIdentity -> ClientIdentity -> Bool
forall a. Eq a => a -> a -> Bool
== ClientIdentity
bob2) (ClientIdentity -> Bool)
-> ((ClientIdentity, ByteString) -> ClientIdentity)
-> (ClientIdentity, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientIdentity, ByteString) -> ClientIdentity
forall a b. (a, b) -> a
fst) [(ClientIdentity, ByteString)]
kps)
    MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
bob1 ConvId
convId [(ClientIdentity, ByteString)
kp2]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

testMixedProtocolRemovePartialClients :: (HasCallStack) => Domain -> App ()
testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App ()
testMixedProtocolRemovePartialClients 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]

  ConvId
convId <- do
    ConvId
convId <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], team = Just tid}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((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 Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
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 ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json

  [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]
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId
  (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]
  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 => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed
  MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
alice1 ConvId
convId [ClientIdentity
bob1]

  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

testMixedProtocolAppMessagesAreDenied :: (HasCallStack) => Domain -> App ()
testMixedProtocolAppMessagesAreDenied :: HasCallStack => Domain -> App ()
testMixedProtocolAppMessagesAreDenied 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]

  ConvId
convId <- do
    ConvId
convId <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], team = Just tid}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mixed") ((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 Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
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 ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json

  [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]

  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId
  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

  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 => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed

  MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
convId ClientIdentity
bob1 String
"hello, world"
  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
422
    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
"mls-unsupported-message"

testMLSProtocolUpgrade :: (HasCallStack) => Domain -> App ()
testMLSProtocolUpgrade :: HasCallStack => Domain -> App ()
testMLSProtocolUpgrade Domain
secondDomain = do
  (Value
alice, Value
bob, ConvId
convId) <- Domain -> App (Value, Value, ConvId)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value, ConvId)
simpleMixedConversationSetup Domain
secondDomain
  Value -> ConvId -> Int -> App Response
forall user conv mode.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue mode) =>
user -> conv -> mode -> App Response
updateReceiptMode Value
alice ConvId
convId (Int
9 :: Int) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  -- alice creates MLS group and bob joins
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
charlie]
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId 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 => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed
  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
convId 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 => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed

  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> (WebSocket -> App Value) -> App Value
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
bob ((WebSocket -> App Value) -> App Value)
-> (WebSocket -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    -- charlie is added to the group
    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
charlie1
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MLSProtocol -> MessagePackage -> App Value
MLSProtocol -> MessagePackage -> App Value
sendAndConsumeCommitBundleWithProtocol MLSProtocol
MLSProtocolMixed
    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
ws

  Value -> App ()
forall u. (HasCallStack, MakesValue u) => u -> App ()
supportMLS Value
alice
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mls") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-migration-criteria-not-satisfied"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mixed"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
9

  Value -> App ()
forall u. (HasCallStack, MakesValue u) => u -> App ()
supportMLS Value
bob

  [ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
alice1, ClientIdentity
bob1] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol Value
bob ConvId
convId String
"mls") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls"
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isNewMLSMessageNotif WebSocket
ws
      Value
msg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data") App ByteString -> (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
      let leafIndexCharlie :: Int
leafIndexCharlie = Int
2
      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
leafIndexCharlie
      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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"protocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testAddUserSimple :: (HasCallStack) => Ciphersuite -> CredentialType -> App ()
testAddUserSimple :: HasCallStack => Ciphersuite -> CredentialType -> App ()
testAddUserSimple Ciphersuite
suite CredentialType
ctype = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]

  ClientIdentity
bob1 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [suite], credType = ctype} Value
bob
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1
  [ClientIdentity
alice1, 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 {ciphersuites = [suite], credType = ctype}) [Value
alice, Value
bob]

  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob2
  ConvId
qcnv <- Value -> (WebSocket -> App ConvId) -> App ConvId
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App ConvId) -> App ConvId)
-> (WebSocket -> App ConvId) -> App ConvId
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    ConvId
qcnv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite ClientIdentity
alice1
    -- check that the conversation inside the ConvCreated event contains
    -- epoch and ciphersuite, regardless of the API version
    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
isConvCreateNotif WebSocket
ws
    Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
    ConvId -> App ConvId
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConvId
qcnv

  Value
resp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
qcnv [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
  [Value]
events <- Value
resp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events" 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
  do
    Value
event <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
events
    App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation.id") ConvId
qcnv.id_
    App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation.domain") ConvId
qcnv.domain
    App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type") String
"conversation.member-join"
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice)
    [Value]
members <- Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"users" 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]
memberQids <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members ((Value -> App Value) -> App [Value])
-> (Value -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Value
mem -> Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    Value
bobQid <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch [Value]
memberQids [Value
bobQid]

  -- check that bob can now see the conversation
  [Value]
convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
bob
  [ConvId]
convIds <- (Value -> App ConvId) -> [Value] -> App [ConvId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId [Value]
convs
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool
      String
"Users added to an MLS group should find it when listing conversations"
      (ConvId
qcnv ConvId -> [ConvId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ConvId]
convIds)

testRemoteAddUser :: (HasCallStack) => App ()
testRemoteAddUser :: HasCallStack => App ()
testRemoteAddUser = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
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
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
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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> Value -> Value -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember ClientIdentity
alice1 (ConvId -> Value
convIdToQidObject ConvId
conv) Value
bob String
"wire_admin") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
bob1 ConvId
conv [Value
charlie]
  -- Support for remote admins is not implemeted yet, but this shows that add
  -- proposal is being applied action
  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
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
500
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"federation-not-implemented"

testRemoteRemoveClient :: (HasCallStack) => Ciphersuite -> App ()
testRemoteRemoveClient :: HasCallStack => Ciphersuite -> App ()
testRemoteRemoveClient Ciphersuite
suite = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  [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 {ciphersuites = [suite]}) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1
  ConvId
conv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite 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
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
    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 -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteClient Value
bob ClientIdentity
bob1.client App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
predicate WebSocket
wsAlice
    App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation") (ConvId -> Value
convIdToQidObject ConvId
conv)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob)

    ByteString
mlsMsg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data")

    -- Checks that the remove proposal is consumable by alice
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
conv Ciphersuite
suite ClientIdentity
alice1 ByteString
mlsMsg
    -- This doesn't work because `sendAndConsumeCommitBundle` doesn't like
    -- remove proposals from the backend. We should fix that in future.
    -- void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle

    Value
parsedMsg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
suite ClientIdentity
alice1 ByteString
mlsMsg
    let leafIndexBob :: Int
leafIndexBob = Int
1
    Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
leafIndexBob
    Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.sender.External" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testRemoteRemoveCreatorClient :: (HasCallStack) => Ciphersuite -> App ()
testRemoteRemoveCreatorClient :: HasCallStack => Ciphersuite -> App ()
testRemoteRemoveCreatorClient Ciphersuite
suite = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  [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 {ciphersuites = [suite]}) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1
  ConvId
conv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite 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
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
bob ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteClient Value
alice ClientIdentity
alice1.client App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
predicate WebSocket
wsBob
    App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation") (ConvId -> Value
convIdToQidObject ConvId
conv)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice)

    ByteString
mlsMsg <- App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data")

    -- Checks that the remove proposal is consumable by alice
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
conv Ciphersuite
suite ClientIdentity
alice1 ByteString
mlsMsg
    -- This doesn't work because `sendAndConsumeCommitBundle` doesn't like
    -- remove proposals from the backend. We should fix that in future.
    -- void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle

    Value
parsedMsg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
suite ClientIdentity
alice1 ByteString
mlsMsg
    let leafIndexAlice :: Int
leafIndexAlice = Int
0
    Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
leafIndexAlice
    Value
parsedMsg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.sender.External" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testCreateSubConv :: (HasCallStack) => Ciphersuite -> App ()
testCreateSubConv :: HasCallStack => Ciphersuite -> App ()
testCreateSubConv Ciphersuite
suite = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  aliceClients :: [ClientIdentity]
aliceClients@(ClientIdentity
alice1 : [ClientIdentity]
_) <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 (App ClientIdentity -> App [ClientIdentity])
-> App ClientIdentity -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [suite]} Value
alice
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ (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
suite) [ClientIdentity]
aliceClients
  [ClientIdentity
bob1, ClientIdentity
bob2] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (App ClientIdentity -> App [ClientIdentity])
-> App ClientIdentity -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [suite]} Value
bob
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ (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
suite) [ClientIdentity
bob1, ClientIdentity
bob2]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite 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
alice, 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
suite ConvId
convId ClientIdentity
alice1 String
"conference"

testCreateSubConvProteus :: App ()
testCreateSubConvProteus :: App ()
testCreateSubConvProteus = 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
  ConvId
conv <- App Response -> (Response -> App ConvId) -> App ConvId
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus) ((Response -> App ConvId) -> App ConvId)
-> (Response -> App ConvId) -> App ConvId
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Response
resp.json
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation Value
alice ConvId
conv String
"conference") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testSelfConversation :: Version5 -> App ()
testSelfConversation :: Version5 -> App ()
testSelfConversation Version5
v = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
v (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ 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
  ClientIdentity
creator : [ClientIdentity]
others <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
3 Value
alice)
  (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]
others
  (String
_, Value
conv) <- HasCallStack =>
Ciphersuite -> ClientIdentity -> App (String, Value)
Ciphersuite -> ClientIdentity -> App (String, Value)
createSelfGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
creator
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
  case Version5
v of
    Version5
Version5 -> Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
    Version5
NoVersion5 -> Value -> String -> App ()
forall a. (HasCallStack, MakesValue a) => a -> String -> App ()
assertFieldMissing Value
conv String
"cipher_suite"

  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
creator ConvId
convId [Value
alice] 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
newClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  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
newClient
  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
convId ClientIdentity
newClient 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

-- | FUTUREWORK: Don't allow partial adds, not even in the first commit
testFirstCommitAllowsPartialAdds :: (HasCallStack) => App ()
testFirstCommitAllowsPartialAdds :: HasCallStack => App ()
testFirstCommitAllowsPartialAdds = 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

  [ClientIdentity
alice1, ClientIdentity
alice2, ClientIdentity
alice3] <- (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
alice]
  (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
alice2, ClientIdentity
alice2, ClientIdentity
alice3, ClientIdentity
alice3]

  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  Value
bundle <- Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  [(ClientIdentity, ByteString)]
kps <- HasCallStack => Value -> App [(ClientIdentity, ByteString)]
Value -> App [(ClientIdentity, ByteString)]
unbundleKeyPackages Value
bundle

  -- first commit only adds kp for alice2 (not alice2 and alice3)
  MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
alice1 ConvId
convId (((ClientIdentity, ByteString) -> Bool)
-> [(ClientIdentity, ByteString)] -> [(ClientIdentity, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ClientIdentity -> ClientIdentity -> Bool
forall a. Eq a => a -> a -> Bool
== ClientIdentity
alice2) (ClientIdentity -> Bool)
-> ((ClientIdentity, ByteString) -> ClientIdentity)
-> (ClientIdentity, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientIdentity, ByteString) -> ClientIdentity
forall a b. (a, b) -> a
fst) [(ClientIdentity, ByteString)]
kps)
  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
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((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
409
    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
"mls-client-mismatch"

-- @SF.Separation @TSFI.RESTfulAPI @S2
--
-- This test verifies that the server rejects a commit containing add proposals
-- that only add a proper subset of the set of clients of a user.
testAddUserPartial :: (HasCallStack) => App ()
testAddUserPartial :: HasCallStack => App ()
testAddUserPartial = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
3 Domain
OwnDomain)

  -- Bob has 3 clients, Charlie has 2
  ClientIdentity
alice1 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  bobClients :: [ClientIdentity]
bobClients@[ClientIdentity
_bob1, ClientIdentity
_bob2, ClientIdentity
bob3] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
bob)
  [ClientIdentity]
charlieClients <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
charlie)

  -- Only the first 2 clients of Bob's have uploaded key packages
  (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) (Int -> [ClientIdentity] -> [ClientIdentity]
forall a. Int -> [a] -> [a]
take Int
2 [ClientIdentity]
bobClients [ClientIdentity] -> [ClientIdentity] -> [ClientIdentity]
forall a. Semigroup a => a -> a -> a
<> [ClientIdentity]
charlieClients)

  -- alice adds bob's first 2 clients
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  -- alice sends a commit now, and should get a conflict error
  [(ClientIdentity, ByteString)]
kps <- ([[(ClientIdentity, ByteString)]]
 -> [(ClientIdentity, ByteString)])
-> App [[(ClientIdentity, ByteString)]]
-> App [(ClientIdentity, ByteString)]
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(ClientIdentity, ByteString)]] -> [(ClientIdentity, ByteString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (App [[(ClientIdentity, ByteString)]]
 -> App [(ClientIdentity, ByteString)])
-> ((Value -> App [(ClientIdentity, ByteString)])
    -> App [[(ClientIdentity, ByteString)]])
-> (Value -> App [(ClientIdentity, ByteString)])
-> App [(ClientIdentity, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value]
-> (Value -> App [(ClientIdentity, ByteString)])
-> App [[(ClientIdentity, ByteString)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
bob, Value
charlie] ((Value -> App [(ClientIdentity, ByteString)])
 -> App [(ClientIdentity, ByteString)])
-> (Value -> App [(ClientIdentity, ByteString)])
-> App [(ClientIdentity, ByteString)]
forall a b. (a -> b) -> a -> b
$ \Value
user -> do
    Value
bundle <- Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    HasCallStack => Value -> App [(ClientIdentity, ByteString)]
Value -> App [(ClientIdentity, ByteString)]
unbundleKeyPackages Value
bundle
  MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
alice1 ConvId
convId [(ClientIdentity, ByteString)]
kps

  -- before alice can commit, bob3 uploads a key package
  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
bob3

  Value
err <- HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) 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
409
  Value
err Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-client-mismatch"

-- @END

-- | admin removes user from a conversation but doesn't list all clients
testRemoveClientsIncomplete :: (HasCallStack) => App ()
testRemoveClientsIncomplete :: HasCallStack => App ()
testRemoveClientsIncomplete = 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 => 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
  MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
alice1 ConvId
convId [ClientIdentity
bob1]

  Value
err <- HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) 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
409
  Value
err Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-client-mismatch"

testAdminRemovesUserFromConv :: (HasCallStack) => Ciphersuite -> App ()
testAdminRemovesUserFromConv :: HasCallStack => Ciphersuite -> App ()
testAdminRemovesUserFromConv Ciphersuite
suite = 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 {ciphersuites = [suite]}) [Value
alice, Value
bob, Value
bob]

  App ClientIdentity -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ClientIdentity -> App ()) -> App ClientIdentity -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
u -> AddClient -> App ClientIdentity
createWireClient Value
bob AddClient
forall a. Default a => a
def
  (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
suite) [ClientIdentity
bob1, ClientIdentity
bob2]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite ClientIdentity
alice1
  let Just String
gid = ConvId
convId.groupId
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
  Value
events <- 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

  do
    Value
event <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Value
events Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events")
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ConvId -> Value
convIdToQidObject ConvId
convId
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-leave"
    Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice
    [Value]
members <- Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_ids" 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
bobQid <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch [Value]
members [Value
bobQid]

  do
    [Value]
convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
bob
    [ConvId]
convIds <- (Value -> App ConvId) -> [Value] -> App [ConvId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId [Value]
convs
    [Value]
clients <- App Response -> (Response -> App [Value]) -> App [Value]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getGroupClients Value
alice String
gid) ((Response -> App [Value]) -> App [Value])
-> (Response -> App [Value]) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client_ids" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
clients
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool
      String
"bob is not longer part of conversation after the commit"
      (ConvId
convId ConvId -> [ConvId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ConvId]
convIds)

testLocalWelcome :: (HasCallStack) => App ()
testLocalWelcome :: HasCallStack => App ()
testLocalWelcome = do
  users :: [Value]
users@[Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]

  [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]
users

  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

  MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value
bob]
  Just ByteString
welcome <- Maybe ByteString -> App (Maybe ByteString)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessagePackage
commit.welcome

  Value
es <- ClientIdentity -> (WebSocket -> App Value) -> App Value
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App Value) -> App Value)
-> (WebSocket -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
    Value
es <- HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
    let isWelcome :: a -> App Bool
isWelcome a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"

    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isWelcome WebSocket
wsBob

    App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation") (ConvId -> Value
convIdToQidObject ConvId
convId)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice)
    App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data") (ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode ByteString
welcome))
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
es

  Value
event <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Value
es Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events")
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
  Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ConvId -> Value
convIdToQidObject ConvId
convId
  Value
addedUser <- (Value
event Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.users") App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
  Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid Value
addedUser App (String, String) -> App (String, String) -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid Value
bob

testStaleCommit :: (HasCallStack) => App ()
testStaleCommit :: HasCallStack => App ()
testStaleCommit = do
  (Value
alice : [Value]
users) <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
5 Domain
OwnDomain)
  let ([Value]
users1, [Value]
users2) = Int -> [Value] -> ([Value], [Value])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 [Value]
users

  (ClientIdentity
alice1 : [ClientIdentity]
clients) <- (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 -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
users)
  (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]
clients
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  ClientGroupState
gsBackup <- HasCallStack => ClientIdentity -> App ClientGroupState
ClientIdentity -> App ClientGroupState
getClientGroupState ClientIdentity
alice1

  -- add the first batch of users to the conversation
  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]
users1 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

  -- now roll back alice1 and try to add the second batch of users
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice1 ClientGroupState
gsBackup

  MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [Value]
users2
  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
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((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
409
    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
"mls-stale-message"

testPropInvalidEpoch :: (HasCallStack) => App ()
testPropInvalidEpoch :: HasCallStack => App ()
testPropInvalidEpoch = do
  users :: [Value]
users@[Value
_alice, Value
bob, Value
charlie, Value
dee] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
4 Domain
OwnDomain)
  [ClientIdentity
alice1, ClientIdentity
bob1, ClientIdentity
charlie1, ClientIdentity
dee1] <- (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]
users
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  -- Add bob -> epoch 1
  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
  ClientGroupState
gsBackup <- HasCallStack => ClientIdentity -> App ClientGroupState
ClientIdentity -> App ClientGroupState
getClientGroupState 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
  ClientGroupState
gsBackup2 <- HasCallStack => ClientIdentity -> App ClientGroupState
ClientIdentity -> App ClientGroupState
getClientGroupState ClientIdentity
alice1

  -- try to send a proposal from an old epoch (0)
  do
    HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice1 ClientGroupState
gsBackup
    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
dee1
    [MessagePackage
prop] <- HasCallStack =>
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId ClientIdentity
alice1 [Value
dee]
    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 ClientIdentity
alice1 MessagePackage
prop.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
409
      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
"mls-stale-message"

  -- try to send a proposal from a newer epoch (2)
  do
    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
dee1
    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
charlie1
    HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice1 ClientGroupState
gsBackup2
    App MessagePackage -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App MessagePackage -> App ()) -> App MessagePackage -> 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
charlie] -- --> epoch 2
    [MessagePackage
prop] <- HasCallStack =>
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId ClientIdentity
alice1 [Value
dee]
    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 ClientIdentity
alice1 MessagePackage
prop.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
409
      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
"mls-stale-message"
    -- remove charlie from users expected to get a welcome message
    (MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
mls -> MLSState
mls {convs = Map.adjust (\MLSConv
conv -> MLSConv
conv {newMembers = mempty}) convId mls.convs}

  -- alice send a well-formed proposal and commits it
  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
dee1
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice1 ClientGroupState
gsBackup2
  HasCallStack =>
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId ClientIdentity
alice1 [Value
dee] App [MessagePackage] -> ([MessagePackage] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MessagePackage -> App Value) -> [MessagePackage] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
  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
convId 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

--- | This test submits a ReInit proposal, which is currently ignored by the
-- backend, in order to check that unsupported proposal types are accepted.
testPropUnsupported :: (HasCallStack) => App ()
testPropUnsupported :: HasCallStack => App ()
testPropUnsupported = do
  users :: [Value]
users@[Value
_alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
2 Domain
OwnDomain)
  [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]
users
  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

  MessagePackage
mp <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createReInitProposal ConvId
convId ClientIdentity
alice1

  -- we cannot consume this message, because the membership tag is fake
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

testAddUserBareProposalCommit :: (HasCallStack) => App ()
testAddUserBareProposalCommit :: HasCallStack => App ()
testAddUserBareProposalCommit = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
2 Domain
OwnDomain)
  [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]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
  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
  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 [] 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 -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId ClientIdentity
alice1 [Value
bob]
    App [MessagePackage] -> ([MessagePackage] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MessagePackage -> App Value) -> [MessagePackage] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage
  MessagePackage
commit <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId ClientIdentity
alice1
  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
$ String -> Maybe ByteString -> App ByteString
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"Expected welcome" MessagePackage
commit.welcome
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit

  -- check that bob can now see the conversation
  [Value]
convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
bob
  [ConvId]
convIds <- (Value -> App ConvId) -> [Value] -> App [ConvId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId [Value]
convs
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool
      String
"Users added to an MLS group should find it when listing conversations"
      (ConvId
convId ConvId -> [ConvId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ConvId]
convIds)

testShadowConversation :: (HasCallStack) => App ()
testShadowConversation :: HasCallStack => App ()
testShadowConversation = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
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
alice1, ClientIdentity
bob1, ClientIdentity
charlie1]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  Value
shadowConv <- ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
alice1 (CreateConv
defMLS {parent = Just convId.id_}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
shadowConvId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
shadowConv
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
shadowConvId

  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bob] (([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] 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

    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
shadowConvId [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

    Value
fetchedConversation <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversationInternal ClientIdentity
alice1 ConvId
shadowConvId) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json
    Value
fetchedMembers <- Value
fetchedConversation Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members"
    let extractId :: a -> App Value
extractId a
x = a
x a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    [Value]
fetchedOtherMembers <- Value
fetchedMembers Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [Value]
fetchedOtherMemberIds <- (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App Value
forall a. MakesValue a => a -> App Value
extractId [Value]
fetchedOtherMembers
    [Value]
expectedMemberIds <- (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App Value
forall a. MakesValue a => a -> App Value
extractId [Value
alice, Value
bob, Value
charlie]
    [Value] -> [Value]
forall a. Ord a => [a] -> [a]
sort ([Value] -> [Value]
forall a. Eq a => [a] -> [a]
nub [Value]
fetchedOtherMemberIds) [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value] -> [Value]
forall a. Ord a => [a] -> [a]
sort [Value]
expectedMemberIds

testShadowConversationDenied :: (HasCallStack) => App ()
testShadowConversationDenied :: HasCallStack => App ()
testShadowConversationDenied = 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] <- (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 => 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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
bob1 (CreateConv
defMLS {parent = Just convId.id_})) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testPropExistingConv :: (HasCallStack) => App ()
testPropExistingConv :: HasCallStack => App ()
testPropExistingConv = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
2 Domain
OwnDomain)
  [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 => 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 [] 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
res <- HasCallStack =>
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId 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
>>= (MessagePackage -> App Value) -> [MessagePackage] -> 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 HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
  App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events")

-- @SF.Separation @TSFI.RESTfulAPI @S2
--
-- This test verifies that the server rejects any commit that does not
-- reference all pending proposals in an MLS group.
testCommitNotReferencingAllProposals :: (HasCallStack) => App ()
testCommitNotReferencingAllProposals :: HasCallStack => App ()
testCommitNotReferencingAllProposals = do
  users :: [Value]
users@[Value
_alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers (Int -> Domain -> [Domain]
forall a. Int -> a -> [a]
replicate Int
3 Domain
OwnDomain)

  [ClientIdentity
alice1, ClientIdentity
bob1, 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]
users
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
  (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
charlie1]
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
convId [] 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

  ClientGroupState
gsBackup <- HasCallStack => ClientIdentity -> App ClientGroupState
ClientIdentity -> App ClientGroupState
getClientGroupState ClientIdentity
alice1

  -- create proposals for bob and charlie
  HasCallStack =>
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
createAddProposals ConvId
convId ClientIdentity
alice1 [Value
bob, Value
charlie]
    App [MessagePackage] -> ([MessagePackage] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MessagePackage -> App Value) -> [MessagePackage] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage

  -- now create a commit referencing only the first proposal
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice1 ClientGroupState
gsBackup
  MessagePackage
commit <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId ClientIdentity
alice1

  -- send commit and expect and error
  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
postMLSCommitBundle ClientIdentity
alice1 (MessagePackage -> ByteString
mkBundle MessagePackage
commit)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-commit-missing-references"

-- @END

testUnsupportedCiphersuite :: (HasCallStack) => App ()
testUnsupportedCiphersuite :: HasCallStack => App ()
testUnsupportedCiphersuite = do
  let suite :: Ciphersuite
suite = (String -> Ciphersuite
Ciphersuite String
"0x0003")
  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
  ClientIdentity
alice1 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [suite]} Value
alice
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite ClientIdentity
alice1

  MessagePackage
mp <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId ClientIdentity
alice1

  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
postMLSCommitBundle ClientIdentity
alice1 (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"

testBackendRemoveProposal :: (HasCallStack) => Ciphersuite -> Domain -> App ()
testBackendRemoveProposal :: HasCallStack => Ciphersuite -> Domain -> App ()
testBackendRemoveProposal Ciphersuite
suite Domain
domain = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
domain]
  (ClientIdentity
alice1 : [ClientIdentity]
bobClients) <- (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 {ciphersuites = [suite]}) [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
suite) [ClientIdentity]
bobClients
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite 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

  let isRemoveProposalFor :: Int -> Value -> App Bool
      isRemoveProposalFor :: Int -> Value -> App Bool
isRemoveProposalFor Int
index Value
e =
        Value -> App Bool
forall a. MakesValue a => a -> App Bool
isNewMLSMessageNotif Value
e App Bool -> App Bool -> App Bool
&&~ do
          ByteString
msgData <- Value
e 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
          Value
msg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
suite ClientIdentity
alice1 ByteString
msgData
          Value -> String -> Int -> App Bool
forall a b.
(MakesValue a, MakesValue b) =>
a -> String -> b -> App Bool
fieldEquals Value
msg String
"message.content.body.Proposal.Remove.removed" Int
index

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 \WebSocket
ws -> do
    Value -> App ()
forall u. (HasCallStack, MakesValue u) => u -> App ()
deleteUser Value
bob
    [(Int, ClientIdentity)]
-> ((Int, ClientIdentity) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int] -> [ClientIdentity] -> [(Int, ClientIdentity)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [ClientIdentity]
bobClients) \(Int
index, ClientIdentity
_) -> 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 =>
(Value -> App Bool)
-> ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
(Value -> App Bool)
-> ConvId
-> Ciphersuite
-> ClientIdentity
-> Maybe MessagePackage
-> WebSocket
-> App Value
consumeMessageWithPredicate (Int -> Value -> App Bool
isRemoveProposalFor Int
index) ConvId
convId Ciphersuite
suite ClientIdentity
alice1 Maybe MessagePackage
forall a. Maybe a
Nothing WebSocket
ws

  String
bobUser <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  (MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
mls ->
    MLSState
mls
      { convs =
          Map.adjust
            ( \MLSConv
conv ->
                MLSConv
conv
                  { members = Set.filter (\ClientIdentity
m -> ClientIdentity
m.user String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
bobUser) conv.members,
                    memberUsers = Set.filter (\Value
quid -> Value
quid Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= ([ClientIdentity] -> ClientIdentity
forall a. HasCallStack => [a] -> a
head [ClientIdentity]
bobClients).qualifiedUserId) conv.memberUsers
                  }
            )
            convId
            mls.convs
      }

  -- alice commits the external proposals
  Value
r <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId 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
  App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events"

testExternalCommitDuplicateClient :: (HasCallStack) => App ()
testExternalCommitDuplicateClient :: HasCallStack => App ()
testExternalCommitDuplicateClient = 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
  [ClientIdentity
creator, ClientIdentity
other] <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
2 Value
alice)
  (String
_, Value
conv) <- HasCallStack =>
Ciphersuite -> ClientIdentity -> App (String, Value)
Ciphersuite -> ClientIdentity -> App (String, Value)
createSelfGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
creator
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  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
creator ConvId
convId [Value
alice] 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

  Int -> App String -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (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
other
  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
convId ClientIdentity
other 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

  -- reset client state
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
other ClientGroupState
forall a. Default a => a
def

  -- rejoin with the same client without removing the existing leaf node
  MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
convId ClientIdentity
other Maybe ByteString
forall a. Maybe a
Nothing
  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
postMLSCommitBundle ClientIdentity
other (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"

testInternalCommitDuplicateClient :: (HasCallStack) => App ()
testInternalCommitDuplicateClient :: HasCallStack => App ()
testInternalCommitDuplicateClient = 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
  [ClientIdentity
alice1, ClientIdentity
alice2] <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
2 Value
alice)
  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
alice] 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
  Int -> App String -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (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
alice2
  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
alice] 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

  -- wipe key store
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice2 ClientGroupState
forall a. Default a => a
def
  (ByteString
kp, String
_) <- HasCallStack =>
ClientIdentity -> Ciphersuite -> App (ByteString, String)
ClientIdentity -> Ciphersuite -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice2 Ciphersuite
forall a. Default a => a
def

  -- We cannot upload the new key package at this point, because the
  -- signature key won't match. However, alice1 can still use it to craft an
  -- add proposal.
  MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
alice1 ConvId
convId [(ClientIdentity
alice2, ByteString
kp)]
  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
postMLSCommitBundle ClientIdentity
alice1 (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"

testExternalCommitWrongSignatureKey :: (HasCallStack) => App ()
testExternalCommitWrongSignatureKey :: HasCallStack => App ()
testExternalCommitWrongSignatureKey = 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
  [ClientIdentity
creator, ClientIdentity
other] <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
2 Value
alice)
  (String
_, Value
conv) <- HasCallStack =>
Ciphersuite -> ClientIdentity -> App (String, Value)
Ciphersuite -> ClientIdentity -> App (String, Value)
createSelfGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
creator
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  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
creator ConvId
convId [Value
alice] 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 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
other

  -- reset client state
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
other ClientGroupState
forall a. Default a => a
def

  -- rejoin with another client and a mismatched signature key
  MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
convId ClientIdentity
other Maybe ByteString
forall a. Maybe a
Nothing
  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
postMLSCommitBundle ClientIdentity
other (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-identity-mismatch"

testInternalCommitWrongSignatureKey :: (HasCallStack) => App ()
testInternalCommitWrongSignatureKey :: HasCallStack => App ()
testInternalCommitWrongSignatureKey = 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
  [ClientIdentity
alice1, ClientIdentity
alice2] <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
2 Value
alice)
  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
alice] 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

  -- wipe key store and make a new key package
  HasCallStack => ClientIdentity -> ClientGroupState -> App ()
ClientIdentity -> ClientGroupState -> App ()
setClientGroupState ClientIdentity
alice2 ClientGroupState
forall a. Default a => a
def
  (ByteString
kp, String
_) <- HasCallStack =>
ClientIdentity -> Ciphersuite -> App (ByteString, String)
ClientIdentity -> Ciphersuite -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice2 Ciphersuite
forall a. Default a => a
def

  MessagePackage
mp <- HasCallStack =>
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
ClientIdentity
-> ConvId -> [(ClientIdentity, ByteString)] -> App MessagePackage
createAddCommitWithKeyPackages ClientIdentity
alice1 ConvId
convId [(ClientIdentity
alice2, ByteString
kp)]
  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
postMLSCommitBundle ClientIdentity
alice1 (MessagePackage -> ByteString
mkBundle MessagePackage
mp)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-identity-mismatch"

testRemoteAddLegacy :: (HasCallStack) => AnyFedDomain -> App ()
testRemoteAddLegacy :: HasCallStack => AnyFedDomain -> App ()
testRemoteAddLegacy AnyFedDomain
domain = do
  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AnyFedDomain -> Integer
unFedDomain AnyFedDomain
domain Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    let suite :: Ciphersuite
suite = String -> Ciphersuite
Ciphersuite String
"0x0001"
    Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    Value
bob <- AnyFedDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser AnyFedDomain
domain CreateUser
forall a. Default a => a
def
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers 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 {ciphersuites = [suite]}) [Value
alice, Value
bob]
    App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1
    ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
suite 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
alice, 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

testInvalidLeafNodeSignature :: (HasCallStack) => App ()
testInvalidLeafNodeSignature :: HasCallStack => App ()
testInvalidLeafNodeSignature = 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
  [ClientIdentity
creator, ClientIdentity
other] <- (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) (Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
2 Value
alice)
  (String
_, Value
conv) <- HasCallStack =>
Ciphersuite -> ClientIdentity -> App (String, Value)
Ciphersuite -> ClientIdentity -> App (String, Value)
createSelfGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
creator
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  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
creator ConvId
convId [Value
alice] 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 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
other

  MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
convId ClientIdentity
other Maybe ByteString
forall a. Maybe a
Nothing
  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
postMLSCommitBundle ClientIdentity
other (MessagePackage -> ByteString
mkBundle MessagePackage
mp {message = makeSignatureCorrupt 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
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-invalid-leaf-node-signature"
  where
    -- This is a hack to make the signature invalid.
    -- It works as long as the format of the MLS message does not change
    -- in any way that changes the offset of the signature.
    -- If this test ever starts flaking, we should consider
    -- factoring the MLS code out of wire-api into a separate shared package
    -- and use it in this test to invalidate the signature.
    makeSignatureCorrupt :: ByteString -> ByteString
    makeSignatureCorrupt :: ByteString -> ByteString
makeSignatureCorrupt ByteString
bs = case Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
0xb0 ByteString
bs of
      (ByteString
left, ByteString
right) -> case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
right of
        Just (Word8
h, ByteString
t) -> ByteString
left ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton (Word8
h Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0x01) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t
        Maybe (Word8, ByteString)
Nothing -> ByteString
bs

testGroupInfoMismatch :: (HasCallStack) => App ()
testGroupInfoMismatch :: HasCallStack => App ()
testGroupInfoMismatch = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  (ServiceOverrides
forall a. Default a => a
def {galleyCfg = setField "settings.checkGroupInfo" True})
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    [Value
alice, Value
bob, Value
charlie] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain, String
domain]
    [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 => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity
bob1, ClientIdentity
charlie1]
    ConvId
conv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

    MessagePackage
mp1 <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
conv [Value
bob]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
mp1

    -- attempt a commit with an old group info
    MessagePackage
mp2 <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
conv [Value
charlie]
    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
postMLSCommitBundle MessagePackage
mp2.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp2 {groupInfo = mp1.groupInfo}))
      ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-info-mismatch"

    -- check that epoch is still 1
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

    -- attempt an external commit with an old group info
    App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob2
    MessagePackage
mp3 <- HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
conv ClientIdentity
bob2 Maybe ByteString
forall a. Maybe a
Nothing
    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
postMLSCommitBundle ClientIdentity
bob2 (MessagePackage -> ByteString
mkBundle MessagePackage
mp3 {groupInfo = mp1.groupInfo}))
      ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-info-mismatch"

    -- check that epoch is still 1
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

testGroupInfoCheckDisabled :: (HasCallStack) => App ()
testGroupInfoCheckDisabled :: HasCallStack => App ()
testGroupInfoCheckDisabled = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, 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
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
charlie1]
  ConvId
conv <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  MessagePackage
mp1 <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
conv [Value
bob]
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
mp1

  -- attempt a commit with an old group info
  MessagePackage
mp2 <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
conv [Value
charlie]
  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
postMLSCommitBundle MessagePackage
mp2.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp2 {groupInfo = mp1.groupInfo}))
    ((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