WPB-16387 add team admins with wire admin permissions to channels

changelog.d/2-features/WPB-16387

@@ -0,0 +1 @@
+Team admins have conversation admin permissions in channels

integration/test/API/Galley.hs

@@ -120,6 +120,23 @@ deleteTeamMember tid owner mem = do
   req <- baseRequest owner Galley Versioned path
   submit "DELETE" (addJSONObject ["password" .= defPassword] req)
 
+data TeamPermissions = Partner | Member | Admin | Owner
+
+instance ToJSON TeamPermissions where
+  toJSON perms = object ["self" .= toInt perms, "copy" .= toInt perms]
+    where
+      toInt Partner = Number 1025
+      toInt Member = Number 1587
+      toInt Admin = Number 5951
+      toInt Owner = Number 8191
+
+updateTeamMember :: (HasCallStack, MakesValue user, MakesValue member) => String -> user -> member -> TeamPermissions -> App Response
+updateTeamMember tid owner mem permissions = do
+  memId <- objId mem
+  let path = joinHttpPath ["teams", tid, "members"]
+  req <- baseRequest owner Galley Versioned path
+  submit "PUT" (req & addJSONObject ["member" .= object ["user" .= memId, "permissions" .= permissions]])
+
 putConversationProtocol ::
   ( HasCallStack,
     MakesValue user,
@@ -435,6 +452,12 @@ getConversationCode user conv mbZHost = do
         & maybe id zHost mbZHost
     )
 
+deleteConversationCode :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> App Response
+deleteConversationCode user conv = do
+  convId <- objId conv
+  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
+  submit "DELETE" req
+
 getJoinCodeConv :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
 getJoinCodeConv u k v = do
   req <- baseRequest u Galley Versioned (joinHttpPath ["conversations", "join"])
@@ -769,3 +792,9 @@ sendTypingStatus user conv status = do
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "typing"])
   submit "POST"
     $ addJSONObject ["status" .= status] req
+
+updateConversationSelf :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> Value -> App Response
+updateConversationSelf user conv payload = do
+  (domain, cnv) <- objQid conv
+  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", domain, cnv, "self"])
+  submit "PUT" $ req & addJSON payload

integration/test/MLS/Util.hs

@@ -226,6 +226,7 @@ createGroup cs cid convId = do
           MLSConv
             { members = Set.singleton cid,
               newMembers = mempty,
+              membersToBeRemoved = mempty,
               groupId,
               convId = convId,
               epoch = 0,
@@ -263,6 +264,7 @@ resetOne2OneGroupGeneric cs cid conv keys = do
           MLSConv
             { members = Set.singleton cid,
               newMembers = mempty,
+              membersToBeRemoved = mempty,
               groupId = groupId,
               convId = convId,
               epoch = 0,
@@ -436,6 +438,17 @@ createRemoveCommit cid convId targets = do
       )
       Nothing
 
+  modifyMLSState $ \mls ->
+    mls
+      { convs =
+          Map.adjust
+            ( \oldConvState ->
+                oldConvState {membersToBeRemoved = Set.fromList targets}
+            )
+            convId
+            mls.convs
+      }
+
   welcome <- liftIO $ BS.readFile welcomeFile
   gi <- liftIO $ BS.readFile giFile
 
@@ -703,15 +716,16 @@ sendAndConsumeCommitBundleWithProtocol protocol mp = do
         when (Set.member mp.sender conv.newMembers) $
           traverse_ (fromWelcome mp.convId conv.ciphersuite mp.sender) mp.welcome
 
-      -- increment epoch and add new clients
+      -- increment epoch and add new/remove clients
       modifyMLSState $ \mls ->
         mls
           { convs =
               Map.adjust
                 ( \conv ->
                     conv
                       { epoch = conv.epoch + 1,
-                        members = conv.members <> conv.newMembers,
+                        members = (conv.members <> conv.newMembers) Set.\\ conv.membersToBeRemoved,
+                        membersToBeRemoved = mempty,
                         newMembers = mempty
                       }
                 )

integration/test/Test/Channels.hs

@@ -19,10 +19,11 @@
 
 module Test.Channels where
 
+import API.Common (randomName)
 import API.Galley
 import API.GalleyInternal hiding (setTeamFeatureConfig)
 import GHC.Stack
-import MLS.Util (createMLSClient, uploadNewKeyPackage)
+import MLS.Util
 import SetupHelpers
 import Testlib.JSON
 import Testlib.Prelude
@@ -115,3 +116,92 @@ config perms =
             "allowed_to_open_channels" .= perms
           ]
     ]
