-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.MLS.One2One where

import API.Brig
import API.Galley
import Control.Concurrent.Async
import Control.Concurrent.MVar
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Read as T
import MLS.Util
import Notifications
import SetupHelpers
import Test.Version
import Testlib.Prelude
import Testlib.VersionedFed

testGetMLSOne2OneLocalV5 :: (HasCallStack) => App ()
testGetMLSOne2OneLocalV5 :: HasCallStack => App ()
testGetMLSOne2OneLocalV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  let assertConvData :: a -> App ()
assertConvData a
conv = do
        a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
        a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  Value
convId <-
    Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Value
conv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
      App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")

      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv

      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"

  -- check that the conversation has the same ID on the other side
  Value
conv2 <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json

  Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
  Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
convId
  Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv2

testGetMLSOne2OneRemoteV5 :: (HasCallStack) => App ()
testGetMLSOne2OneRemoteV5 :: HasCallStack => App ()
testGetMLSOne2OneRemoteV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-federated-one2one-not-supported"

  Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-federated-one2one-not-supported"

testGetMLSOne2One :: (HasCallStack) => Domain -> App ()
testGetMLSOne2One :: HasCallStack => Domain -> App ()
testGetMLSOne2One Domain
bobDomain = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
bobDomain]
  String
bobDomainStr <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
bobDomain
  let assertConvData :: a -> App ()
assertConvData a
conv = do
        a
conv a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
        a -> String -> App ()
forall a. (HasCallStack, MakesValue a) => a -> String -> App ()
assertFieldMissing a
conv String
"cipher_suite"

  Value
mlsOne2OneConv <-
    Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Value
one2oneConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      String
convOwnerDomain <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id.domain"
      let user :: Value
user = if String
convOwnerDomain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bobDomainStr then Value
bob else Value
alice
      Value
ownerDomainPublicKeys <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

      Value
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
ownerDomainPublicKeys

      Value
conv <- Value
one2oneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
      App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv

      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
one2oneConv

  -- check that the conversation has the same ID on the other side
  Value
mlsOne2OneConv2 <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json

  Value
conv2 <- Value
mlsOne2OneConv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
  Value
conv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
mlsOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")
  Value
mlsOne2OneConv2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
mlsOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_keys")
  Value -> App ()
forall {a}. MakesValue a => a -> App ()
assertConvData Value
conv2

testMLSOne2OneOtherMember :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneOtherMember :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneOtherMember One2OneScenario
scenario = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
      convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
  Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
 HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  do
    Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
    Value
bobOne2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobOne2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")

  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

  -- Make sure the membership info is OK both for the MLS 1-to-1 endpoint and
  -- for the general conversation fetching endpoint.
  let assertOthers :: (HasCallStack, MakesValue other, MakesValue retrievedConv) => other -> retrievedConv -> App ()
      assertOthers :: forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers other
other retrievedConv
retrievedConv = do
        [Value]
othersObj <- retrievedConv
retrievedConv retrievedConv -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
        Value
otherActual <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
othersObj
        Value
