WPB-16875 team admin creates a channel without joining (#4527)

Author: battermann

changelog.d/2-features/WBP-16875

@@ -0,0 +1 @@
+Team admins can create a channel without joining

integration/test/API/Galley.hs

@@ -32,7 +32,8 @@ data CreateConv = CreateConv
     protocol :: String,
     groupConvType :: Maybe String,
     cells :: Bool,
-    addPermission :: Maybe String
+    addPermission :: Maybe String,
+    skipCreator :: Maybe Bool
   }
 
 defProteus :: CreateConv
@@ -49,7 +50,8 @@ defProteus =
       protocol = "proteus",
       groupConvType = Nothing,
       cells = False,
-      addPermission = Nothing
+      addPermission = Nothing,
+      skipCreator = Nothing
     }
 
 defMLS :: CreateConv
@@ -84,7 +86,8 @@ instance MakesValue CreateConv where
                 "message_timer" .=? cc.messageTimer,
                 "receipt_mode" .=? cc.receiptMode,
                 "group_conv_type" .=? cc.groupConvType,
-                "add_permission" .=? cc.addPermission
+                "add_permission" .=? cc.addPermission,
+                "skip_creator" .=? cc.skipCreator
               ]
         )
 
@@ -271,7 +274,7 @@ postMLSCommitBundle cid msg = do
 postProteusMessage :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> QualifiedNewOtrMessage -> App Response
 postProteusMessage user conv msgs = do
   convDomain <- objDomain conv
-  convId <- objId conv
+  convId <- objQidObject conv & objId
   let bytes = Proto.encodeMessage msgs
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "proteus", "messages"])
   submit "POST" (addProtobuf bytes req)
@@ -443,7 +446,7 @@ postConversationCode ::
   Maybe String ->
   App Response
 postConversationCode user conv mbpassword mbZHost = do
-  convId <- objId conv
+  convId <- objQidObject conv & objId
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
   submit
     "POST"
@@ -459,7 +462,7 @@ getConversationCode ::
   Maybe String ->
   App Response
 getConversationCode user conv mbZHost = do
-  convId <- objId conv
+  convId <- objQidObject conv & objId
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
   submit
     "GET"
@@ -470,7 +473,7 @@ getConversationCode user conv mbZHost = do
 
 deleteConversationCode :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> App Response
 deleteConversationCode user conv = do
-  convId <- objId conv
+  convId <- objQidObject conv & objId
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
   submit "DELETE" req
 
@@ -804,7 +807,7 @@ getTeamMembersCsv user tid = do
 sendTypingStatus :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> String -> App Response
 sendTypingStatus user conv status = do
   convDomain <- objDomain conv
-  convId <- objId conv
+  convId <- objQidObject conv & objId
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "typing"])
   submit "POST"
     $ addJSONObject ["status" .= status] req

integration/test/Test/Bot.hs

@@ -111,7 +111,7 @@ withBotWithSettings settings k = do
         $ def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey}
     serviceId <- asString $ service %. "id"
     conv <- getJSON 201 =<< postConversation alice defProteus
-    convId <- conv %. "id" & asString
+    convId <- conv %. "qualified_id" & objId
     assertStatus 200 =<< updateServiceConn OwnDomain providerId serviceId do
       object ["enabled" .= True, "password" .= password]
     addBot alice providerId serviceId convId >>= k

integration/test/Test/Cells.hs

@@ -40,7 +40,7 @@ testCellsEvent = do
   do
     event <- getMessage q %. "payload.0"
     event %. "type" `shouldMatch` "conversation.member-join"
-    event %. "conversation" `shouldMatch` (conv %. "id")
+    event %. "conversation" `shouldMatch` (conv %. "qualified_id" & objId)
     event %. "qualified_from" `shouldMatch` (alice %. "qualified_id")
     users <- event %. "data.users" & asList
     assertOne users %. "qualified_id" `shouldMatch` chazId
@@ -51,7 +51,7 @@ testCellsEvent = do
   do
     event <- getMessage q %. "payload.0"
     event %. "type" `shouldMatch` "conversation.member-join"
-    event %. "conversation" `shouldMatch` (conv %. "id")
+    event %. "conversation" `shouldMatch` (conv %. "qualified_id" & objId)
     event %. "qualified_from" `shouldMatch` (alice %. "qualified_id")
     users <- event %. "data.users" & asList
     assertOne users %. "qualified_id" `shouldMatch` deanId
