WBP-5133 External partners search restriction enforced by backend

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

@@ -0,0 +1 @@
+External partners search restriction enforced by backend

integration/test/API/Galley.hs

@@ -485,3 +485,9 @@ updateMessageTimer user qcnv update = do
   let path = joinHttpPath ["conversations", cnvDomain, cnvId, "message-timer"]
   req <- baseRequest user Galley Versioned path
   submit "PUT" (addJSONObject ["message_timer" .= updateReq] req)
+
+getTeamMembers :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
+getTeamMembers user tid = do
+  tidStr <- asString tid
+  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "members"])
+  submit "GET" req

integration/test/SetupHelpers.hs

@@ -40,9 +40,17 @@ createTeamMember ::
   inviter ->
   String ->
   App Value
-createTeamMember inviter tid = do
+createTeamMember inviter tid = createTeamMemberWithRole inviter tid "member"
+
+createTeamMemberWithRole ::
+  (HasCallStack, MakesValue inviter) =>
+  inviter ->
+  String ->
+  String ->
+  App Value
+createTeamMemberWithRole inviter tid role = do
   newUserEmail <- randomEmail
-  let invitationJSON = ["role" .= "member", "email" .= newUserEmail]
+  let invitationJSON = ["role" .= role, "email" .= newUserEmail]
   invitationReq <-
     baseRequest inviter Brig Versioned $
       joinHttpPath ["teams", tid, "invitations"]

integration/test/Test/Search.hs

@@ -3,6 +3,8 @@ module Test.Search where
 import API.Brig qualified as BrigP
 import API.BrigInternal qualified as BrigI
 import API.Common qualified as API
+import API.Galley
+import API.Galley qualified as Galley
 import API.GalleyInternal qualified as GalleyI
 import GHC.Stack
 import SetupHelpers
@@ -15,14 +17,45 @@ import Testlib.Prelude
 testSearchContactForExternalUsers :: HasCallStack => App ()
 testSearchContactForExternalUsers = do
   owner <- randomUser OwnDomain def {BrigI.team = True}
-  partner <- randomUser OwnDomain def {BrigI.team = True}
+  tid <- owner %. "team" & asString
 
-  bindResponse (GalleyI.putTeamMember partner (partner %. "team") (API.teamRole "partner")) $ \resp ->
+  partner <- createTeamMemberWithRole owner tid "partner"
+  tm1 <- createTeamMember owner tid
+  tm2 <- createTeamMember owner tid
+
+  -- a team member can search for contacts
+  bindResponse (BrigP.searchContacts tm1 (owner %. "name") OwnDomain) $ \resp ->
     resp.status `shouldMatchInt` 200
 
+  -- a partner is not allowed to search for contacts
   bindResponse (BrigP.searchContacts partner (owner %. "name") OwnDomain) $ \resp ->
     resp.status `shouldMatchInt` 403
 