otherActual Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (other
other other -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
  [(Value, Value)] -> ((Value, Value) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Value
alice, Value
bob), (Value
bob, Value
alice)] (((Value, Value) -> App ()) -> App ())
-> ((Value, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
self, Value
other) -> do
    Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
self Value
other App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Value
retrievedConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")
      Value -> Value -> App ()
forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers Value
other Value
retrievedConv
    Value -> App Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getConversation Value
self (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Value
retrievedConv <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      Value -> Value -> App ()
forall other retrievedConv.
(HasCallStack, MakesValue other, MakesValue retrievedConv) =>
other -> retrievedConv -> App ()
assertOthers Value
other Value
retrievedConv

testMLSOne2OneRemoveClientLocalV5 :: App ()
testMLSOne2OneRemoveClientLocalV5 :: App ()
testMLSOne2OneRemoveClientLocalV5 = Version5 -> App () -> App ()
forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  Value
conv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ConvId
convId

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

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
    ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
bob ClientIdentity
bob1.client App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsAlice
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob)

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

    -- 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
convId Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 ByteString
mlsMsg

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

testGetMLSOne2OneUnconnected :: (HasCallStack) => Domain -> App ()
testGetMLSOne2OneUnconnected :: HasCallStack => Domain -> App ()
testGetMLSOne2OneUnconnected Domain
otherDomain = do
  [Value
alice, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
otherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Domain
domain -> Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
domain CreateUser
forall a. Default a => a
def

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testMLSOne2OneBlocked :: (HasCallStack) => Domain -> App ()
testMLSOne2OneBlocked :: HasCallStack => Domain -> App ()
testMLSOne2OneBlocked Domain
otherDomain = do
  [Value
alice, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
otherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ (Domain -> CreateUser -> App Value)
-> CreateUser -> Domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
postConnection Value
bob Value
alice App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403

-- | Alice and Bob are initially connected, but then Alice blocks Bob.
testMLSOne2OneBlockedAfterConnected :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneBlockedAfterConnected :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneBlockedAfterConnected One2OneScenario
scenario = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
      convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
  Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
 HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
  do
    Value
bobConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")

  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
  MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    -- Alice blocks Bob
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    -- There is also a proteus 1-to-1 conversation. Neither it nor the MLS
    -- 1-to-1 conversation should get any events.
    Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
2 WebSocket
ws App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)
    -- Alice is not in the MLS 1-to-1 conversation given that she has blocked
    -- 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
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403

  MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
bob1 String
"hello, world, again"
  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSMessage MessagePackage
mp.sender MessagePackage
mp.message App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
    Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
2 WebSocket
ws App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)

-- | Alice and Bob are initially connected, then Alice blocks Bob, and finally
-- Alice unblocks Bob.
testMLSOne2OneUnblocked :: (HasCallStack) => One2OneScenario -> App ()
testMLSOne2OneUnblocked :: HasCallStack => One2OneScenario -> App ()
testMLSOne2OneUnblocked One2OneScenario
scenario = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
      convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
  Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
 HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  do
    Value
convId <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id"
    Value
bobConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
bob Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    Value
convId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bobConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.qualified_id")

  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob1
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv
  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit
    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

  -- Alice blocks Bob
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403

  -- Reset the group membership in the test setup as only 'bob1' is left in
  -- reality, even though the test state believes 'alice1' is still part of the
  -- conversation.
  (MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
s -> MLSState
s {convs = Map.adjust (\MLSConv
conv -> MLSConv
conv {members = Set.singleton bob1}) one2OneConvId s.convs}

  -- Bob creates a new client and adds it to the one-to-one conversation just so
  -- that the epoch advances.
  ClientIdentity
bob2 <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
bob
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
bob2
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
bob1 ConvId
one2OneConvId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  -- Alice finally unblocks Bob
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"accepted" App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

  -- Alice rejoins via an external commit
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
one2OneConvId ClientIdentity
alice1 Maybe ByteString
forall a. Maybe a
Nothing App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  -- Check that an application message can get to Bob
  [ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
bob1, ClientIdentity
bob2] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
alice1 String
"hello, I've always been here"
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage MessagePackage
mp
    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
      Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode MessagePackage
mp.message)

testGetMLSOne2OneSameTeam :: App ()
testGetMLSOne2OneSameTeam :: App ()
testGetMLSOne2OneSameTeam = do
  (Value
alice, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
bob <- Value -> App Value
forall u. (HasCallStack, MakesValue u) => u -> App Value
addUserToTeam Value
alice
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

data One2OneScenario
  = -- | Both users are local
    One2OneScenarioLocal
  | -- | One user is remote, conversation is local
    One2OneScenarioLocalConv
  | -- | One user is remote, conversation is remote
    One2OneScenarioRemoteConv

instance TestCases One2OneScenario where
  mkTestCases :: IO [TestCase One2OneScenario]
mkTestCases =
    [TestCase One2OneScenario] -> IO [TestCase One2OneScenario]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=own]" One2OneScenario
One2OneScenarioLocal,
        String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=other;conv=own]" One2OneScenario
One2OneScenarioLocalConv,
        String -> One2OneScenario -> TestCase One2OneScenario
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=other;conv=other]" One2OneScenario
One2OneScenarioRemoteConv
      ]

one2OneScenarioUserDomain :: One2OneScenario -> Domain
one2OneScenarioUserDomain :: One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
One2OneScenarioLocal = Domain
OwnDomain
one2OneScenarioUserDomain One2OneScenario
_ = Domain
OtherDomain

one2OneScenarioConvDomain :: One2OneScenario -> Domain
one2OneScenarioConvDomain :: One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioLocal = Domain
OwnDomain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioLocalConv = Domain
OwnDomain
one2OneScenarioConvDomain One2OneScenario
One2OneScenarioRemoteConv = Domain
OtherDomain