+
+testTeamAdminPermissions :: (HasCallStack) => App ()
+testTeamAdminPermissions = do
+  (owner, tid, mem : nonAdmin : mems) <- createTeam OwnDomain 10
+  clients@(ownerClient : memClient : nonAdminClient : _) <- for (owner : mem : nonAdmin : mems) $ createMLSClient def 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)) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    members <- resp.json %. "members" %. "others" & asList
+    for members (\m -> m %. "id") `shouldMatchSet` (for [owner, nonAdmin] (\m -> m %. "id"))
+    for_ members $ \m -> do
+      m %. "conversation_role" `shouldMatch` "wire_member"
+
+  let otherMembers = mems `zip` drop 3 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 convId conv user userClient (userToAdd, userToAddClient) userToUpdate = do
+      newName <- randomName
+      changeConversationName user conv newName >>= assertSuccess
+      updateReceiptMode user conv (42 :: Int) >>= 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
+      bindResponse (getConversation user conv) $ \resp -> do
+        resp.status `shouldMatchInt` 200
+        resp.json %. "name" `shouldMatch` newName
+        resp.json %. "receipt_mode" `shouldMatchInt` 42
+        resp.json %. "message_timer" `shouldMatchInt` 1000
+        asList (resp.json %. "access_role") `shouldMatchSet` ["team_member", "guest"]
+        resp.json %. "members.self.otr_archived" `shouldMatch` True
+      void $ createAddCommit userClient convId [userToAdd] >>= sendAndConsumeCommitBundle
+      void $ createRemoveCommit userClient convId [userToAddClient] >>= sendAndConsumeCommitBundle
+
+    assertNoChannelAdminPermission :: (HasCallStack) => ConvId -> Value -> Value -> ClientIdentity -> (Value, ClientIdentity) -> ClientIdentity -> App ()
+    assertNoChannelAdminPermission convId conv user userClient (userToAdd, _) userToUpdate = do
+      newName <- randomName
+      changeConversationName user conv newName `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "action-denied"
+      updateReceiptMode user conv (41 :: Int) `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "action-denied"
+      updateMessageTimer user conv 2000 `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "action-denied"
+      updateAccess user conv (["access" .= ["code"], "access_role" .= ["team_member", "guest"]]) `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "action-denied"
+      updateConversationMember user conv userToUpdate "wire_member" `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "action-denied"
+      tid <- user %. "team" & asString
+      deleteTeamConv tid conv user `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "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] >>= \mp -> postMLSCommitBundle userClient (mkBundle mp) >>= assertStatus 403
+      modifyMLSState (const mlsState)
+      createRemoveCommit userClient convId [userToUpdate] >>= \mp -> postMLSCommitBundle userClient (mkBundle mp) >>= assertStatus 403
+      modifyMLSState (const mlsState)

integration/test/Testlib/Types.hs

@@ -322,10 +322,20 @@ data MLSState = MLSState
   }
   deriving (Show)
 
+printMLSState :: MLSState -> String
+printMLSState MLSState {convs, clientGroupState} =
+  "MLSState {"
+    <> "convs = "
+    <> show convs
+    <> ", clientGroupState = "
+    <> show (Map.keys clientGroupState)
+    <> "}"
+
 data MLSConv = MLSConv
   { members :: Set ClientIdentity,
     -- | users expected to receive a welcome message after the next commit
     newMembers :: Set ClientIdentity,
+    membersToBeRemoved :: Set ClientIdentity,
     groupId :: String,
     convId :: ConvId,
     epoch :: Word64,

services/galley/src/Galley/API/Action.hs

@@ -32,7 +32,6 @@ module Galley.API.Action
     pushTypingIndicatorEvents,
 
     -- * Utilities
-    ensureConversationActionAllowed,
     addMembersToLocalConversation,
     notifyConversationAction,
     updateLocalStateOfRemoteConv,
@@ -734,7 +733,8 @@ updateLocalConversation ::
     Member NotificationSubsystem r,
     Member (Input UTCTime) r,
     HasConversationActionEffects tag r,
-    SingI tag
+    SingI tag,
+    Member TeamStore r
   ) =>
   Local ConvId ->
   Qualified UserId ->
@@ -772,7 +772,8 @@ updateLocalConversationUnchecked ::
     Member ExternalAccess r,
     Member NotificationSubsystem r,
     Member (Input UTCTime) r,
-    HasConversationActionEffects tag r
+    HasConversationActionEffects tag r,
+    Member TeamStore r
   ) =>
   Local Conversation ->
   Qualified UserId ->
