{-# 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.Brig
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
  (owner, tid, mem : otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  partner <- createTeamMember owner def {role = "partner"}
  ownerClient <- createMLSClient def owner
  memClient <- createMLSClient def mem
  partnerClient <- createMLSClient def partner
  otherClients <- for otherTeamMembers $ createMLSClient def
  replicateM_ 3 $ for_ (memClient : ownerClient : partnerClient : otherClients) (uploadNewKeyPackage def)
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
  assertCreateChannelSuccess_ ownerClient tid otherTeamMembers
  assertCreateChannelSuccess_ memClient tid otherTeamMembers
  assertCreateChannelSuccess_ partnerClient tid otherTeamMembers

testCreateChannelMembersOnly :: (HasCallStack) => App ()
testCreateChannelMembersOnly :: HasCallStack => App ()
testCreateChannelMembersOnly = do
  (owner, tid, mem : otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  partner <- createTeamMember owner def {role = "partner"}
  ownerClient <- createMLSClient def owner
  memClient <- createMLSClient def mem
  partnerClient <- createMLSClient def partner
  otherClients <- for otherTeamMembers $ createMLSClient def
  replicateM_ 3 $ for_ (memClient : ownerClient : partnerClient : otherClients) (uploadNewKeyPackage def)
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "team-members")
  assertCreateChannelSuccess_ ownerClient tid otherTeamMembers
  assertCreateChannelSuccess_ memClient tid otherTeamMembers
  assertCreateChannelFailure "operation-denied" partnerClient tid

testCreateChannelAdminsOnly :: (HasCallStack) => App ()
testCreateChannelAdminsOnly :: HasCallStack => App ()
testCreateChannelAdminsOnly = do
  (owner, tid, mem : otherTeamMembers) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  partner <- createTeamMember owner def {role = "partner"}
  ownerClient <- createMLSClient def owner
  memClient <- createMLSClient def mem
  partnerClient <- createMLSClient def partner
  otherClients <- for otherTeamMembers $ createMLSClient def
  replicateM_ 3 $ for_ (memClient : ownerClient : partnerClient : otherClients) (uploadNewKeyPackage def)
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "admins")
  assertCreateChannelSuccess_ ownerClient tid otherTeamMembers
  assertCreateChannelFailure "operation-denied" memClient tid
  assertCreateChannelFailure "operation-denied" partnerClient tid

testCreateChannelFeatureDisabled :: (HasCallStack) => App ()
testCreateChannelFeatureDisabled :: HasCallStack => App ()
testCreateChannelFeatureDisabled = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  ownerClient <- createMLSClient def owner
  void $ uploadNewKeyPackage def ownerClient
  assertCreateChannelFailure "channels-not-enabled" ownerClient tid

testCreateChannelNonTeamConvNotAllowed :: (HasCallStack) => App ()
testCreateChannelNonTeamConvNotAllowed :: HasCallStack => App ()
testCreateChannelNonTeamConvNotAllowed = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  userClient <- createMLSClient def user
  void $ uploadNewKeyPackage def userClient
  postConversation userClient defMLS {groupConvType = Just "channel"} `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
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
  postConversation owner defProteus {groupConvType = Just "channel", team = Just tid} `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
  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
  conv %. "group_conv_type" `shouldMatch` "channel"
  convId <- objConvId conv
  createGroup def client convId
  resp <- createAddCommit client convId members >>= sendAndConsumeCommitBundle
  (resp %. "events.0.data.user_ids" & asList) `shouldMatchSet` (for members (%. "id"))
  pure 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
  (owner, tid, mem : nonAdmin : mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
10
  clients@(ownerClient : memClient : nonAdminClient : _) <- for (owner : mem : nonAdmin : mems) $ createMLSClient def
  for_ clients (uploadNewKeyPackage def)
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  -- a member creates a channel
  conv <- postConversation memClient defMLS {groupConvType = Just "channel", team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def memClient convId

  -- other team members are added to the channel
  void $ createAddCommit memClient convId [owner, nonAdmin] >>= sendAndConsumeCommitBundle
  bindResponse (getConversation mem (convIdToQidObject convId)) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    for members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for [owner, nonAdmin] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    for_ members $ \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]
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

  assertChannelAdminPermission convId conv mem memClient (head otherMembers) owner
  assertChannelAdminPermission convId conv owner ownerClient (otherMembers !! 1) mem
  assertNoChannelAdminPermission convId conv nonAdmin nonAdminClient (otherMembers !! 2) ownerClient
  -- make nonAdmin a team admin
  updateTeamMember tid owner nonAdmin Admin >>= assertSuccess
  assertChannelAdminPermission convId conv nonAdmin nonAdminClient (otherMembers !! 3) mem
  -- make nonAdmin a team member again
  updateTeamMember tid owner nonAdmin Member >>= assertSuccess
  assertNoChannelAdminPermission convId conv nonAdmin nonAdminClient (otherMembers !! 4) ownerClient
  -- finally make them admin again and check that they can delete the conversation
  updateTeamMember tid owner nonAdmin Admin >>= assertSuccess
  deleteTeamConv tid conv nonAdmin >>= 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
      newName <- App String
randomName
      changeConversationName user conv newName >>= assertSuccess
      updateMessageTimer user conv 1000 >>= assertSuccess
      updateAccess user conv (["access" .= ["code", "invite"], "access_role" .= ["team_member", "guest"]]) >>= assertSuccess
      updateConversationMember user conv userToUpdate "wire_member" >>= assertSuccess
      updateConversationSelf user conv (object ["otr_archived" .= True]) >>= assertSuccess
      postConversationCode user conv Nothing Nothing >>= assertSuccess
      getConversationCode user conv Nothing >>= assertSuccess
      deleteConversationCode user conv >>= assertSuccess
      updateChannelAddPermission user conv "everyone" >>= assertSuccess
      bindResponse (getConversation user conv) $ \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
      updateChannelAddPermission user conv "admins" >>= assertSuccess
      void $ createAddCommit userClient convId [userToAdd] >>= sendAndConsumeCommitBundle
      void $ createRemoveCommit userClient convId [userToAddClient] >>= 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
      newName <- App String
randomName
      changeConversationName user conv newName `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"
      updateMessageTimer user conv 2000 `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"
      updateAccess user conv (["access" .= ["code"], "access_role" .= ["team_member", "guest"]]) `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"
      updateConversationMember user conv userToUpdate "wire_member" `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"
      tid <- user %. "team" & asString
      deleteTeamConv tid conv user `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"
      updateChannelAddPermission user conv "everyone" `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"
      updateConversationSelf user conv (object ["otr_archived" .= True]) >>= assertSuccess
      -- since the mls test client cannot handle failed commits, we need to restore the state manually
      mlsState <- getMLSState
      createAddCommit userClient convId [userToAdd] >>= \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
      modifyMLSState (const mlsState)
      createRemoveCommit userClient convId [userToUpdate] >>= \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
      modifyMLSState (const mlsState)

testUpdateAddPermissions :: (HasCallStack) => App ()
testUpdateAddPermissions :: HasCallStack => App ()
testUpdateAddPermissions = do
  (alice, tid, bob : chaz : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  clients@(aliceClient : _) <- for [alice, bob, chaz] $ createMLSClient def
  for_ clients (uploadNewKeyPackage def)
  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  void $ setTeamFeatureConfig alice tid "channels" (config "everyone")

  conv <- postConversation alice defMLS {groupConvType = Just "channel", team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def aliceClient convId

  bindResponse (getConversation alice (convIdToQidObject convId)) $ \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"

  void $ createAddCommit aliceClient convId [bob, chaz] >>= sendAndConsumeCommitBundle
  void $ withWebSockets [alice, bob, chaz] $ \[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
  (alice, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  aliceClient <- createMLSClient def alice
  void $ uploadNewKeyPackage def aliceClient
  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  void $ setTeamFeatureConfig alice tid "channels" (config "everyone")

  conv <- postConversation alice defMLS {groupConvType = Just "channel", team = Just tid, addPermission = Just "admins"} >>= getJSON 201
  convId <- objConvId conv
  bindResponse (getConversation alice (convIdToQidObject convId)) $ \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
  (alice, tid, bob : chaz : delia : eric : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  gunther <- randomUser OwnDomain def
  clients@(aliceClient : bobClient : chazClient : _ : _ : guntherClient : _) <- for [alice, bob, chaz, delia, eric, gunther] $ createMLSClient def
  connectTwoUsers bob gunther
  connectTwoUsers gunther eric
  for_ clients (uploadNewKeyPackage def)
  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  void $ setTeamFeatureConfig alice tid "channels" (config "everyone")
  conv <- postConversation alice defMLS {groupConvType = Just "channel", team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def aliceClient convId
  void $ createAddCommit aliceClient convId [bob] >>= sendAndConsumeCommitBundle

  bindResponse (getConversation alice (convIdToQidObject convId)) $ \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"
    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
    for members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for [bob] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    for_ members $ \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"

  assertAddSuccess convId bobClient (chaz, chazClient)
  -- guests can be added
  assertAddSuccess convId bobClient (gunther, guntherClient)
  -- but guests are not allowed to add other members even when the add permission is set to everyone
  assertAddFailure convId guntherClient eric
  -- set permissions back to admins
  updateChannelAddPermission alice conv "admins" >>= assertSuccess
  assertAddFailure convId bobClient 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 <- App MLSState
getMLSState
      -- they cant remove, though
      createRemoveCommit userClient convId [userToAddClient] >>= \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
      modifyMLSState (const mlsState)

    assertAddFailure :: (HasCallStack) => ConvId -> ClientIdentity -> Value -> App ()
    assertAddFailure :: HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
assertAddFailure ConvId
convId ClientIdentity
userClient Value
userToAdd = do
      mlsState <- App MLSState
getMLSState
      createAddCommit userClient convId [userToAdd] >>= \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
      modifyMLSState (const mlsState)

testFederatedChannel :: (HasCallStack) => App ()
testFederatedChannel :: HasCallStack => App ()
testFederatedChannel = do
  (alice, teamAlice, anton : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (bärbel, _, bob : _) <- createTeam OtherDomain 2
  connectTwoUsers alice bärbel
  connectTwoUsers alice bob
  clients@(aliceClient : _ : bärbelClient : _) <- for [alice, anton, bärbel, bob] $ createMLSClient def
  for_ clients (uploadNewKeyPackage def)

  setTeamFeatureLockStatus alice teamAlice "channels" "unlocked"
  void $ setTeamFeatureConfig alice teamAlice "channels" (config "everyone")
  conv <- postConversation alice defMLS {groupConvType = Just "channel", team = Just teamAlice} >>= getJSON 201
  convId <- objConvId conv
  createGroup def aliceClient convId
  void $ createAddCommit aliceClient convId [anton, bärbel] >>= sendAndConsumeCommitBundle

  bindResponse (getConversation alice (convIdToQidObject convId)) $ \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"
    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
    for members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for [anton, bärbel] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))
    for_ members $ \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
  void $ withWebSockets [bärbel] $ \[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
  updateConversationMember alice conv bärbel "wire_admin" >>= assertSuccess
  assertAddFails convId bärbelClient bob
  where
    assertAddFails :: (HasCallStack) => ConvId -> ClientIdentity -> Value -> App ()
    assertAddFails :: HasCallStack => ConvId -> ClientIdentity -> Value -> App ()
assertAddFails ConvId
convId ClientIdentity
userClient Value
userToAdd = do
      mp <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
userClient ConvId
convId [Value
userToAdd]
      postMLSCommitBundle userClient (mkBundle mp) `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
422
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"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"
  (bärbel, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  horst <- randomUser fedDomain def
  connectTwoUsers bärbel horst

  bärbelClient <- createMLSClient def {ciphersuites = [cs]} bärbel
  void $ uploadNewKeyPackage cs bärbelClient
  horstClient <- createMLSClient def {ciphersuites = [cs]} horst
  void $ uploadNewKeyPackage cs horstClient

  setTeamFeatureLockStatus bärbel tid "channels" "unlocked"
  void $ setTeamFeatureConfig bärbel tid "channels" (config "everyone")
  conv <- postConversation bärbel defMLS {groupConvType = Just "channel", team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup cs bärbelClient convId
  void $ createAddCommit bärbelClient convId [horst] >>= sendAndConsumeCommitBundle

  -- this will trigger a notification that the old backend cannot parse
  updateChannelAddPermission bärbel conv "admins" >>= 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
    commit <- HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
partnerClient ConvId
convId [Value]
mems
    postMLSCommitBundle partnerClient (mkBundle commit) `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
    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
    (resp %. "events.0.data.user_ids" & asList) `shouldMatchSet` (for mems (%. "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
  (owner, tid, mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
  partner <- createTeamMember owner def {role = "partner"}
  clients@(ownerClient : partnerClient : _) <- for (owner : partner : mems) $ createMLSClient def
  for_ clients (uploadNewKeyPackage def)
  let p =
        CreateConv
defMLS
          { groupConvType = Just "channel",
            team = Just tid,
            addPermission = Just addPermission
          }
  conv <- postConversation owner p >>= getJSON 201
  convId <- objConvId conv
  createGroup def ownerClient convId
  void $ createAddCommit ownerClient convId [partner] >>= sendAndConsumeCommitBundle
  assertion partnerClient convId mems

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

  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  conv <-
    postConversation owner defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} `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

  I.getConversation conv `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
  (owner, tid, mems@(m1 : m2 : m3 : _)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  cs <- for mems $ createMLSClient def
  for_ cs $ uploadNewKeyPackage def

  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "admins")

  channel <- postConversation owner defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} >>= getJSON 201

  addMembers m1 channel def {users = [m1, m2, m3], role = Just "wire_member"} `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
  (owner, tid, mem : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
  conv <-
    postConversation
      owner
      defMLS {name = Just "foo", groupConvType = Just "channel", team = Just tid, skipCreator = Just True}
      >>= getJSON 201
  I.getConversation conv `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"
  newName <- randomName
  changeConversationName owner conv newName >>= assertSuccess
  I.getConversation conv `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
  changeConversationName mem conv newName `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"
  I.getConversation conv `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
  (owner, tid, mems@(m1 : m2 : m3 : m4 : m5 : _)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
6
  cs@(c1 : c2 : c3 : c4 : c5 : _) <- for mems $ createMLSClient def
  for_ cs $ uploadNewKeyPackage def

  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "admins")

  -- the team admin creates a channel without joining
  channel <- postConversation owner defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} >>= getJSON 201
  convId <- objConvId channel

  withWebSockets [c1, c2, c3, c4, c5] $ \[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
      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
      for [m1, m2, m3] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for 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
      notif <- 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
isMemberJoinNotif WebSocket
ws1
      -- if add_type is external_add ...
      notif %. "payload.0.data.add_type" `shouldMatch` "external_add"
      qconv <- notif %. "payload.0.qualified_conversation"
      membersToAdd <- notif %. "payload.0.data.users" & asList

      conv <- getConversation m1 qconv >>= getJSON 200
      -- ... and the epoch is 0
      conv %. "epoch" `shouldMatchInt` 0
      -- the client creates the MLS group and adds everyone else
      createGroupForChannel def c1 convId membersToAdd
      void $ createAddCommit c1 convId membersToAdd >>= 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 n. (HasCallStack, MakesValue n) => n -> 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

    notif <- 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
isMemberJoinNotif WebSocket
ws4
    notif %. "payload.0.data.add_type" `shouldMatch` "external_add"

    -- c4 adds itself with an external add
    void $ createExternalCommit convId c4 Nothing >>= sendAndConsumeCommitBundle
    -- add others via normal commit
    membersToAdd <- others m4 notif
    void $ createAddCommit c4 convId membersToAdd >>= sendAndConsumeCommitBundle
    -- m5 receives welcome message
    void $ awaitMatch isWelcomeNotif ws5
  where
    others :: a -> a -> App [Value]
others a
self a
memberJoinNotif = do
      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
      selfQid <- self %. "qualified_id"
      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")) allUsers

testTeamAdminCanReplaceMembers :: (HasCallStack) => App ()
testTeamAdminCanReplaceMembers :: HasCallStack => App ()
testTeamAdminCanReplaceMembers = do
  (alice, tid, bob : charlie : dylan : emil : fred : guenter : horst : ilona : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
9
  [bobId, charlieId, dylanId, emilId, fredId, guenterId, horstId, ilonaId] <-
    for [bob, charlie, dylan, emil, fred, guenter, horst, ilona] (%. "id")

  -- these are the users added to the conversation via user groups
  -- they should not be removed by the replace operation
  let userGroupUsers = [Value
guenterId, Value
horstId, Value
ilonaId]

  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  void $ setTeamFeatureConfig alice tid "channels" (config "admins")

  -- the team admin creates a channel without joining
  channel <- postConversation alice defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} >>= getJSON 201
  convId <- objConvId channel

  -- create 2 user groups and assign the channel to them
  gid1 <- createUserGroup alice (object ["name" .= "ug 1", "members" .= [guenterId, horstId]]) >>= getJSON 200 >>= (%. "id") >>= asString
  gid2 <- createUserGroup alice (object ["name" .= "ug 2", "members" .= [horstId, ilonaId]]) >>= getJSON 200 >>= (%. "id") >>= asString
  updateUserGroupChannels alice gid1 [convId.id_] >>= assertSuccess
  updateUserGroupChannels alice gid2 [convId.id_] >>= assertSuccess

  withWebSockets [guenter, horst, ilona] $ \[WebSocket]
wss -> do
    -- let's add the users from the associated user group by hand for now (later this will be automatic)
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembersToChannel Value
alice Value
channel AddMembers
forall a. Default a => a
def {users = [guenter, horst, ilona], role = Just "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
    [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
isMemberJoinNotif WebSocket
ws

  withWebSockets [bob, charlie, dylan] $ \[WebSocket]
wss -> do
    -- the team admin adds members to the channel using the PUT endpoint
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
replaceMembers Value
alice Value
channel AddMembers
forall a. Default a => a
def {users = [bob, charlie, dylan]}) ((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

    -- members should receive member-join notifications
    [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
isMemberJoinNotif WebSocket
ws

    -- 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
      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
      let expected = [Value]
userGroupUsers [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value
bobId, Value
charlieId, Value
dylanId]
      actual <- for convMems (%. "id")
      expected `shouldMatchSet` actual

  withWebSockets [emil, fred] $ \[WebSocket]
wss -> do
    -- the team admin replaces members in the channel using the PUT endpoint
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
replaceMembers Value
alice Value
channel AddMembers
forall a. Default a => a
def {users = [dylan, emil, fred]}) ((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

    -- members should receive member-join notifications
    [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
isMemberJoinNotif WebSocket
ws

    -- the members are replaced in 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
      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
      let expected = [Value]
userGroupUsers [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value
dylanId, Value
emilId, Value
fredId]
      actual <- for convMems (%. "id")
      expected `shouldMatchSet` actual

testAdminCanRemoveMemberWithoutJoining :: (HasCallStack) => App ()
testAdminCanRemoveMemberWithoutJoining :: HasCallStack => App ()
testAdminCanRemoveMemberWithoutJoining = do
  (owner, tid, mems@(m1 : m2 : m3 : _)) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  cs@(c1 : c2 : c3 : _) <- for mems $ createMLSClient def
  for_ cs $ uploadNewKeyPackage def

  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  -- a channel is created by a team member
  channel <- assertCreateChannelSuccess c1 tid [m2]
  convId <- objConvId channel
  I.getConversation channel `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    for [m1, m2] (%. "id") `shouldMatchSet` (for convMems (%. "id"))

  withWebSockets [c1, c2, c3] $ \[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
      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
      for [m1] (%. "id") `shouldMatchSet` (for convMems (%. "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
      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
      for [m3] (%. "id") `shouldMatchSet` (for convMems (%. "id"))

    -- m3 receives a member-join notification and joins via external commit
    notif <- 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
isMemberJoinNotif WebSocket
ws3
    notif %. "payload.0.data.add_type" `shouldMatch` "external_add"

    -- c3 adds itself with an external add
    void $ createExternalCommit convId c3 Nothing >>= sendAndConsumeCommitBundle

    -- now m3 receives the pending remove proposal and processes it
    awaitAndProcessRemoveProposal convId c3 ws3 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
      e <- Int -> WebSocket -> App (Maybe Value)
awaitAnyEvent Int
1 WebSocket
ws
      msgData <- e %. "payload.0.data" & asByteString
      msg <- showMessage def cid msgData
      msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` index
      void $ mlsCliConsume convId def cid msgData
      r <- createPendingProposalCommit convId cid >>= sendAndConsumeCommitBundle
      shouldBeEmpty $ r %. "events"

testTeamAdminCanGetChannelData :: (HasCallStack) => App ()
testTeamAdminCanGetChannelData :: HasCallStack => App ()
testTeamAdminCanGetChannelData = do
  (owner, tid, mem : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
  chan <-
    postConversation
      owner
      defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True}
      >>= getJSON 201
  chan %. "group_conv_type" `shouldMatch` "channel"

  -- The admin can get channel data without joining
  getConversation owner chan `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
  getConversation mem chan `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
  conv <- postConversation mem defMLS {team = Just tid} >>= getJSON 201
  conv %. "group_conv_type" `shouldMatch` "group_conversation"
  getConversation owner conv `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"

testConversationOutOfSync :: (HasCallStack) => App ()
testConversationOutOfSync :: HasCallStack => App ()
testConversationOutOfSync = do
  (owner, tid, [alice, bob, charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
  traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  -- create empty channel
  ch <-
    postConversation
      alice1
      defMLS
        { groupConvType = Just "channel",
          team = Just tid
        }
      >>= getJSON 201

  -- set up mls group
  convId <- objConvId ch
  createGroup def alice1 convId
  void $ createAddCommit alice1 convId [] >>= sendAndConsumeCommitBundle

  -- an empty channel should not be out of sync
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` False

  -- after adding some members, it should be out of sync
  void $ addMembers owner convId def {users = [bob, charlie]} >>= getJSON 200
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` True

  -- now bob joins with an external commit, the conv should remain out of sync
  void $ createExternalCommit convId bob1 Nothing >>= sendAndConsumeCommitBundle
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` True

  -- finally, charlie joins and the conversation is not out of sync anymore
  void $ createExternalCommit convId charlie1 Nothing >>= sendAndConsumeCommitBundle
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` False

testTeamAdminCanManageChannel :: (HasCallStack) => TaggedBool "isMember" -> App ()
testTeamAdminCanManageChannel :: HasCallStack => TaggedBool "isMember" -> App ()
testTeamAdminCanManageChannel (TaggedBool Bool
isMember) = do
  (alice, tid, bob : charlie : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  void $ setTeamFeatureConfig alice tid "channels" (config "admins")
  channel <- postConversation alice defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} >>= getJSON 201

  when isMember $ do
    addMembersToChannel alice channel def {users = [alice]} `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    I.getConversation channel `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      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
      for [alice] (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for convMems (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

  -- ADD MEMBERS
  addMembersToChannel alice channel def {users = [bob, charlie]} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  I.getConversation channel `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    let expected = if Bool
isMember then [Value
alice, Value
bob, Value
charlie] else [Value
bob, Value
charlie]
    for expected (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for convMems (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

  -- REMOVE MEMBER
  removeMember alice channel bob `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

  I.getConversation channel `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    let expected = if Bool
isMember then [Value
alice, Value
charlie] else [Value
charlie]
    for expected (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for convMems (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

  -- REPLACE MEMBERS
  replaceMembers alice channel def {users = [alice, bob]} `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  I.getConversation channel `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    let expected = [Value
alice, Value
bob]
    for expected (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") `shouldMatchSet` (for convMems (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"))

testOutOfSyncError :: (HasCallStack) => App ()
testOutOfSyncError :: HasCallStack => App ()
testOutOfSyncError = do
  (owner, tid, [alice, bob, charlie, dee]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  [alice1, bob1, charlie1, dee1] <- traverse (createMLSClient def) [alice, bob, charlie, dee]
  replicateM_ 5 $ traverse_ (uploadNewKeyPackage def) [bob1, charlie1, dee1]
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  -- create empty channel
  ch <-
    postConversation
      alice1
      defMLS
        { groupConvType = Just "channel",
          team = Just tid
        }
      >>= getJSON 201

  -- set up mls group
  convId <- objConvId ch
  createGroup def alice1 convId
  void $ createAddCommit alice1 convId [alice] >>= sendAndConsumeCommitBundle

  -- make channel out of sync
  void $ addMembers owner convId def {users = [bob, charlie]} >>= getJSON 200
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` True

  -- sending a message should fail
  do
    mp <- createApplicationMessage convId alice1 "hello world"
    bindResponse (postMLSMessage mp.sender mp.message) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-out-of-sync"
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"Group is out of sync"
      missing <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"missing_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
      length missing `shouldMatchInt` 2

  -- sending a message should not fail in version < 13
  withAPIVersion 12 $ do
    mp <- createApplicationMessage convId alice1 "foo"
    void $ postMLSMessage mp.sender mp.message >>= getJSON 201

  -- adding only one of the users should fail
  do
    gs <- getClientGroupState alice1
    mp <- createAddCommit alice1 convId [bob]
    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-out-of-sync"
      missing <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"missing_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
      length missing `shouldMatchInt` 1
    setClientGroupState alice1 gs

  -- adding a new user should fail
  do
    gs <- getClientGroupState alice1
    mp <- createAddCommit alice1 convId [dee]
    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-out-of-sync"
      missing <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"missing_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
      length missing `shouldMatchInt` 2
    setClientGroupState alice1 gs

  -- adding a new user should not fail in version < 13
  withAPIVersion 12 $ do
    mp <- createAddCommit alice1 convId [dee]
    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

  -- adding both users should work
  do
    mp <- createAddCommit alice1 convId [bob, charlie]
    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

testOutOfSyncFederation :: (HasCallStack) => App ()
testOutOfSyncFederation :: HasCallStack => App ()
testOutOfSyncFederation = do
  (owner, tid, [alice, bob, charlie, dee]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  alex <- randomUser OtherDomain def
  connectTwoUsers alice alex

  [alice1, alex1, bob1, charlie1, dee1] <-
    traverse
      (createMLSClient def)
      [alice, alex, bob, charlie, dee]
  replicateM_ 5 $ traverse_ (uploadNewKeyPackage def) [alex1, bob1, charlie1, dee1]
  setTeamFeatureLockStatus owner tid "channels" "unlocked"
  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")

  -- create empty channel
  ch <-
    postConversation
      alice1
      defMLS
        { groupConvType = Just "channel",
          team = Just tid
        }
      >>= getJSON 201

  -- set up mls group
  convId <- objConvId ch
  createGroup def alice1 convId
  void $ createAddCommit alice1 convId [alice, alex] >>= sendAndConsumeCommitBundle

  -- make channel out of sync
  void $ addMembers owner convId def {users = [bob, charlie]} >>= getJSON 200
  do
    s <- isConversationOutOfSync convId >>= getJSON 200
    s `shouldMatch` True

  -- sending messages from a remote backend should fail
  do
    mp <- createApplicationMessage convId alex1 "hello world"
    bindResponse (postMLSMessage mp.sender mp.message) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-group-out-of-sync"
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"Group is out of sync"
      missing <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"missing_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
      length missing `shouldMatchInt` 2

  -- sending a message should not fail in version < 13
  withAPIVersion 12 $ do
    mp <- createApplicationMessage convId alex1 "foo"
    void $ postMLSMessage mp.sender mp.message >>= getJSON 201