testMLSOne2One :: (HasCallStack) => Ciphersuite -> One2OneScenario -> App ()
testMLSOne2One :: HasCallStack => Ciphersuite -> One2OneScenario -> App ()
testMLSOne2One Ciphersuite
suite One2OneScenario
scenario = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let otherDomain :: Domain
otherDomain = One2OneScenario -> Domain
one2OneScenarioUserDomain One2OneScenario
scenario
      convDomain :: Domain
convDomain = One2OneScenario -> Domain
one2OneScenarioConvDomain One2OneScenario
scenario
  Value
bob <- Domain -> Value -> Domain -> App Value
forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
 HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner Domain
otherDomain Value
alice Domain
convDomain
  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
suite InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
suite ClientIdentity
bob1

  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
suite ClientIdentity
alice1 Value
one2OneConv

  MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit

    let isWelcome :: a -> App Bool
isWelcome a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isWelcome WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMemberJoinNotif WebSocket
ws

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    MessagePackage
mp <- HasCallStack =>
ConvId -> ClientIdentity -> String -> App MessagePackage
ConvId -> ClientIdentity -> String -> App MessagePackage
createApplicationMessage ConvId
one2OneConvId ClientIdentity
alice1 String
"hello, world"
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeMessage MessagePackage
mp
    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
ws
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode MessagePackage
mp.message)

  -- Send another commit. This verifies that the backend has correctly updated
  -- the cipersuite of this 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 => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
one2OneConvId ClientIdentity
alice1 App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  Value
one2OneConv' <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  (Int
suiteCode, Text
_) <- Either String (Int, Text) -> App (Int, Text)
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne (Either String (Int, Text) -> App (Int, Text))
-> Either String (Int, Text) -> App (Int, Text)
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
T.hexadecimal (String -> Text
T.pack Ciphersuite
suite.code)
  Value
one2OneConv' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation.cipher_suite" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
suiteCode

-- | This test verifies that one-to-one conversations are created inside the
-- commit lock. There used to be an issue where a conversation could be
-- partially created at the time of setting its ciphersuite, resulting in an
-- incomplete database entry that would prevent further uses of the
-- conversation.
testMLSGhostOne2OneConv :: App ()
testMLSGhostOne2OneConv :: App ()
testMLSGhostOne2OneConv = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain]
  [ClientIdentity
alice1, ClientIdentity
bob1, ClientIdentity
bob2] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob, Value
bob]
  (ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity
bob1, ClientIdentity
bob2]
  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
one2OneConv

  MVar ()
