{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- 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.Channels where

import API.Common (randomName)
import API.Galley
import API.GalleyInternal hiding (getConversation, setTeamFeatureConfig)
import qualified API.GalleyInternal as I
import GHC.Stack
import MLS.Util
import Notifications (isChannelAddPermissionUpdate, isMemberJoinNotif, isWelcomeNotif)
import SetupHelpers
import Testlib.JSON
import Testlib.Prelude
import Testlib.VersionedFed (FedDomain)

testCreateChannelEveryone :: (HasCallStack) => App ()
testCreateChannelEveryone :: HasCallStack => App ()
testCreateChannelEveryone = do
  (Value
owner, String
tid, Value
mem : [Value]
otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  Value
partner <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity]
otherClients <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
otherTeamMembers ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ClientIdentity
memClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
ownerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
partnerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: [ClientIdentity]
otherClients) (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
ownerClient String
tid [Value]
otherTeamMembers
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
memClient String
tid [Value]
otherTeamMembers
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
partnerClient String
tid [Value]
otherTeamMembers

testCreateChannelMembersOnly :: (HasCallStack) => App ()
testCreateChannelMembersOnly :: HasCallStack => App ()
testCreateChannelMembersOnly = do
  (Value
owner, String
tid, Value
mem : [Value]
otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  Value
partner <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity]
otherClients <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
otherTeamMembers ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ClientIdentity
memClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
ownerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
partnerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: [ClientIdentity]
otherClients) (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"team-members")
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
ownerClient String
tid [Value]
otherTeamMembers
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
memClient String
tid [Value]
otherTeamMembers
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
partnerClient String
tid

testCreateChannelAdminsOnly :: (HasCallStack) => App ()
testCreateChannelAdminsOnly :: HasCallStack => App ()
testCreateChannelAdminsOnly = do
  (Value
owner, String
tid, Value
mem : [Value]
otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  Value
partner <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity]
otherClients <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
otherTeamMembers ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ClientIdentity
memClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
ownerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
partnerClient ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: [ClientIdentity]
otherClients) (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"admins")
  HasCallStack => ClientIdentity -> String -> [Value] -> App ()
ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
ownerClient String
tid [Value]
otherTeamMembers
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
memClient String
tid
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
partnerClient String
tid

testCreateChannelFeatureDisabled :: (HasCallStack) => App ()
testCreateChannelFeatureDisabled :: HasCallStack => App ()
testCreateChannelFeatureDisabled = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  ClientIdentity
ownerClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
owner
  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
ownerClient
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"channels-not-enabled" ClientIdentity
ownerClient String
tid

testCreateChannelNonTeamConvNotAllowed :: (HasCallStack) => App ()
testCreateChannelNonTeamConvNotAllowed :: HasCallStack => App ()
testCreateChannelNonTeamConvNotAllowed = do
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  ClientIdentity
userClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
user
  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
userClient
  ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
userClient CreateConv
defMLS {groupConvType = Just "channel"} 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
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"operation-denied"

testCreateChannelProteusNotAllowed :: (HasCallStack) => App ()
testCreateChannelProteusNotAllowed :: HasCallStack => App ()
testCreateChannelProteusNotAllowed = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
defProteus {groupConvType = Just "channel", team = Just tid} 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
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"not-mls-conversation"

assertCreateChannelSuccess_ :: (HasCallStack) => ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ :: HasCallStack => ClientIdentity -> String -> [Value] -> App ()
assertCreateChannelSuccess_ ClientIdentity
client String
tid [Value]
members = App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => ClientIdentity -> String -> [Value] -> App Value
ClientIdentity -> String -> [Value] -> App Value
assertCreateChannelSuccess ClientIdentity
client String
tid [Value]
members

assertCreateChannelSuccess :: (HasCallStack) => ClientIdentity -> String -> [Value] -> App Value
assertCreateChannelSuccess :: HasCallStack => ClientIdentity -> String -> [Value] -> App Value
assertCreateChannelSuccess ClientIdentity
client String
tid [Value]
members = do
  Value
conv <-
    ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
      ClientIdentity
