Tests: support giving a role when adding

integration/test/API/Galley.hs

@@ -233,12 +233,22 @@ getGroupInfo user conv = do
   req <- baseRequest user Galley Versioned path
   submit "GET" req
 
-addMembers :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> [Value] -> App Response
-addMembers usr qcnv newMembers = do
+addMembers :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> Maybe String -> [Value] -> App Response
+addMembers usr qcnv role newMembers = do
   (convDomain, convId) <- objQid qcnv
   qUsers <- mapM objQidObject newMembers
-  req <- baseRequest usr Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members"])
-  submit "POST" (req & addJSONObject ["qualified_users" .= qUsers])
+  req <- do
+    b <-
+      baseRequest
+        usr
+        Galley
+        Versioned
+        (joinHttpPath ["conversations", convDomain, convId, "members"])
+    let b' = addJSONObject ["qualified_users" .= qUsers] b
+    pure $ case role of
+      Nothing -> b'
+      Just r -> addJSONObject ["conversation_role" .= r] b'
+  submit "POST" req
 
 removeMember :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response
 removeMember remover qcnv removed = do

integration/test/Test/Conversation.hs

@@ -340,7 +340,7 @@ testAddMembersFullyConnectedProteus = do
     cid <- postConversation u1 (defProteus {qualifiedUsers = []}) >>= getJSON 201
     -- add members from remote backends
     members <- for [u2, u3] (%. "qualified_id")
-    bindResponse (addMembers u1 cid members) $ \resp -> do
+    bindResponse (addMembers u1 cid Nothing members) $ \resp -> do
       resp.status `shouldMatchInt` 200
       users <- resp.json %. "data.users" >>= asList
       addedUsers <- forM users (%. "qualified_id")
@@ -358,7 +358,7 @@ testAddMembersNonFullyConnectedProteus = do
     liftIO $ threadDelay (2 * 1000 * 1000) -- wait for federation status to be updated
     -- add members from remote backends
     members <- for [u2, u3] (%. "qualified_id")
-    bindResponse (addMembers u1 cid members) $ \resp -> do
+    bindResponse (addMembers u1 cid Nothing members) $ \resp -> do
       resp.status `shouldMatchInt` 409
       resp.json %. "non_federating_backends" `shouldMatchSet` [domainB, domainC]
 
@@ -369,11 +369,11 @@ testAddMember = do
   cid <- postConversation alice defProteus >>= getJSON 201
   bob <- randomUser OwnDomain def
   mem <- bob %. "qualified_id"
-  bindResponse (addMembers alice cid [mem]) $ \resp -> do
+  bindResponse (addMembers alice cid Nothing [mem]) $ \resp -> do
     resp.status `shouldMatchInt` 403
     resp.json %. "label" `shouldMatch` "not-connected"
   connectUsers alice bob
-  bindResponse (addMembers alice cid [mem]) $ \resp -> do
+  bindResponse (addMembers alice cid Nothing [mem]) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "type" `shouldMatch` "conversation.member-join"
     resp.json %. "qualified_from" `shouldMatch` objQidObject alice
@@ -420,7 +420,7 @@ testAddReachableWithUnreachableRemoteUsers = do
       pure ([alex, bob], conv, domains)
 
   bobId <- bob %. "qualified_id"
-  bindResponse (addMembers alex conv [bobId]) $ \resp -> do
+  bindResponse (addMembers alex conv Nothing [bobId]) $ \resp -> do
     -- This test is updated to reflect the changes in `performConversationJoin`
     -- `performConversationJoin` now does a full check between all federation members
     -- that will be in the conversation when adding users to a conversation. This is
@@ -445,7 +445,7 @@ testAddUnreachable = do
       pure ([alex, charlie], domains, conv)
 
   charlieId <- charlie %. "qualified_id"
-  bindResponse (addMembers alex conv [charlieId]) $ \resp -> do
+  bindResponse (addMembers alex conv Nothing [charlieId]) $ \resp -> do
     resp.status `shouldMatchInt` 533
     -- All of the domains that are in the conversation, or will be in the conversation,
     -- need to be reachable so we can check that the graph for those domains is fully connected.
@@ -483,7 +483,7 @@ testAddingUserNonFullyConnectedFederation = do
 
     bobId <- bob %. "qualified_id"
     charlieId <- charlie %. "qualified_id"
-    bindResponse (addMembers alice conv [bobId, charlieId]) $ \resp -> do
+    bindResponse (addMembers alice conv Nothing [bobId, charlieId]) $ \resp -> do
       resp.status `shouldMatchInt` 409
       resp.json %. "non_federating_backends" `shouldMatchSet` [other, dynBackend]
 
@@ -714,7 +714,7 @@ testDeleteTeamConversationWithRemoteMembers = do
   bobClient <- objId $ bindResponse (addClient bob def) $ getJSON 201
   connectUsers alice bob
   mem <- bob %. "qualified_id"
-  void $ addMembers alice conv [mem] >>= getBody 200
+  void $ addMembers alice conv Nothing [mem] >>= getBody 200
   void $ deleteTeamConversation team conv alice >>= getBody 200
   let assertNotifications :: (HasCallStack, MakesValue user) => user -> String -> App ()
       assertNotifications user client = do
@@ -743,7 +743,7 @@ testDeleteTeamConversationWithUnreachableRemoteMembers = do
       bobClient <- objId $ bindResponse (addClient bob def) $ getJSON 201
       connectUsers alice bob
       mem <- bob %. "qualified_id"
-      void $ addMembers alice conv [mem] >>= getBody 200
+      void $ addMembers alice conv Nothing [mem] >>= getBody 200
       pure (bob, bobClient)
     void $ deleteTeamConversation team conv alice >>= getBody 200
     assertNotification alice aliceClient

integration/test/Test/Federation.hs

@@ -74,11 +74,11 @@ testNotificationsForOfflineBackends = do
     -- check non-fully connected graph between all participating backends
     otherUser3 <- randomUser OtherDomain def
     connectUsers delUser otherUser3
-    bindResponse (addMembers delUser upBackendConv [otherUser3]) $ \resp ->
+    bindResponse (addMembers delUser upBackendConv Nothing [otherUser3]) $ \resp ->
       resp.status `shouldMatchInt` 533
 
     -- Adding users from down backend to a conversation should also fail
-    bindResponse (addMembers delUser upBackendConv [downUser2]) $ \resp ->
+    bindResponse (addMembers delUser upBackendConv Nothing [downUser2]) $ \resp ->
       resp.status `shouldMatchInt` 533
 
     -- Removing users from an up backend conversation should work even when one