doneVar <- IO (MVar ()) -> App (MVar ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> App (MVar ())) -> IO (MVar ()) -> App (MVar ())
forall a b. (a -> b) -> a -> b
$ IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  let checkConversation :: App ()
checkConversation =
        IO (Maybe ()) -> App (Maybe ())
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
doneVar) App (Maybe ()) -> (Maybe () -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe ()
Nothing -> do
            App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getConversation Value
alice (Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
              Response
resp.status Int -> [Int] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchOneOf` [Int
404 :: Int, Int
403, Int
200]

            App ()
checkConversation
          Just ()
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  IO ()
checkConversationIO <- App () -> App (IO ())
forall a. App a -> App (IO a)
appToIO App ()
checkConversation

  IO ()
createCommit <-
    App () -> App (IO ())
forall a. App a -> App (IO a)
appToIO
      (App () -> App (IO ())) -> App () -> App (IO ())
forall a b. (a -> b) -> a -> b
$ App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
      App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO ()
checkConversationIO ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
a -> do
    IO ()
createCommit
    IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneVar ()
    Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
a

-- [NOTE: Federated 1:1 MLS Conversations]
-- 1:1 Conversations shouldn't work when there is no way for the creator to know
-- the MLS public keys of the backend which will host this conversation. In
-- federation API V2, this will always work and has been tested above. When one
-- of the backends doesn't support federation API v2, the 1:1 conversation can
-- still be created but only by the user whose backend hosts this conversation.

-- | See Note: [Federated 1:1 MLS Conversations]
-- To run locally this test requires federation-v1 docker containers to be up and running.
-- See `deploy/dockerephemeral/run.sh` and comment on `StaticFedDomain` in `Testlib/VersionedFed.hs` for more details.
testMLSFederationV1ConvOnOldBackend :: App ()
testMLSFederationV1ConvOnOldBackend :: App ()
testMLSFederationV1ConvOnOldBackend = do
  let cs :: Ciphersuite
cs = String -> Ciphersuite
Ciphersuite String
"0x0001"
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let createBob :: App Value
createBob = do
        Value
bobCandidate <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser (Integer -> StaticDomain
StaticFedDomain Integer
1) CreateUser
forall a. Default a => a
def
        [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bobCandidate]
        Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bobCandidate App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
          if Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
533
            then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
bobCandidate
            else App Value
createBob

  Value
bob <- App Value
createBob
  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
cs InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
cs ClientIdentity
alice1

  -- Alice cannot start this conversation because it would exist on Bob's
  -- backend and Alice cannot get the MLS public keys of that backend.
  Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Value
fedError <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
533 Response
resp
    Value
fedError Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"federation-version-error"

  Value
conv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  Value
keys <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  Ciphersuite -> ClientIdentity -> Value -> Value -> App ()
forall conv keys.
(HasCallStack, MakesValue conv, MakesValue keys) =>
Ciphersuite -> ClientIdentity -> conv -> keys -> App ()
resetOne2OneGroupGeneric Ciphersuite
cs ClientIdentity
bob1 Value
conv Value
keys

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
bob1 ConvId
convId [Value
alice]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit

    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
wsAlice
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
    ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
alice ClientIdentity
alice1.client App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200

    let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsBob
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
alice)

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

    -- Checks that the remove proposal is consumable by bob
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
convId Ciphersuite
cs ClientIdentity
bob1 ByteString
mlsMsg

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

-- | See Note: Federated 1:1 MLS Conversations
-- To run locally this test requires federation-v1 docker containers to be up and running.
-- See `deploy/dockerephemeral/run.sh` and comment on `StaticFedDomain` in `Testlib/VersionedFed.hs` for more details.
testMLSFederationV1ConvOnNewBackend :: App ()
testMLSFederationV1ConvOnNewBackend :: App ()
testMLSFederationV1ConvOnNewBackend = do
  let cs :: Ciphersuite
cs = String -> Ciphersuite
Ciphersuite String
"0x0001"
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let createBob :: App Value
createBob = do
        Value
bobCandidate <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser (Integer -> StaticDomain
StaticFedDomain Integer
1) CreateUser
forall a. Default a => a
def
        [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bobCandidate]
        Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bobCandidate App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
          if Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200
            then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
bobCandidate
            else App Value
createBob

  Value
bob <- App Value
createBob
  [ClientIdentity
alice1, ClientIdentity
bob1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
cs InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
cs ClientIdentity
bob1

  -- Bob cannot start this conversation because it would exist on Alice's
  -- backend and Bob cannot get the MLS public keys of that backend.
  Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversationLegacy Value
bob Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Value
fedError <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
533 Response
resp
    Value
fedError Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"federation-remote-error"

  Value
one2OneConv <- Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  ConvId
one2OneConvId <- App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (App Value -> App ConvId) -> App Value -> App ConvId
forall a b. (a -> b) -> a -> b
$ Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Value
conv <- Value
one2OneConv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation"
  Ciphersuite -> ClientIdentity -> Value -> App ()
forall one2OneConv.
(HasCallStack, MakesValue one2OneConv) =>
Ciphersuite -> ClientIdentity -> one2OneConv -> App ()
resetOne2OneGroup Ciphersuite
cs ClientIdentity
alice1 Value
one2OneConv

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
bob1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsBob -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
alice1 ConvId
one2OneConvId [Value
bob]
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle MessagePackage
commit

    let isMessage :: a -> App Bool
isMessage a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-welcome"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
isMessage WebSocket
wsBob
    Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ByteString -> String
B8.unpack (ByteString -> ByteString
Base64.encode (Maybe ByteString -> ByteString
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold MessagePackage
commit.welcome))

  ClientIdentity -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket ClientIdentity
alice1 ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsAlice -> do
    ByteString
_ <- Value -> String -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
deleteClient Value
bob ClientIdentity
bob1.client App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200

    let predicate :: a -> App Bool
predicate a
n = a -> App Value
forall a. MakesValue a => a -> App Value
nPayload a
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"conversation.mls-message-add"
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall {a}. MakesValue a => a -> App Bool
predicate WebSocket
wsAlice
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv)
    App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
shouldMatch (Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"from") (Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob)

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

    -- Checks that the remove proposal is consumable by bob
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
ConvId
-> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
mlsCliConsume ConvId
one2OneConvId Ciphersuite
cs ClientIdentity
alice1 ByteString
mlsMsg

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