WPB-5695 Enforce group conversation permission for external partner role

changelog.d/3-bug-fixes/WPB-5695

@@ -0,0 +1 @@
+Enforce external partner permissions on the backend

integration/integration.cabal

@@ -110,6 +110,7 @@ library
     Test.Conversation
     Test.Demo
     Test.Errors
+    Test.ExternalPartner
     Test.Federation
     Test.Federator
     Test.MessageTimer

integration/test/API/Galley.hs

@@ -416,6 +416,7 @@ getConversationCode user conv mbZHost = do
         & maybe id zHost mbZHost
     )
 
+-- https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_conversations__cnv_domain___cnv__name
 changeConversationName ::
   (HasCallStack, MakesValue user, MakesValue conv, MakesValue name) =>
   user ->

integration/test/SetupHelpers.hs

@@ -26,7 +26,7 @@ deleteUser :: (HasCallStack, MakesValue user) => user -> App ()
 deleteUser user = bindResponse (API.Brig.deleteUser user) $ \resp -> do
   resp.status `shouldMatchInt` 200
 
--- | returns (user, team id)
+-- | returns (user, team id, members)
 createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value, String, [Value])
 createTeam domain memberCount = do
   res <- createUser domain def {team = True}

integration/test/Test/ExternalPartner.hs

@@ -0,0 +1,82 @@
+{-# 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.ExternalPartner where
+
+import API.Galley
+import GHC.Stack
+import MLS.Util
+import SetupHelpers
+import Testlib.Prelude
+
+testExternalPartnerPermissions :: HasCallStack => App ()
+testExternalPartnerPermissions = do
+  (owner, tid, u1 : u2 : u3 : _) <- createTeam OwnDomain 6
+
+  partner <- createTeamMemberWithRole owner tid "partner"
+
+  -- a partner should not be able to create conversation with more than 2 users
+  void $ postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1, u2]}) >>= getJSON 403
+
+  do
+    -- a partner can create a one to one conversation with a user from the same team
+    conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201
+
+    -- they should not be able to add another team member to the one to one conversation
+    bindResponse (addMembers partner conv def {users = [u2]}) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+
+    -- the other member in the conversation gets deleted
+    deleteUser u1
+
+    -- now they still should not be able to add another member
+    bindResponse (addMembers partner conv def {users = [u2]}) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+
+  do
+    -- also an external partner cannot add someone to a conversation, even if it is empty
+    conv <- postConversation partner (defProteus {team = Just tid}) >>= getJSON 201
+    bindResponse (addMembers partner conv def {users = [u3]}) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+
+testExternalPartnerPermissionsMls :: HasCallStack => App ()
+testExternalPartnerPermissionsMls = do
+  -- external partners should not be able to create (MLS) conversations
+  (owner, tid, _) <- createTeam OwnDomain 2
+  bobExt <- createTeamMemberWithRole owner tid "partner"
+  bobExtClient <- createMLSClient def bobExt
+  bindResponse (postConversation bobExtClient defMLS) $ \resp -> do
+    resp.status `shouldMatchInt` 403
+
+testExternalPartnerPermissionMlsOne2One :: HasCallStack => App ()
+testExternalPartnerPermissionMlsOne2One = do
+  (owner, tid, alice : _) <- createTeam OwnDomain 2
+  bobExternal <- createTeamMemberWithRole owner tid "partner"
+  void $ getMLSOne2OneConversation alice bobExternal >>= getJSON 200
+
+testExternalPartnerPermissionsConvName :: HasCallStack => App ()
+testExternalPartnerPermissionsConvName = do
+  (owner, tid, u1 : _) <- createTeam OwnDomain 2
+
+  partner <- createTeamMemberWithRole owner tid "partner"
+
+  conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201
+
+  bindResponse (changeConversationName partner conv "new name") $ \resp -> do
+    resp.status `shouldMatchInt` 403

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

@@ -91,6 +91,7 @@ import Galley.Env (Env)
 import Galley.Intra.Push
 import Galley.Options
 import Galley.Types.Conversations.Members
+import Galley.Types.Teams (IsPerm (hasPermission))
 import Galley.Types.UserList
 import Galley.Validation
 import Imports hiding ((\\))
@@ -122,6 +123,7 @@ import Wire.API.Routes.Internal.Brig.Connection
 import Wire.API.Team.Feature
 import Wire.API.Team.LegalHold
 import Wire.API.Team.Member
+import Wire.API.Team.Permission (Perm (DoNotUseDeprecatedAddRemoveConvMember, DoNotUseDeprecatedModifyConvName))
 import Wire.API.User qualified as User
 
 data NoChanges = NoChanges