+  -- a team member can see all other team members
+  bindResponse (Galley.getTeamMembers tm1 tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    assertContainsUserIds resp [owner, tm1, tm2, partner]
+
+  -- an external partner should see the person who invited them
+  bindResponse (Galley.getTeamMembers partner tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    assertContainsUserIds resp [owner, partner]
+
+  -- the team owner creates a conversation with the partner and another team member
+  void $ postConversation owner (defProteus {qualifiedUsers = [tm1, partner], team = Just tid}) >>= getJSON 201
+
+  -- now the external partner should still only the person who invited them
+  bindResponse (Galley.getTeamMembers partner tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    assertContainsUserIds resp [owner, partner]
+  where
+    assertContainsUserIds :: Response -> [Value] -> App ()
+    assertContainsUserIds resp users = do
+      members <- resp.json %. "members" & asList
+      userIds <- for members (\m -> m %. "user")
+      expected <- for users objId
+      userIds `shouldMatchSet` expected
+
 --------------------------------------------------------------------------------
 -- FEDERATION SEARCH
 

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

@@ -493,10 +493,18 @@ getTeamMembers ::
   Maybe TeamMembersPagingState ->
   Sem r TeamMembersPage
 getTeamMembers lzusr tid mbMaxResults mbPagingState = do
-  member <- E.getTeamMember tid (tUnqualified lzusr) >>= noteS @'NotATeamMember
+  let uid = tUnqualified lzusr
+  member <- E.getTeamMember tid uid >>= noteS @'NotATeamMember
   let mState = C.PagingState . LBS.fromStrict <$> (mbPagingState >>= mtpsState)
   let mLimit = fromMaybe (unsafeRange Public.hardTruncationLimit) mbMaxResults
-  E.listTeamMembers @CassandraPaging tid mState mLimit <&> toTeamMembersPage member
+  if member `hasPermission` SearchContacts
+    then E.listTeamMembers @CassandraPaging tid mState mLimit <&> toTeamMembersPage member
+    else do
+      -- If the user does not have the SearchContacts permission (e.g. the external partner),
+      -- we only return the person who invited them and the self user.
+      let invitee = member ^. invitation <&> fst
+      let uids = maybe [uid] (: [uid]) invitee
+      E.selectTeamMembersPaginated tid uids mState mLimit <&> toTeamMembersPage member
   where
     toTeamMembersPage :: TeamMember -> C.PageWithState TeamMember -> TeamMembersPage
     toTeamMembersPage member p =

services/galley/src/Galley/Cassandra/Team.hs

@@ -104,6 +104,7 @@ interpretTeamStoreToCassandra lh = interpret $ \case
     menv <- inputs (view aEnv)
     for_ menv $ \env ->
       embed @IO $ Aws.execute env (Aws.enqueue e)
+  SelectTeamMembersPaginated tid uids mps lim -> embedClient $ selectSomeTeamMembersPaginated lh tid uids mps lim
 
 interpretTeamListToCassandra ::
   ( Member (Embed IO) r,
@@ -488,3 +489,15 @@ teamMembersPageFrom lh tid pagingState (fromRange -> max) = do
   page <- paginateWithState Cql.selectTeamMembers (paramsPagingState LocalQuorum (Identity tid) max pagingState)
   members <- mapM (newTeamMember' lh tid) (pwsResults page)
   pure $ PageWithState members (pwsState page)
+
+selectSomeTeamMembersPaginated ::
+  FeatureLegalHold ->
+  TeamId ->
+  [UserId] ->
+  Maybe PagingState ->
+  Range 1 HardTruncationLimit Int32 ->
+  Client (PageWithState TeamMember)
+selectSomeTeamMembersPaginated lh tid uids pagingState (fromRange -> max) = do
+  page <- paginateWithState Cql.selectTeamMembers' (paramsPagingState LocalQuorum (tid, uids) max pagingState)
+  members <- mapM (newTeamMember' lh tid) (pwsResults page)
+  pure $ PageWithState members (pwsState page)

services/galley/src/Galley/Effects/TeamStore.hs

@@ -61,6 +61,7 @@ module Galley.Effects.TeamStore
     getBillingTeamMembers,
     getTeamAdmins,
     selectTeamMembers,
+    selectTeamMembersPaginated,
 
     -- ** Update team members
     setTeamMemberPermissions,
@@ -92,6 +93,7 @@ import Wire.API.Team.Conversation
 import Wire.API.Team.Member (HardTruncationLimit, TeamMember, TeamMemberList)
 import Wire.API.Team.Permission
 import Wire.Sem.Paging
+import Wire.Sem.Paging.Cassandra (CassandraPaging)
 
 data TeamStore m a where
   CreateTeamMember :: TeamId -> TeamMember -> TeamStore m ()
@@ -116,6 +118,12 @@ data TeamStore m a where
   GetTeamMembersWithLimit :: TeamId -> Range 1 HardTruncationLimit Int32 -> TeamStore m TeamMemberList
   GetTeamMembers :: TeamId -> TeamStore m [TeamMember]
   SelectTeamMembers :: TeamId -> [UserId] -> TeamStore m [TeamMember]
+  SelectTeamMembersPaginated ::
+    TeamId ->
+    [UserId] ->
+    Maybe (PagingState CassandraPaging TeamMember) ->
+    PagingBounds CassandraPaging TeamMember ->
+    TeamStore m (Page CassandraPaging TeamMember)
   GetUserTeams :: UserId -> TeamStore m [TeamId]
   GetUsersTeams :: [UserId] -> TeamStore m (Map UserId TeamId)
   GetOneUserTeam :: UserId -> TeamStore m (Maybe TeamId)