client
      CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, addPermission = Just "admins"}
      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
  Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"group_conv_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"channel"
  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
client ConvId
convId
  Value
resp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
client ConvId
convId [Value]
members 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
resp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events.0.data.user_ids" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList) App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
  Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
conv

assertCreateChannelFailure :: (HasCallStack) => String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure :: HasCallStack => String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
label ClientIdentity
client String
tid = do
  ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
client CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} 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
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
label

config :: String -> Value
config :: String -> Value
config String
perms =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"allowed_to_create_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms,
            String
"allowed_to_open_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms
          ]
    ]

testTeamAdminPermissions :: (HasCallStack) => App ()
testTeamAdminPermissions :: HasCallStack => App ()
testTeamAdminPermissions = do
  (Value
owner, String
tid, Value
mem : Value
nonAdmin : [Value]
mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
10
  clients :: [ClientIdentity]
clients@(ClientIdentity
ownerClient : ClientIdentity
memClient : ClientIdentity
nonAdminClient : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Value
owner Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Value
mem Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Value
nonAdmin Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
mems) ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
clients (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")

  -- a member creates a channel
  Value
conv <- ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
memClient CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  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
memClient ConvId
convId

  -- other team members are added to the channel
  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
memClient ConvId
convId [Value
owner, Value
nonAdmin] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
mem (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
owner, Value
nonAdmin] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
members ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
m -> do
      Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"

  let otherMembers :: [(Value, ClientIdentity)]
otherMembers = [Value]
mems [Value] -> [ClientIdentity] -> [(Value, ClientIdentity)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Int -> [ClientIdentity] -> [ClientIdentity]
forall a. Int -> [a] -> [a]
drop Int
3 [ClientIdentity]
clients

  HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
assertChannelAdminPermission ConvId
convId Value
conv Value
mem ClientIdentity
memClient ([(Value, ClientIdentity)] -> (Value, ClientIdentity)
forall a. HasCallStack => [a] -> a
head [(Value, ClientIdentity)]
otherMembers) Value
owner
  HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
assertChannelAdminPermission ConvId
convId Value
conv Value
owner ClientIdentity
ownerClient ([(Value, ClientIdentity)]
otherMembers [(Value, ClientIdentity)] -> Int -> (Value, ClientIdentity)
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Value
mem
  HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> ClientIdentity
-> App ()
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> ClientIdentity
-> App ()
assertNoChannelAdminPermission ConvId
convId Value
conv Value
nonAdmin ClientIdentity
nonAdminClient ([(Value, ClientIdentity)]
otherMembers [(Value, ClientIdentity)] -> Int -> (Value, ClientIdentity)
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) ClientIdentity
ownerClient
  -- make nonAdmin a team admin
  String -> Value -> Value -> TeamPermissions -> App Response
forall user member.
(HasCallStack, MakesValue user, MakesValue member) =>
String -> user -> member -> TeamPermissions -> App Response
updateTeamMember String
tid Value
owner Value
nonAdmin TeamPermissions
Admin App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
assertChannelAdminPermission ConvId
convId Value
conv Value
nonAdmin ClientIdentity
nonAdminClient ([(Value, ClientIdentity)]
otherMembers [(Value, ClientIdentity)] -> Int -> (Value, ClientIdentity)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) Value
mem
  -- make nonAdmin a team member again
  String -> Value -> Value -> TeamPermissions -> App Response
forall user member.
(HasCallStack, MakesValue user, MakesValue member) =>
String -> user -> member -> TeamPermissions -> App Response
updateTeamMember String
tid Value
owner Value
nonAdmin TeamPermissions
Member App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> ClientIdentity
-> App ()
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> ClientIdentity
-> App ()
assertNoChannelAdminPermission ConvId
convId Value
conv Value
nonAdmin ClientIdentity
nonAdminClient ([(Value, ClientIdentity)]
otherMembers [(Value, ClientIdentity)] -> Int -> (Value, ClientIdentity)
forall a. HasCallStack => [a] -> Int -> a
!! Int
4) ClientIdentity
ownerClient
  -- finally make them admin again and check that they can delete the conversation
  String -> Value -> Value -> TeamPermissions -> App Response
forall user member.
(HasCallStack, MakesValue user, MakesValue member) =>
String -> user -> member -> TeamPermissions -> App Response
updateTeamMember String
tid Value
owner Value
nonAdmin TeamPermissions
Admin App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  String -> Value -> Value -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
deleteTeamConv String
tid Value
conv Value
nonAdmin App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  where
    assertChannelAdminPermission :: (HasCallStack) => ConvId -> Value -> Value -> ClientIdentity -> (Value, ClientIdentity) -> Value -> App ()
    assertChannelAdminPermission :: HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> Value
-> App ()
assertChannelAdminPermission ConvId
convId Value
conv Value
user ClientIdentity
userClient (Value
userToAdd, ClientIdentity
userToAddClient) Value
userToUpdate = do
      String
newName <- App String
randomName
      Value -> Value -> String -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
changeConversationName Value
user Value
conv String
newName App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> Word64 -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Word64 -> App Response
updateMessageTimer Value
user Value
conv Word64
1000 App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> [Pair] -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess Value
user Value
conv ([String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"code", String
"invite"], String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"team_member", String
"guest"]]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> Value -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember Value
user Value
conv Value
userToUpdate String
"wire_member" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Value -> App Response
updateConversationSelf Value
user Value
conv ([Pair] -> Value
object [String
"otr_archived" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> Maybe String -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteConversationCode Value
user Value
conv App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
user Value
conv String
"everyone" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
user Value
conv) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message_timer" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1000
        App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"access_role") App [Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
"team_member", String
"guest"]
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.self.otr_archived" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"add_permission" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"everyone"
      -- we need to reset the add permission to admins for the next assertions to be meaningful
      Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
user Value
conv String
"admins" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      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
userClient ConvId
convId [Value
userToAdd] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
userClient ConvId
convId [ClientIdentity
userToAddClient] 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

    assertNoChannelAdminPermission :: (HasCallStack) => ConvId -> Value -> Value -> ClientIdentity -> (Value, ClientIdentity) -> ClientIdentity -> App ()
    assertNoChannelAdminPermission :: HasCallStack =>
ConvId
-> Value
-> Value
-> ClientIdentity
-> (Value, ClientIdentity)
-> ClientIdentity
-> App ()
assertNoChannelAdminPermission ConvId
convId Value
conv Value
user ClientIdentity
userClient (Value
userToAdd, ClientIdentity
_) ClientIdentity
userToUpdate = do
      String
newName <- App String
randomName
      Value -> Value -> String -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
changeConversationName Value
user Value
conv String
newName 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      Value -> Value -> Word64 -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Word64 -> App Response
updateMessageTimer Value
user Value
conv Word64
2000 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      Value -> Value -> [Pair] -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess Value
user Value
conv ([String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"code"], String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"team_member", String
"guest"]]) 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      Value -> Value -> ClientIdentity -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember Value
user Value
conv ClientIdentity
userToUpdate String
"wire_member" 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      String
tid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      String -> Value -> Value -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
deleteTeamConv String
tid Value
conv Value
user 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
user Value
conv String
"everyone" 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
403
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"
      Value -> Value -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Value -> App Response
updateConversationSelf Value
user Value
conv ([Pair] -> Value
object [String
"otr_archived" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      -- since the mls test client cannot handle failed commits, we need to restore the state manually
      MLSState
mlsState <- App MLSState
getMLSState
      HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
userClient ConvId
convId [Value
userToAdd] App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp -> HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
userClient (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
403
      (MLSState -> MLSState) -> App ()
modifyMLSState (MLSState -> MLSState -> MLSState
forall a b. a -> b -> a
const MLSState
mlsState)
      HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
userClient ConvId
convId [ClientIdentity
userToUpdate] App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp -> HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
userClient (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
403
      (MLSState -> MLSState) -> App ()
modifyMLSState (MLSState -> MLSState -> MLSState
forall a b. a -> b -> a
const MLSState
mlsState)

testUpdateAddPermissions :: (HasCallStack) => App ()
testUpdateAddPermissions :: HasCallStack => App ()
testUpdateAddPermissions = do
  (Value
alice, String
tid, Value
bob : Value
chaz : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  clients :: [ClientIdentity]
clients@(ClientIdentity
aliceClient : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
alice, Value
bob, Value
chaz] ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
clients (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
alice String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
alice String
tid String
"channels" (String -> Value
config String
"everyone")

  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  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
aliceClient ConvId
convId

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

  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
aliceClient ConvId
convId [Value
bob, Value
chaz] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob, Value
chaz] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
alice Value
conv String
"admins" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App Value) -> App ())
-> (WebSocket -> App Value) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall n. (HasCallStack, MakesValue n) => n -> App Bool
isChannelAddPermissionUpdate WebSocket
ws

testSetAddPermissionOnChannelCreation :: (HasCallStack) => App ()
testSetAddPermissionOnChannelCreation :: HasCallStack => App ()
testSetAddPermissionOnChannelCreation = do
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  ClientIdentity
aliceClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
aliceClient
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
alice String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
alice String
tid String
"channels" (String -> Value
config String
"everyone")

  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, addPermission = Just "admins"} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"add_permission" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"admins"

testAddPermissionEveryone :: (HasCallStack) => App ()
testAddPermissionEveryone :: HasCallStack => App ()
testAddPermissionEveryone = do
  (Value
alice, String
tid, Value
bob : Value
chaz : Value
delia : Value
eric : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  Value
gunther <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  clients :: [ClientIdentity]
clients@(ClientIdentity
aliceClient : ClientIdentity
bobClient : ClientIdentity
chazClient : ClientIdentity
_ : ClientIdentity
_ : ClientIdentity
guntherClient : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
alice, Value
bob, Value
chaz, Value
delia, Value
eric, Value
gunther] ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bob Value
gunther
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
gunther Value
eric
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
clients (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
alice String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
alice String
tid String
"channels" (String -> Value
config String
"everyone")
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  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
aliceClient 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
aliceClient ConvId
convId [Value
bob] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"add_permission" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"everyone"
    [Value]
members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
bob] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
members ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
m -> do
      Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"

  HasCallStack =>
ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
assertAddSuccess ConvId
convId ClientIdentity
bobClient (Value
chaz, ClientIdentity
chazClient)
  -- guests can be added
  HasCallStack =>
ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
assertAddSuccess ConvId
convId ClientIdentity
bobClient (Value
gunther, ClientIdentity
guntherClient)
  -- but guests are not allowed to add other members even when the add permission is set to everyone
  HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
ConvId -> ClientIdentity -> Value -> App ()
assertAddFailure ConvId
convId ClientIdentity
guntherClient Value
eric
  -- set permissions back to admins
  Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
alice Value
conv String
"admins" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
ConvId -> ClientIdentity -> Value -> App ()
assertAddFailure ConvId
convId ClientIdentity
bobClient Value
delia
  where
    assertAddSuccess :: (HasCallStack) => ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
    assertAddSuccess :: HasCallStack =>
ConvId -> ClientIdentity -> (Value, ClientIdentity) -> App ()
assertAddSuccess ConvId
convId ClientIdentity
userClient (Value
userToAdd, ClientIdentity
userToAddClient) = do
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
userClient ConvId
convId [Value
userToAdd] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
      MLSState
mlsState <- App MLSState
getMLSState
      -- they cant remove, though
      HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
userClient ConvId
convId [ClientIdentity
userToAddClient] App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp -> HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
userClient (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
403
      (MLSState -> MLSState) -> App ()
modifyMLSState (MLSState -> MLSState -> MLSState
forall a b. a -> b -> a
const MLSState
mlsState)

    assertAddFailure :: (HasCallStack) => ConvId -> ClientIdentity -> Value -> App ()
    assertAddFailure :: HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
assertAddFailure ConvId
convId ClientIdentity
userClient Value
userToAdd = do
      MLSState
mlsState <- App MLSState
getMLSState
      HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
userClient ConvId
convId [Value
userToAdd] App MessagePackage -> (MessagePackage -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MessagePackage
mp -> HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
userClient (MessagePackage -> ByteString
mkBundle MessagePackage
mp) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
403
      (MLSState -> MLSState) -> App ()
modifyMLSState (MLSState -> MLSState -> MLSState
forall a b. a -> b -> a
const MLSState
mlsState)

testFederatedChannel :: (HasCallStack) => App ()
testFederatedChannel :: HasCallStack => App ()
testFederatedChannel = do
  (Value
alice, String
teamAlice, Value
anton : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (Value
bärbel, String
_, Value
bob : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OtherDomain Int
2
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bärbel
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  clients :: [ClientIdentity]
clients@(ClientIdentity
aliceClient : ClientIdentity
_ : ClientIdentity
bärbelClient : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
alice, Value
anton, Value
bärbel, Value
bob] ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
clients (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
alice String
teamAlice String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
alice String
teamAlice String
"channels" (String -> Value
config String
"everyone")
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defMLS {groupConvType = Just "channel", team = Just teamAlice} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
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
aliceClient 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
aliceClient ConvId
convId [Value
anton, Value
bärbel] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (ConvId -> Value
convIdToQidObject ConvId
convId)) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"add_permission" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"everyone"
    [Value]
members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
anton, Value
bärbel] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
members ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
m -> do
      Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"

  -- remote user gets the event
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bärbel] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
    Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
alice Value
conv String
"admins" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App Value) -> App ())
-> (WebSocket -> App Value) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall n. (HasCallStack, MakesValue n) => n -> App Bool
isChannelAddPermissionUpdate WebSocket
ws

  -- even when the remote member is promoted to a conversation admin they can cant add other members, because this is not implemented yet
  Value -> Value -> Value -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember Value
alice Value
conv Value
bärbel String
"wire_admin" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
ConvId -> ClientIdentity -> Value -> App ()
assertAddFails ConvId
convId ClientIdentity
bärbelClient Value
bob
  where
    assertAddFails :: (HasCallStack) => ConvId -> ClientIdentity -> Value -> App ()
    assertAddFails :: HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
assertAddFails ConvId
convId ClientIdentity
userClient Value
userToAdd = do
      MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
userClient ConvId
convId [Value
userToAdd]
      HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
userClient (MessagePackage -> ByteString
mkBundle MessagePackage
mp) 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
500
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"federation-not-implemented"

-- if the federation queue gets stuck, the second test run will fail
-- therefore this test verifies that a notification that cannot be parsed by the remote
-- backend does not block the queue
testWithOldBackendVersion :: (HasCallStack) => FedDomain 1 -> App ()
testWithOldBackendVersion :: HasCallStack => FedDomain 1 -> App ()
testWithOldBackendVersion FedDomain 1
fedDomain = Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 do
  let cs :: Ciphersuite
cs = String -> Ciphersuite
Ciphersuite String
"0x0001"
  (Value
bärbel, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
horst <- FedDomain 1 -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser FedDomain 1
fedDomain CreateUser
forall a. Default a => a
def
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bärbel Value
horst

  ClientIdentity
bärbelClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [cs]} Value
bärbel
  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
bärbelClient
  ClientIdentity
horstClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def {ciphersuites = [cs]} Value
horst
  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
horstClient

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
bärbel String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
bärbel String
tid String
"channels" (String -> Value
config String
"everyone")
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bärbel CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
conv
  Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
cs ClientIdentity
bärbelClient 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
bärbelClient ConvId
convId [Value
horst] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  -- this will trigger a notification that the old backend cannot parse
  Value -> Value -> String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission Value
bärbel Value
conv String
"admins" App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

testAddPermissionAdminExternalPartner :: (HasCallStack) => App ()
testAddPermissionAdminExternalPartner :: HasCallStack => App ()
testAddPermissionAdminExternalPartner = do
  HasCallStack =>
String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
_testAddtermissionExternalPartner String
"admins" ((ClientIdentity -> ConvId -> [Value] -> App ()) -> App ())
-> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ClientIdentity
partnerClient ConvId
convId [Value]
mems -> do
    MessagePackage
commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
partnerClient ConvId
convId [Value]
mems
    HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
partnerClient (MessagePackage -> ByteString
mkBundle MessagePackage
commit) 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
403
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"action-denied"

testAddPermissionEveryoneExternalPartner :: (HasCallStack) => App ()
testAddPermissionEveryoneExternalPartner :: HasCallStack => App ()
testAddPermissionEveryoneExternalPartner = do
  HasCallStack =>
String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
_testAddtermissionExternalPartner String
"everyone" ((ClientIdentity -> ConvId -> [Value] -> App ()) -> App ())
-> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ClientIdentity
partnerClient ConvId
convId [Value]
mems -> do
    Value
resp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
partnerClient ConvId
convId [Value]
mems 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
resp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events.0.data.user_ids" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList) App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

_testAddtermissionExternalPartner :: (HasCallStack) => String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
_testAddtermissionExternalPartner :: HasCallStack =>
String -> (ClientIdentity -> ConvId -> [Value] -> App ()) -> App ()
_testAddtermissionExternalPartner String
addPermission ClientIdentity -> ConvId -> [Value] -> App ()
assertion = do
  (Value
owner, String
tid, [Value]
mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  Value
partner <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  clients :: [ClientIdentity]
clients@(ClientIdentity
ownerClient : ClientIdentity
partnerClient : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Value
owner Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Value
partner Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
mems) ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
clients (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  let p :: CreateConv
p =
        CreateConv
defMLS
          { groupConvType = Just "channel",
            team = Just tid,
            addPermission = Just addPermission
          }
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
p App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
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
ownerClient 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
ownerClient ConvId
convId [Value
partner] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
  ClientIdentity -> ConvId -> [Value] -> App ()
assertion ClientIdentity
partnerClient ConvId
convId [Value]
mems

testTeamAdminCanCreateChannelWithoutJoining :: (HasCallStack) => App ()
testTeamAdminCanCreateChannelWithoutJoining :: HasCallStack => App ()
testTeamAdminCanCreateChannelWithoutJoining = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")

  App Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} App Response -> (Response -> App (App Value)) -> App (App Value)
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
201
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
      App Value -> App (App Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
resp.json

  App Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation App Value
conv 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
200

testNonTeamAdminCannotAddMembersWithoutJoining :: (HasCallStack) => App ()
testNonTeamAdminCannotAddMembersWithoutJoining :: HasCallStack => App ()
testNonTeamAdminCannotAddMembersWithoutJoining = do
  (Value
owner, String
tid, mems :: [Value]
mems@(Value
m1 : Value
m2 : Value
m3 : [Value]
_)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  [ClientIdentity]
cs <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
cs ((ClientIdentity -> App String) -> App ())
-> (ClientIdentity -> 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

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"admins")

  Value
channel <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} 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

  Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
m1 Value
channel AddMembers
forall a. Default a => a
def {users = [m1, m2, m3], role = Just "wire_member"} 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
404
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-conversation"

testTeamAdminCanChangeChannelNameWithoutJoining :: (HasCallStack) => App ()
testTeamAdminCanChangeChannelNameWithoutJoining :: HasCallStack => App ()
testTeamAdminCanChangeChannelNameWithoutJoining = do
  (Value
owner, String
tid, Value
mem : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
      Value
owner
      CreateConv
defMLS {name = Just "foo", groupConvType = Just "channel", team = Just tid, skipCreator = Just True}
      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
  Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
conv 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
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"foo"
  String
newName <- App String
randomName
  Value -> Value -> String -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
changeConversationName Value
owner Value
conv String
newName App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
conv 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
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
  Value -> Value -> String -> App Response
forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
changeConversationName Value
mem Value
conv String
newName 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
404
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-conversation"
  Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
conv 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
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName

testTeamAdminCanAddMembersWithoutJoining :: (HasCallStack) => App ()
testTeamAdminCanAddMembersWithoutJoining :: HasCallStack => App ()
testTeamAdminCanAddMembersWithoutJoining = do
  (Value
owner, String
tid, mems :: [Value]
mems@(Value
m1 : Value
m2 : Value
m3 : Value
m4 : Value
m5 : [Value]
_)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
6
  cs :: [ClientIdentity]
cs@(ClientIdentity
c1 : ClientIdentity
c2 : ClientIdentity
c3 : ClientIdentity
c4 : ClientIdentity
c5 : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
cs ((ClientIdentity -> App String) -> App ())
-> (ClientIdentity -> 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

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"admins")

  -- the team admin creates a channel without joining
  Value
channel <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
channel

  [ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
c1, ClientIdentity
c2, ClientIdentity
c3, ClientIdentity
c4, ClientIdentity
c5] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket
ws1, WebSocket
ws2, WebSocket
ws3, WebSocket
ws4, WebSocket
ws5] -> do
    -- the team admin adds members to the channel
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembersToChannel Value
owner Value
channel AddMembers
forall a. Default a => a
def {users = [m1, m2, m3], role = Just "wire_member"} 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
200

    -- the members are added to the backend conversation
    Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
channel 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
200
      [Value]
convMems <- Response
resp.json App Value -> 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] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
m1, Value
m2, Value
m3] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
convMems (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

    do
      -- client if m1 receives the member join notification
      Value
notif <- 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
ws1
      -- if add_type is external_add ...
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.add_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"external_add"
      Value
qconv <- Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_conversation"
      [Value]
membersToAdd <- Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.users" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList

      Value
conv <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
m1 Value
qconv 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
      -- ... and the epoch is 0
      Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
      -- the client creates the MLS group and adds everyone else
      Ciphersuite -> ClientIdentity -> ConvId -> [Value] -> App ()
createGroupForChannel Ciphersuite
forall a. Default a => a
def ClientIdentity
c1 ConvId
convId [Value]
membersToAdd
      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
c1 ConvId
convId [Value]
membersToAdd 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

    -- the members that were added receive a welcome message
    [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
ws2, WebSocket
ws3] ((WebSocket -> App Value) -> App ())
-> (WebSocket -> App Value) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isWelcomeNotif WebSocket
ws

    -- the team admin adds another member to the channel
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembersToChannel Value
owner Value
channel AddMembers
forall a. Default a => a
def {users = [m4, m5], role = Just "wire_member"} 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
200

    Value
notif <- 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
ws4
    Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.add_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"external_add"

    -- c4 adds itself with an external add
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
convId ClientIdentity
c4 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
    -- add others via normal commit
    [Value]
membersToAdd <- Value -> Value -> App [Value]
forall {a} {a}.
(MakesValue a, MakesValue a) =>
a -> a -> App [Value]
others Value
m4 Value
notif
    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
c4 ConvId
convId [Value]
membersToAdd 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
    -- m5 receives welcome message
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isWelcomeNotif WebSocket
ws5
  where
    others :: a -> a -> App [Value]
others a
self a
memberJoinNotif = do
      [Value]
allUsers <- a
memberJoinNotif a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.users" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      Value
selfQid <- a
self a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
      (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\Value
m -> (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
selfQid) (Value -> Bool) -> App Value -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")) [Value]
allUsers

testAdminCanRemoveMemberWithoutJoining :: (HasCallStack) => App ()
testAdminCanRemoveMemberWithoutJoining :: HasCallStack => App ()
testAdminCanRemoveMemberWithoutJoining = do
  (Value
owner, String
tid, mems :: [Value]
mems@(Value
m1 : Value
m2 : Value
m3 : [Value]
_)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  cs :: [ClientIdentity]
cs@(ClientIdentity
c1 : ClientIdentity
c2 : ClientIdentity
c3 : [ClientIdentity]
_) <- [Value] -> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems ((Value -> App ClientIdentity) -> App [ClientIdentity])
-> (Value -> App ClientIdentity) -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
cs ((ClientIdentity -> App String) -> App ())
-> (ClientIdentity -> 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

  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")

  -- a channel is created by a team member
  Value
channel <- HasCallStack => ClientIdentity -> String -> [Value] -> App Value
ClientIdentity -> String -> [Value] -> App Value
assertCreateChannelSuccess ClientIdentity
c1 String
tid [Value
m2]
  ConvId
convId <- Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId Value
channel
  Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
channel 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
200
    [Value]
convMems <- Response
resp.json App Value -> 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] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
m1, Value
m2] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
convMems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

  [ClientIdentity] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [ClientIdentity
c1, ClientIdentity
c2, ClientIdentity
c3] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket
ws1, WebSocket
_ws2, WebSocket
ws3] -> do
    -- the team admin removes a member from the channel without joining
    HasCallStack => Value -> Value -> Value -> App ()
Value -> Value -> Value -> App ()
removeMemberFromChannel Value
owner Value
channel Value
m2

    Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
channel 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
200
      [Value]
convMems <- Response
resp.json App Value -> 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] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
m1] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
convMems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

    -- the client of m1 receives a notification, creates a pending proposal, sends it, and consumes messages
    HasCallStack =>
ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
awaitAndProcessRemoveProposal ConvId
convId ClientIdentity
c1 WebSocket
ws1 Int
1

    -- the team admin now removes the last remaining member
    HasCallStack => Value -> Value -> Value -> App ()
Value -> Value -> Value -> App ()
removeMemberFromChannel Value
owner Value
channel Value
m1

    Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
channel 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
200
      App [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (App [Value] -> App ()) -> App [Value] -> App ()
forall a b. (a -> b) -> a -> b
$ Response
resp.json App Value -> 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

    -- now there is no one left to create and submit the pending proposal
    -- the team admin adds another member to the channel again
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembersToChannel Value
owner Value
channel AddMembers
forall a. Default a => a
def {users = [m3], role = Just "wire_member"} 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
200

    Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
I.getConversation Value
channel 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
200
      [Value]
convMems <- Response
resp.json App Value -> 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] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
m3] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
convMems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

    -- m3 receives a member-join notification and joins via external commit
    Value
notif <- 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
ws3
    Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.add_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"external_add"

    -- c3 adds itself with an external add
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
ConvId -> ClientIdentity -> Maybe ByteString -> App MessagePackage
createExternalCommit ConvId
convId ClientIdentity
c3 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

    -- now m3 receives the pending remove proposal and processes it
    HasCallStack =>
ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
awaitAndProcessRemoveProposal ConvId
convId ClientIdentity
c3 WebSocket
ws3 Int
0
  where
    awaitAndProcessRemoveProposal :: (HasCallStack) => ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
    awaitAndProcessRemoveProposal :: HasCallStack =>
ConvId -> ClientIdentity -> WebSocket -> Int -> App ()
awaitAndProcessRemoveProposal ConvId
convId ClientIdentity
cid WebSocket
ws Int
index = do
      Maybe Value
e <- Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
1 WebSocket
ws
      ByteString
msgData <- Maybe Value
e Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data" App Value -> (App Value -> App ByteString) -> App ByteString
forall a b. a -> (a -> b) -> b
& App Value -> App ByteString
forall a. (HasCallStack, MakesValue a) => a -> App ByteString
asByteString
      Value
msg <- HasCallStack =>
Ciphersuite -> ClientIdentity -> ByteString -> App Value
Ciphersuite -> ClientIdentity -> ByteString -> App Value
showMessage Ciphersuite
forall a. Default a => a
def ClientIdentity
cid ByteString
msgData
      Value
msg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message.content.body.Proposal.Remove.removed" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
index
      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
cid ByteString
msgData
      Value
r <- HasCallStack => ConvId -> ClientIdentity -> App MessagePackage
ConvId -> ClientIdentity -> App MessagePackage
createPendingProposalCommit ConvId
convId ClientIdentity
cid App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle
      App Value -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"events"

testTeamAdminCanGetChannelData :: (HasCallStack) => App ()
testTeamAdminCanGetChannelData :: HasCallStack => App ()
testTeamAdminCanGetChannelData = do
  (Value
owner, String
tid, Value
mem : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  Value
chan <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
      Value
owner
      CreateConv
defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True}
      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
  Value
chan Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"group_conv_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"channel"

  -- The admin can get channel data without joining
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
owner Value
chan 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
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"members.self" 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)

  -- A team member cannot get channel data without joining
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
mem Value
chan 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
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"access-denied"

  -- The admin cannot get data of a conversation that is not a channel
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
mem CreateConv
defMLS {team = Just tid} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"group_conv_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"group_conversation"
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
owner Value
conv 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
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"access-denied"