@@ -202,7 +204,9 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con
     )
   HasConversationActionEffects 'ConversationRenameTag r =
     ( Member (Error InvalidInput) r,
-      Member ConversationStore r
+      Member ConversationStore r,
+      Member TeamStore r,
+      Member (ErrorS InvalidOperation) r
     )
   HasConversationActionEffects 'ConversationAccessDataTag r =
     ( Member BotAccess r,
@@ -464,6 +468,10 @@ performAction tag origUser lconv action = do
 
       pure (mempty, action)
     SConversationRenameTag -> do
+      zusrMembership <- join <$> forM (cnvmTeam (convMetadata conv)) (flip E.getTeamMember (qUnqualified origUser))
+      case zusrMembership of
+        Just tm -> unless (tm `hasPermission` DoNotUseDeprecatedModifyConvName) $ throwS @'InvalidOperation
+        Nothing -> pure ()
       cn <- rangeChecked (cupName action)
       E.setConversationName (tUnqualified lcnv) cn
       pure (mempty, action)
@@ -520,7 +528,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do
   checkLHPolicyConflictsLocal (ulLocals newMembers)
   checkLHPolicyConflictsRemote (FutureWork (ulRemotes newMembers))
   checkRemoteBackendsConnected lusr
-
+  checkTeamMemberAddPermissions lusr
   addMembersToLocalConversation (fmap (.convId) lconv) newMembers role
   where
     checkRemoteBackendsConnected :: Local x -> Sem r ()
@@ -609,6 +617,12 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do
       Sem r ()
     checkLHPolicyConflictsRemote _remotes = pure ()
 
+    checkTeamMemberAddPermissions :: Local UserId -> Sem r ()
+    checkTeamMemberAddPermissions lusr =
+      forM (cnvmTeam (convMetadata conv)) (flip E.getTeamMember (tUnqualified lusr))
+        >>= (maybe (pure ()) (\tm -> unless (tm `hasPermission` DoNotUseDeprecatedAddRemoveConvMember) $ throwS @'InvalidOperation))
+          . join
+
 performConversationAccessData ::
   ( HasConversationActionEffects 'ConversationAccessDataTag r,
     Member (Error FederationError) r,

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

@@ -31,6 +31,7 @@ module Galley.API.Create
   )
 where
 
+import Control.Error (headMay)
 import Control.Lens hiding ((??))
 import Data.Id
 import Data.List1 (list1)
@@ -244,10 +245,15 @@ checkCreateConvPermissions ::
 checkCreateConvPermissions lusr _newConv Nothing allUsers = do
   activated <- listToMaybe <$> lookupActivatedUsers [tUnqualified lusr]
   void $ noteS @OperationDenied activated
+  -- an external partner is not allowed to create group conversations (except 1:1 team conversations that are handled below)
+  zusrMembership <- getTeamMember (tUnqualified lusr) Nothing
+  case zusrMembership of
+    Just tm -> void $ permissionCheck DoNotUseDeprecatedAddRemoveConvMember (Just tm)
+    Nothing -> pure ()
   ensureConnected lusr allUsers
 checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do
   let convTeam = cnvTeamId tinfo
-  zusrMembership <- E.getTeamMember convTeam (tUnqualified lusr)
+  zusrMembership <- getTeamMember (tUnqualified lusr) (Just convTeam)
   void $ permissionCheck CreateConversation zusrMembership
   convLocalMemberships <- mapM (E.getTeamMember convTeam) (ulLocals allUsers)
   ensureAccessRole (accessRoles newConv) (zip (ulLocals allUsers) convLocalMemberships)
@@ -261,14 +267,20 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do
   -- Not sure at the moment how to best solve this but it is unlikely
   -- we can ever get rid of the team permission model anyway - the only thing I can
   -- think of is that 'partners' can create convs but not be admins...
-  when (length allUsers > 1) $ do
+  -- this only applies to proteus conversations, because in MLS we have proper 1:1 conversations,
+  -- so we don't allow an external partner to create an MLS group conversation at all
+  when (length allUsers > 1 || newConv.newConvProtocol == BaseProtocolMLSTag) $ do
     void $ permissionCheck DoNotUseDeprecatedAddRemoveConvMember zusrMembership
 
   -- Team members are always considered to be connected, so we only check
   -- 'ensureConnected' for non-team-members.
   ensureConnectedToLocals (tUnqualified lusr) (notTeamMember (ulLocals allUsers) (catMaybes convLocalMemberships))
   ensureConnectedToRemotes lusr (ulRemotes allUsers)
 
+getTeamMember :: Member TeamStore r => UserId -> Maybe TeamId -> Sem r (Maybe TeamMember)
+getTeamMember uid (Just tid) = E.getTeamMember tid uid
+getTeamMember uid Nothing = E.getUserTeams uid >>= maybe (pure Nothing) (flip E.getTeamMember uid) . headMay
+
 ----------------------------------------------------------------------------
 -- Other kinds of conversations
 

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

@@ -1375,7 +1375,8 @@ updateConversationName ::
     Member ExternalAccess r,
     Member GundeckAccess r,
     Member (Input UTCTime) r,
-    Member (Logger (Msg -> Msg)) r
+    Member (Logger (Msg -> Msg)) r,
+    Member TeamStore r
   ) =>
   Local UserId ->
   ConnId ->
@@ -1401,7 +1402,8 @@ updateUnqualifiedConversationName ::
     Member ExternalAccess r,
     Member GundeckAccess r,
     Member (Input UTCTime) r,
-    Member (Logger (Msg -> Msg)) r
+    Member (Logger (Msg -> Msg)) r,
+    Member TeamStore r
   ) =>
   Local UserId ->
   ConnId ->
@@ -1423,7 +1425,8 @@ updateLocalConversationName ::
     Member ExternalAccess r,
     Member GundeckAccess r,
     Member (Input UTCTime) r,
-    Member (Logger (Msg -> Msg)) r
+    Member (Logger (Msg -> Msg)) r,
+    Member TeamStore r
   ) =>
   Local UserId ->
   ConnId ->