@@ -72,7 +72,7 @@ testCellsCreationEvent = do
 
   event <- getMessage q %. "payload.0"
   event %. "type" `shouldMatch` "conversation.create"
-  event %. "conversation" `shouldMatch` (conv %. "id")
+  event %. "conversation" `shouldMatch` (conv %. "qualified_id" & objId)
   event %. "qualified_from" `shouldMatch` (alice %. "qualified_id")
 
 testCellsFeatureCheck :: (HasCallStack) => App ()

integration/test/Test/Channels.hs

@@ -400,3 +400,14 @@ _testAddtermissionExternalPartner addPermission assertion = do
   createGroup def ownerClient convId
   void $ createAddCommit ownerClient convId [partner] >>= sendAndConsumeCommitBundle
   assertion partnerClient convId mems
+
+testTeamAdminCanCreateChannelWithoutJoining :: (HasCallStack) => App ()
+testTeamAdminCanCreateChannelWithoutJoining = do
+  (owner, tid, _) <- createTeam OwnDomain 1
+
+  setTeamFeatureLockStatus owner tid "channels" "unlocked"
+  void $ setTeamFeatureConfig owner tid "channels" (config "everyone")
+
+  postConversation owner defMLS {groupConvType = Just "channel", team = Just tid, skipCreator = Just True} `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 201
+    resp.json %. "members" `shouldMatch` ([] :: [Value])

integration/test/Test/Conversation.hs

@@ -862,7 +862,7 @@ testGuestLinksSuccess = do
     pure (k, v)
   bindResponse (getJoinCodeConv tm k v) $ \resp -> do
     resp.status `shouldMatchInt` 200
-    resp.json %. "id" `shouldMatch` objId conv
+    resp.json %. "id" `shouldMatch` (objQidObject conv & objId)
 
 testGuestLinksExpired :: (HasCallStack) => App ()
 testGuestLinksExpired = do

integration/test/Test/LegalHold.hs

@@ -24,6 +24,7 @@ import API.Galley
 import API.GalleyInternal
 import Control.Error (MaybeT (MaybeT), runMaybeT)
 import Control.Lens ((.~), (^?), (^?!))
+import Control.Monad.Extra (findM)
 import Control.Monad.Reader (asks, local)
 import Control.Monad.Trans.Class (lift)
 import Data.Aeson.Lens
@@ -789,20 +790,24 @@ testLHNoConsentRemoveFromGroup approvedOrPending admin = do
     postLegalHoldSettings tidAlice alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201
     withWebSockets [alice, bob] \[aws, bws] -> do
       connectTwoUsers alice bob
-      (convId, qConvId) <- do
+      qConvId <- do
         let (inviter, tidInviter, invitee, inviteeRole) = case admin of
               LegalholderIsAdmin -> (alice, tidAlice, bob, "wire_member")
               BothAreAdmins -> (alice, tidAlice, bob, "wire_admin")
               PeerIsAdmin -> (bob, tidBob, alice, "wire_member")
 
         let createConv = defProteus {qualifiedUsers = [invitee], newUsersRole = inviteeRole, team = Just tidInviter}
         postConversation inviter createConv `bindResponse` \resp -> do
-          resp.json %. "members.self.conversation_role" `shouldMatch` "wire_admin"
-          resp.json %. "members.others.0.conversation_role" `shouldMatch` case admin of
+          allMembers <- resp.json %. "members" & asList
+          selfMember <- findM (\m -> (==) <$> m %. "qualified_id" <*> inviter %. "qualified_id") allMembers
+          otherMember <- findM (\m -> (==) <$> m %. "qualified_id" <*> invitee %. "qualified_id") allMembers
+          selfMember %. "conversation_role" `shouldMatch` "wire_admin"
+          otherMember %. "conversation_role" `shouldMatch` case admin of
             BothAreAdmins -> "wire_admin"
             PeerIsAdmin -> "wire_member"
             LegalholderIsAdmin -> "wire_member"
-          (,) <$> resp.json %. "id" <*> resp.json %. "qualified_id"
+          resp.json %. "qualified_id"
+      let convId = objId qConvId
       for_ [aws, bws] \ws -> do
         awaitMatch isConvCreateNotifNotSelf ws >>= \pl -> pl %. "payload.0.conversation" `shouldMatch` convId