@@ -784,8 +785,10 @@ updateLocalConversationUnchecked lconv qusr con action = do
       lcnv = fmap (.convId) lconv
       conv = tUnqualified lconv
 
+  mTeamMember <- foldQualified lconv (getTeamMembership conv) (const $ pure Nothing) qusr
+
   -- retrieve member
-  self <- noteS @'ConvNotFound $ getConvMember lconv conv qusr
+  self <- noteS @'ConvNotFound $ getConvMember lconv conv (maybe (ConvMemberNoTeam qusr) ConvMemberTeam mTeamMember)
 
   -- perform checks
   ensureConversationActionAllowed (sing @tag) lcnv action conv self
@@ -801,6 +804,9 @@ updateLocalConversationUnchecked lconv qusr con action = do
     lconv
     (convBotsAndMembers conv <> extraTargets)
     action'
+  where
+    getTeamMembership :: Conversation -> Local UserId -> Sem r (Maybe TeamMember)
+    getTeamMembership conv luid = maybe (pure Nothing) (`E.getTeamMember` tUnqualified luid) conv.convMetadata.cnvmTeam
 
 -- --------------------------------------------------------------------------------
 -- -- Utilities

services/galley/src/Galley/API/Federation.hs

@@ -273,7 +273,8 @@ leaveConversation ::
     Member ProposalStore r,
     Member Random r,
     Member SubConversationStore r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member TeamStore r
   ) =>
   Domain ->
   LeaveConversationRequest ->

services/galley/src/Galley/API/Query.hs

@@ -80,6 +80,7 @@ import Galley.Effects.ConversationStore qualified as E
 import Galley.Effects.FederatorAccess qualified as E
 import Galley.Effects.ListItems qualified as E
 import Galley.Effects.MemberStore qualified as E
+import Galley.Effects.TeamStore qualified as E
 import Galley.Env
 import Galley.Options
 import Galley.Types.Conversations.Members
@@ -107,6 +108,7 @@ import Wire.API.MLS.Keys
 import Wire.API.Provider.Bot qualified as Public
 import Wire.API.Routes.MultiTablePaging qualified as Public
 import Wire.API.Team.Feature as Public
+import Wire.API.Team.Member (TeamMember, isAdminOrOwner, permissions)
 import Wire.API.User
 import Wire.HashPassword (HashPassword)
 import Wire.RateLimit
@@ -685,14 +687,16 @@ getConversationGuestLinksStatus ::
     Member (ErrorS 'ConvNotFound) r,
     Member (ErrorS 'ConvAccessDenied) r,
     Member (Input Opts) r,
-    Member TeamFeatureStore r
+    Member TeamFeatureStore r,
+    Member TeamStore r
   ) =>
   UserId ->
   ConvId ->
   Sem r (LockableFeature GuestLinksConfig)
 getConversationGuestLinksStatus uid convId = do
   conv <- E.getConversation convId >>= noteS @'ConvNotFound
-  ensureConvAdmin (Data.convLocalMembers conv) uid
+  mTeamMember <- maybe (pure Nothing) (flip E.getTeamMember uid) conv.convMetadata.cnvmTeam
+  ensureConvAdmin conv uid mTeamMember
   getConversationGuestLinksFeatureStatus (Data.convTeam conv)
 
 getConversationGuestLinksFeatureStatus ::
@@ -975,10 +979,20 @@ ensureConvAdmin ::
   ( Member (ErrorS 'ConvAccessDenied) r,
     Member (ErrorS 'ConvNotFound) r
   ) =>
-  [LocalMember] ->
+  Data.Conversation ->
   UserId ->
+  Maybe TeamMember ->
   Sem r ()
-ensureConvAdmin users uid =
-  case find ((== uid) . lmId) users of
+ensureConvAdmin conversation uid mTeamMember = do
+  case find ((== uid) . lmId) conversation.convLocalMembers of
     Nothing -> throwS @'ConvNotFound
-    Just lm -> unless (lmConvRoleName lm == roleNameWireAdmin) $ throwS @'ConvAccessDenied
+    Just lm -> unless (hasAdminPermissions lm) $ throwS @'ConvAccessDenied
+  where
+    hasAdminPermissions :: LocalMember -> Bool
+    hasAdminPermissions lm = lmConvRoleName lm == roleNameWireAdmin || isChannelAdmin mTeamMember
+
+    isChannelAdmin :: Maybe TeamMember -> Bool
+    isChannelAdmin Nothing = False
+    isChannelAdmin (Just tm) =
+      conversation.convMetadata.cnvmGroupConvType == Just Channel
+        && isAdminOrOwner (tm ^. permissions)