From 0f6a8414cdc7a36558e12b65e22f9d7faa7991dd Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 8 May 2026 16:19:18 +0200 Subject: [PATCH 1/4] Changelog. --- ...e-team-conversation-access-control-more-collaborator-friendly | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/WPB-25521-refactor_-make-team-conversation-access-control-more-collaborator-friendly diff --git a/changelog.d/5-internal/WPB-25521-refactor_-make-team-conversation-access-control-more-collaborator-friendly b/changelog.d/5-internal/WPB-25521-refactor_-make-team-conversation-access-control-more-collaborator-friendly new file mode 100644 index 0000000000..0b8c9950b7 --- /dev/null +++ b/changelog.d/5-internal/WPB-25521-refactor_-make-team-conversation-access-control-more-collaborator-friendly @@ -0,0 +1 @@ +Refactor: make team conversation access control more collaborator-friendly. From 272c5bc9f5088bd70b712a212b77bc388d0f59ac Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 8 May 2026 16:19:41 +0200 Subject: [PATCH 2/4] Refactor: team conversation access control. This syntax-only change lays the ground-work abstracts "get member and if that fails get collaborator and apply `hasPermissions` to whichever you found" away behind "lookup principle and apply `hasPermissions`". --- libs/wire-api/src/Wire/API/Team/Member.hs | 20 +++++++++++++++++++ .../src/Wire/ConversationSubsystem/Action.hs | 4 ++-- .../ConversationSubsystem/CreateInternal.hs | 9 +++------ .../src/Wire/ConversationSubsystem/Util.hs | 6 +++--- .../wire-subsystems/src/Wire/TeamSubsystem.hs | 16 +++++++++++++++ 5 files changed, 44 insertions(+), 11 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 7a0b09dbe0..f00baa553a 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -71,6 +71,10 @@ module Wire.API.Team.Member IsPerm (..), HiddenPerm (..), mkSingleTeamMembersPage, + + -- * TeamPrincipal + TeamPrincipal, + isFullTeamMember, ) where @@ -657,6 +661,22 @@ collaboratorToTeamPermissions = Collaborator.ImplicitConnection -> mempty ) +-- | A user associated with a team, either as a collaborator (@Left@) or as a +-- full team member (@Right@). The 'IsPerm' instance is derived automatically +-- via the 'Either' instance, using 'collaboratorToTeamPermissions' for the +-- @Left@ case. +type TeamPrincipal = Either TeamCollaborator TeamMember + +-- | True only for full team members, not for collaborators. +-- Used in conversation access-role checks that enforce team-member-only +-- conversations, preserving the invariant that collaborators are not +-- considered equivalent to full members for access control. +-- +-- (We probably do not want to discriminate against collaborators in +-- this way, but that's a semantic change for another PR.) +isFullTeamMember :: TeamPrincipal -> Bool +isFullTeamMember = isRight + ---------------------------------------------------------------------- makeLenses ''TeamMember' diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs index 3c81ed700f..cbe8822133 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs @@ -794,8 +794,8 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do tms <- Map.fromList . map (view Wire.API.Team.Member.userId &&& Imports.id) <$> TeamSubsystem.internalSelectTeamMembers tid newUsers - let userMembershipMap = map (Imports.id &&& flip Map.lookup tms) newUsers - ensureAccessRole (convAccessRoles conv) userMembershipMap + let userMembershipMap = map (Imports.id &&& (fmap Right . flip Map.lookup tms)) newUsers + in ensureAccessRole (convAccessRoles conv) userMembershipMap ensureConnectedToLocalsOrSameTeam lusr newUsers checkLocals lusr Nothing newUsers = do ensureAccessRole (convAccessRoles conv) (map (,Nothing) newUsers) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs index e28425c906..142b1f7e10 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs @@ -330,11 +330,8 @@ checkCreateConvPermissions lusr newConv Nothing allUsers = do ensureConnected lusr allUsers checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do let convTeam = cnvTeamId tinfo - mTeamMember <- getTeamMember (tUnqualified lusr) (Just convTeam) - teamAssociation <- case mTeamMember of - Just tm -> pure (Just (Right tm)) - Nothing -> do - Left <$$> internalGetTeamCollaborator convTeam (tUnqualified lusr) + teamAssociation <- TeamSubsystem.lookupTeamPrincipal convTeam (tUnqualified lusr) + let mTeamMember = teamAssociation >>= either (const Nothing) Just let checkGroup = do void $ permissionCheck CreateConversation teamAssociation @@ -347,7 +344,7 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do MeetingConversation -> checkGroup convLocalMemberships <- mapM (flip TeamSubsystem.internalGetTeamMember convTeam) (ulLocals allUsers) - ensureAccessRole (accessRoles newConv) (zip (ulLocals allUsers) convLocalMemberships) + ensureAccessRole (accessRoles newConv) (zip (ulLocals allUsers) (fmap (fmap Right) convLocalMemberships)) ensureConnectedToLocals (tUnqualified lusr) (notTeamMember (ulLocals allUsers) (catMaybes convLocalMemberships)) ensureConnectedToRemotes lusr (ulRemotes allUsers) where diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs index 78d7019397..4809d8fefd 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs @@ -115,12 +115,12 @@ ensureAccessRole :: Member (ErrorS 'ConvAccessDenied) r ) => Set Public.AccessRole -> - [(UserId, Maybe TeamMember {- isJust iff user and conv are in the same team -})] -> + [(UserId, Maybe TeamPrincipal {- Just (Right tm) iff full team member, Just (Left c) iff collaborator, Nothing otherwise -})] -> Sem r () ensureAccessRole roles users = do when (Set.null roles) $ throwS @'ConvAccessDenied unless (NonTeamMemberAccessRole `Set.member` roles) $ - when (any (isNothing . snd) users) $ + when (any (maybe True (not . isFullTeamMember) . snd) users) $ throwS @'NotATeamMember unless (Set.fromList [GuestAccessRole, ServiceAccessRole] `Set.isSubsetOf` roles) $ do activated <- lookupActivatedUsers (fst <$> users) @@ -685,7 +685,7 @@ ensureConversationAccess :: ensureConversationAccess zusr conv access = do ensureAccess conv access zusrMembership <- maybe (pure Nothing) (TeamSubsystem.internalGetTeamMember zusr) (Data.convTeam conv) - ensureAccessRole (Data.convAccessRoles conv) [(zusr, zusrMembership)] + ensureAccessRole (Data.convAccessRoles conv) [(zusr, fmap Right zusrMembership)] ensureAccess :: (Member (ErrorS 'ConvAccessDenied) r) => diff --git a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs index cd4fa9a7ca..98e70ee0e2 100644 --- a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs @@ -33,6 +33,7 @@ import Wire.API.Team.LegalHold (UserLegalHoldStatusResponse) import Wire.API.Team.Member import Wire.API.Team.Member.Error import Wire.API.Team.Member.Info (TeamMemberInfoList) +import Wire.TeamCollaboratorsSubsystem data PermissionCheckArgs teamAssociation where PermissionCheckArgs :: @@ -144,3 +145,18 @@ checkConsent :: Sem r ConsentGiven checkConsent teamsOfUsers other = do consentGiven <$> getLHStatus (Map.lookup other teamsOfUsers) other + +-- | Look up a user as a 'TeamPrincipal': a full member (@Right@) takes +-- precedence over a collaborator (@Left@). Returns 'Nothing' if the user has +-- no association with the team. +lookupTeamPrincipal :: + ( Member TeamSubsystem r, + Member TeamCollaboratorsSubsystem r + ) => + TeamId -> + UserId -> + Sem r (Maybe TeamPrincipal) +lookupTeamPrincipal tid uid = + internalGetTeamMember uid tid >>= \case + Just m -> pure (Just (Right m)) + Nothing -> fmap Left <$> internalGetTeamCollaborator tid uid From a5f351ad360f810d7955d1bc198071ea32736028 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 8 May 2026 17:26:02 +0200 Subject: [PATCH 3/4] [UNVETTED AI SLOP] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 1. Wire.API.Team.Member: Removed isFullTeamMember (export + definition) — it was a temporary placeholder for the behavior change. 2. ensureAccessRole (Util.hs): Changed guard from maybe True (not . isFullTeamMember) . snd → isNothing . snd. Collaborators (Just (Left _)) now pass the TeamMemberAccessRole check, just like full members. 3. ensureConversationAccess (Util.hs): Now uses lookupTeamPrincipal instead of internalGetTeamMember + fmap Right, so collaborators get Just (Left _) instead of Nothing and pass the access role check. Added Member TeamCollaboratorsSubsystem r constraint. 4. convLocalMemberships (CreateInternal.hs): Now uses lookupTeamPrincipal for all users. The notTeamMember call is replaced with [uid | (uid, Nothing) <- allUsersWithPrincipal], exempting collaborators from the explicit connection check. 5. checkLocals (Action.hs): Now batch-fetches collaborators via internalGetTeamCollaboratorsWithIds and merges them with team members into the userMembershipMap, so collaborators appear as Just (Left _) and pass the access role check. --- libs/wire-api/src/Wire/API/Team/Member.hs | 11 ----------- .../src/Wire/ConversationSubsystem/Action.hs | 11 +++++++++-- .../src/Wire/ConversationSubsystem/CreateInternal.hs | 8 ++++---- .../src/Wire/ConversationSubsystem/Query.hs | 1 + .../src/Wire/ConversationSubsystem/Update.hs | 3 +++ .../src/Wire/ConversationSubsystem/Util.hs | 7 ++++--- 6 files changed, 21 insertions(+), 20 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index f00baa553a..a3ebf4bfd9 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -74,7 +74,6 @@ module Wire.API.Team.Member -- * TeamPrincipal TeamPrincipal, - isFullTeamMember, ) where @@ -667,16 +666,6 @@ collaboratorToTeamPermissions = -- @Left@ case. type TeamPrincipal = Either TeamCollaborator TeamMember --- | True only for full team members, not for collaborators. --- Used in conversation access-role checks that enforce team-member-only --- conversations, preserving the invariant that collaborators are not --- considered equivalent to full members for access control. --- --- (We probably do not want to discriminate against collaborators in --- this way, but that's a semantic change for another PR.) -isFullTeamMember :: TeamPrincipal -> Bool -isFullTeamMember = isRight - ---------------------------------------------------------------------- makeLenses ''TeamMember' diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs index cbe8822133..12b6087dda 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs @@ -136,6 +136,7 @@ import Wire.Sem.Now qualified as Now import Wire.Sem.Random (Random) import Wire.StoredConversation import Wire.StoredConversation qualified as Data +import Wire.API.Team.Collaborator (TeamCollaborator (..)) import Wire.TeamCollaboratorsSubsystem import Wire.TeamStore import Wire.TeamSubsystem (ConsentGiven (..), TeamSubsystem, consentGiven) @@ -794,8 +795,14 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do tms <- Map.fromList . map (view Wire.API.Team.Member.userId &&& Imports.id) <$> TeamSubsystem.internalSelectTeamMembers tid newUsers - let userMembershipMap = map (Imports.id &&& (fmap Right . flip Map.lookup tms)) newUsers - in ensureAccessRole (convAccessRoles conv) userMembershipMap + collabs <- + Map.fromList . map (\c -> (c.gUser, c)) + <$> internalGetTeamCollaboratorsWithIds (Set.singleton tid) (Set.fromList newUsers) + let principalFor uid = + fmap Right (Map.lookup uid tms) + <|> fmap Left (Map.lookup uid collabs) + userMembershipMap = map (Imports.id &&& principalFor) newUsers + ensureAccessRole (convAccessRoles conv) userMembershipMap ensureConnectedToLocalsOrSameTeam lusr newUsers checkLocals lusr Nothing newUsers = do ensureAccessRole (convAccessRoles conv) (map (,Nothing) newUsers) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs index 142b1f7e10..574e33010e 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs @@ -55,7 +55,6 @@ import Wire.API.Team import Wire.API.Team.Collaborator qualified as CollaboratorPermission import Wire.API.Team.Feature import Wire.API.Team.Feature qualified as Conf -import Wire.API.Team.FeatureFlags (notTeamMember) import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) import Wire.API.Team.Member import Wire.API.Team.Permission hiding (self) @@ -343,9 +342,10 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do GroupConversation -> checkGroup MeetingConversation -> checkGroup - convLocalMemberships <- mapM (flip TeamSubsystem.internalGetTeamMember convTeam) (ulLocals allUsers) - ensureAccessRole (accessRoles newConv) (zip (ulLocals allUsers) (fmap (fmap Right) convLocalMemberships)) - ensureConnectedToLocals (tUnqualified lusr) (notTeamMember (ulLocals allUsers) (catMaybes convLocalMemberships)) + convLocalMemberships <- mapM (TeamSubsystem.lookupTeamPrincipal convTeam) (ulLocals allUsers) + let allUsersWithPrincipal = zip (ulLocals allUsers) convLocalMemberships + ensureAccessRole (accessRoles newConv) allUsersWithPrincipal + ensureConnectedToLocals (tUnqualified lusr) [uid | (uid, Nothing) <- allUsersWithPrincipal] ensureConnectedToRemotes lusr (ulRemotes allUsers) where ensureCreateChannelPermissions :: diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs index ce8009d45b..ccbfe47301 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs @@ -648,6 +648,7 @@ getConversationByReusableCode :: Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, + Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => Local UserId -> diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs index 96a798aeca..9027eb5d54 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs @@ -741,6 +741,7 @@ joinConversationByReusableCode :: Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, + Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r, Member Now r, Member (Input ConversationSubsystemConfig) r @@ -770,6 +771,7 @@ joinConversationById :: Member NotificationSubsystem r, Member E.ExternalAccess r, Member Now r, + Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => Local UserId -> @@ -794,6 +796,7 @@ joinConversation :: Member ConversationStore r, Member Now r, Member NotificationSubsystem r, + Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => Local UserId -> diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs index 4809d8fefd..7e5a265a3a 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs @@ -120,7 +120,7 @@ ensureAccessRole :: ensureAccessRole roles users = do when (Set.null roles) $ throwS @'ConvAccessDenied unless (NonTeamMemberAccessRole `Set.member` roles) $ - when (any (maybe True (not . isFullTeamMember) . snd) users) $ + when (any (isNothing . snd) users) $ throwS @'NotATeamMember unless (Set.fromList [GuestAccessRole, ServiceAccessRole] `Set.isSubsetOf` roles) $ do activated <- lookupActivatedUsers (fst <$> users) @@ -676,6 +676,7 @@ ensureConversationAccess :: ( Member BrigAPIAccess r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'NotATeamMember) r, + Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => UserId -> @@ -684,8 +685,8 @@ ensureConversationAccess :: Sem r () ensureConversationAccess zusr conv access = do ensureAccess conv access - zusrMembership <- maybe (pure Nothing) (TeamSubsystem.internalGetTeamMember zusr) (Data.convTeam conv) - ensureAccessRole (Data.convAccessRoles conv) [(zusr, fmap Right zusrMembership)] + zusrPrincipal <- maybe (pure Nothing) (\tid -> TeamSubsystem.lookupTeamPrincipal tid zusr) (Data.convTeam conv) + ensureAccessRole (Data.convAccessRoles conv) [(zusr, zusrPrincipal)] ensureAccess :: (Member (ErrorS 'ConvAccessDenied) r) => From c28f62ef0c10ce6ceee7897639eee45e9e47b6df Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 8 May 2026 18:09:47 +0200 Subject: [PATCH 4/4] [UNVETTED AI SLOP] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Summary of the full implementation: wire-subsystems builds clean. galley builds clean. brig compiles clean (only fails at link due to a pre-existing missing native lib). Here's what was changed across the implementation: 1. Wire.API.Team.Collaborator — Added CollaboratorStatus, TeamCollaboratorView, collaboratorToView 2. Wire.API.Routes.Public.Brig — Changed get-team-collaborators response type to [TeamCollaboratorView] 3. Wire.TeamSubsystem — Added pseudoSuspendedCollaborators, isPseudoSuspended; updated lookupTeamPrincipal to return Nothing for pseudo-suspended collaborators 4. Wire.ConversationSubsystem.Action — Updated checkLocals to filter pseudo-suspended collaborators before building userMembershipMap; added FeaturesConfigSubsystem to HasConversationActionEffects 'ConversationJoinTag, updateLocalConversationJoin, and updateLocalConversationUncheckedJoin 5. Wire.ConversationSubsystem.MLS.Commit.Core — Added FeaturesConfigSubsystem to HasProposalActionEffects 6. Wire.ConversationSubsystem.MLS.Proposal — Added FeaturesConfigSubsystem to HasProposalEffects 7. Wire.ConversationSubsystem.Federation — Added FeaturesConfigSubsystem to sendMLSMessage 8. Wire.ConversationSubsystem.Update — Added FeaturesConfigSubsystem to addMembers, addQualifiedMembersUnqualified, replaceMembers 9. Brig.Team.API — Added enrichCollaboratorsWithStatus using GalleyAPIAccess.getFeatureConfigForTeam @_ @AppsConfig --- .../src/Wire/API/Routes/Public/Brig.hs | 2 +- .../src/Wire/API/Team/Collaborator.hs | 37 ++++++++++++++ .../src/Wire/ConversationSubsystem/Action.hs | 9 +++- .../Wire/ConversationSubsystem/Federation.hs | 3 +- .../ConversationSubsystem/MLS/Commit/Core.hs | 4 +- .../ConversationSubsystem/MLS/Proposal.hs | 4 +- .../src/Wire/ConversationSubsystem/Query.hs | 2 +- .../src/Wire/ConversationSubsystem/Update.hs | 6 +++ .../src/Wire/ConversationSubsystem/Util.hs | 2 + .../wire-subsystems/src/Wire/TeamSubsystem.hs | 49 +++++++++++++++++-- services/brig/src/Brig/Team/API.hs | 36 +++++++++++++- 11 files changed, 142 insertions(+), 12 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 2dbe0c784d..270e5cf991 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -2082,7 +2082,7 @@ type TeamsAPI = :> "teams" :> Capture "tid" TeamId :> "collaborators" - :> MultiVerb1 'GET '[JSON] (Respond 200 "Return collaborators" [TeamCollaborator]) + :> MultiVerb1 'GET '[JSON] (Respond 200 "Return collaborators" [TeamCollaboratorView]) ) type SystemSettingsAPI = diff --git a/libs/wire-api/src/Wire/API/Team/Collaborator.hs b/libs/wire-api/src/Wire/API/Team/Collaborator.hs index d256ce9247..7da61b03bf 100644 --- a/libs/wire-api/src/Wire/API/Team/Collaborator.hs +++ b/libs/wire-api/src/Wire/API/Team/Collaborator.hs @@ -74,3 +74,40 @@ instance ToSchema TeamCollaborator where <$> (gUser .= field "user" schema) <*> (gTeam .= field "team" schema) <*> (gPermissions .= field "permissions" (set schema)) + +data CollaboratorStatus = CollaboratorActive | CollaboratorPseudoSuspended + deriving (Eq, Ord, Show, Generic) + deriving (Arbitrary) via GenericUniform CollaboratorStatus + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema CollaboratorStatus) + +instance ToSchema CollaboratorStatus where + schema = + enum @Text $ + mconcat + [ element "active" CollaboratorActive, + element "pseudo_suspended" CollaboratorPseudoSuspended + ] + +-- | API response type for collaborators, enriched with a computed status field. +-- The status is not stored; it is derived server-side from the user type and +-- the team's feature configuration. +data TeamCollaboratorView = TeamCollaboratorView + { tcvUser :: UserId, + tcvTeam :: TeamId, + tcvPermissions :: Set CollaboratorPermission, + tcvStatus :: CollaboratorStatus + } + deriving (Eq, Show) + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema TeamCollaboratorView) + +instance ToSchema TeamCollaboratorView where + schema = + object $ + TeamCollaboratorView + <$> (.tcvUser) .= field "user" schema + <*> (.tcvTeam) .= field "team" schema + <*> (.tcvPermissions) .= field "permissions" (set schema) + <*> (.tcvStatus) .= field "status" schema + +collaboratorToView :: CollaboratorStatus -> TeamCollaborator -> TeamCollaboratorView +collaboratorToView status c = TeamCollaboratorView c.gUser c.gTeam c.gPermissions status diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs index 12b6087dda..b150c141b9 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs @@ -190,6 +190,7 @@ instance IsConversationAction 'ConversationJoinTag where Member BackendNotificationQueueAccess r, Member TeamCollaboratorsSubsystem r, Member FederationSubsystem r, + Member FeaturesConfigSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r, Member E.BrigAPIAccess r, @@ -798,9 +799,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do collabs <- Map.fromList . map (\c -> (c.gUser, c)) <$> internalGetTeamCollaboratorsWithIds (Set.singleton tid) (Set.fromList newUsers) - let principalFor uid = + pseudoSusp <- TeamSubsystem.pseudoSuspendedCollaborators tid (Map.keys collabs) + let activeCollabs = Map.filterWithKey (\uid _ -> uid `Set.notMember` pseudoSusp) collabs + principalFor uid = fmap Right (Map.lookup uid tms) - <|> fmap Left (Map.lookup uid collabs) + <|> fmap Left (Map.lookup uid activeCollabs) userMembershipMap = map (Imports.id &&& principalFor) newUsers ensureAccessRole (convAccessRoles conv) userMembershipMap ensureConnectedToLocalsOrSameTeam lusr newUsers @@ -998,6 +1001,7 @@ updateLocalConversationJoin :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, Member FederationSubsystem r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r, @@ -1322,6 +1326,7 @@ updateLocalConversationUncheckedJoin :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, Member FederationSubsystem r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r, diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs index 34a22f5dd4..6f8431c6c8 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs @@ -657,7 +657,8 @@ sendMLSMessage :: Member P.TinyLog r, Member ProposalStore r, Member TeamCollaboratorsSubsystem r, - Member TeamStore r + Member TeamStore r, + Member FeaturesConfigSubsystem r ) => Domain -> MLSMessageSendRequest -> diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs index a51f0adcbc..ddd73809f1 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs @@ -73,6 +73,7 @@ import Wire.NotificationSubsystem import Wire.ProposalStore (ProposalStore) import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) +import Wire.FeaturesConfigSubsystem import Wire.TeamCollaboratorsSubsystem import Wire.TeamStore @@ -101,7 +102,8 @@ type HasProposalActionEffects r = Member TinyLog r, Member NotificationSubsystem r, Member Random r, - Member TeamCollaboratorsSubsystem r + Member TeamCollaboratorsSubsystem r, + Member FeaturesConfigSubsystem r ) getCommitData :: diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs index 712fd32aee..18400ee39b 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs @@ -73,6 +73,7 @@ import Wire.LegalHoldStore (LegalHoldStore) import Wire.NotificationSubsystem import Wire.ProposalStore import Wire.Sem.Now (Now) +import Wire.FeaturesConfigSubsystem import Wire.TeamCollaboratorsSubsystem import Wire.TeamStore import Wire.Util @@ -138,7 +139,8 @@ type HasProposalEffects r = Member ProposalStore r, Member TeamStore r, Member TinyLog r, - Member TeamCollaboratorsSubsystem r + Member TeamCollaboratorsSubsystem r, + Member FeaturesConfigSubsystem r ) derefOrCheckProposal :: diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs index ccbfe47301..318571b58c 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs @@ -645,9 +645,9 @@ getConversationByReusableCode :: Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'GuestLinksDisabled) r, Member (ErrorS 'NotATeamMember) r, - Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs index 9027eb5d54..85a9b38c89 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs @@ -741,6 +741,7 @@ joinConversationByReusableCode :: Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r, Member Now r, @@ -770,6 +771,7 @@ joinConversationById :: Member BackendNotificationQueueAccess r, Member NotificationSubsystem r, Member E.ExternalAccess r, + Member FeaturesConfigSubsystem r, Member Now r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r @@ -794,6 +796,7 @@ joinConversation :: Member BackendNotificationQueueAccess r, Member E.ExternalAccess r, Member ConversationStore r, + Member FeaturesConfigSubsystem r, Member Now r, Member NotificationSubsystem r, Member TeamCollaboratorsSubsystem r, @@ -860,6 +863,7 @@ addMembers :: Member TeamStore r, Member TinyLog r, Member TeamCollaboratorsSubsystem r, + Member FeaturesConfigSubsystem r, Member FederationSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r @@ -911,6 +915,7 @@ addQualifiedMembersUnqualified :: Member TeamStore r, Member TinyLog r, Member TeamCollaboratorsSubsystem r, + Member FeaturesConfigSubsystem r, Member FederationSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r @@ -958,6 +963,7 @@ replaceMembers :: Member TeamCollaboratorsSubsystem r, Member UserGroupStore r, Member FederationSubsystem r, + Member FeaturesConfigSubsystem r, Member TeamSubsystem r, Member (Input ConversationSubsystemConfig) r ) => diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs index 7e5a265a3a..eab940d1e4 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs @@ -92,6 +92,7 @@ import Wire.RateLimit import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now import Wire.StoredConversation as Data +import Wire.FeaturesConfigSubsystem import Wire.TeamCollaboratorsSubsystem import Wire.TeamStore import Wire.TeamSubsystem (ConsentGiven (..), TeamSubsystem, consentGiven, getLHStatus) @@ -676,6 +677,7 @@ ensureConversationAccess :: ( Member BrigAPIAccess r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'NotATeamMember) r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => diff --git a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs index 98e70ee0e2..ba464d952e 100644 --- a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs @@ -22,17 +22,23 @@ module Wire.TeamSubsystem where import Data.Id import Data.LegalHold import Data.Map qualified as Map +import Data.Proxy (Proxy (..)) import Data.Qualified import Data.Range +import Data.Set qualified as Set import Data.Singletons (Demote, Sing, SingKind, fromSing) import Imports import Polysemy import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Team.Feature (AppsConfig) import Wire.API.Team.LegalHold (UserLegalHoldStatusResponse) import Wire.API.Team.Member import Wire.API.Team.Member.Error import Wire.API.Team.Member.Info (TeamMemberInfoList) +import Wire.API.User (User (..), UserType (..)) +import Wire.BrigAPIAccess +import Wire.FeaturesConfigSubsystem import Wire.TeamCollaboratorsSubsystem data PermissionCheckArgs teamAssociation where @@ -146,12 +152,44 @@ checkConsent :: checkConsent teamsOfUsers other = do consentGiven <$> getLHStatus (Map.lookup other teamsOfUsers) other +-- | Returns the set of user IDs from @uids@ that are pseudo-suspended as +-- collaborators in @tid@. A collaborator is pseudo-suspended when they are an +-- app user and the team's @apps@ feature is disabled. The feature is checked +-- once; user types are only fetched when the feature is off. +pseudoSuspendedCollaborators :: + ( Member BrigAPIAccess r, + Member FeaturesConfigSubsystem r + ) => + TeamId -> + [UserId] -> + Sem r (Set UserId) +pseudoSuspendedCollaborators _ [] = pure Set.empty +pseudoSuspendedCollaborators tid uids = do + appsEnabled <- featureEnabledForTeam (Proxy @AppsConfig) tid + if appsEnabled + then pure Set.empty + else do + users <- getUsers uids + pure $ Set.fromList [qUnqualified u.userQualifiedId | u <- users, u.userType == UserTypeApp] + +isPseudoSuspended :: + ( Member BrigAPIAccess r, + Member FeaturesConfigSubsystem r + ) => + TeamId -> + UserId -> + Sem r Bool +isPseudoSuspended tid uid = Set.member uid <$> pseudoSuspendedCollaborators tid [uid] + -- | Look up a user as a 'TeamPrincipal': a full member (@Right@) takes -- precedence over a collaborator (@Left@). Returns 'Nothing' if the user has --- no association with the team. +-- no association with the team, or if they are a pseudo-suspended collaborator +-- (an app user whose team has the @apps@ feature disabled). lookupTeamPrincipal :: ( Member TeamSubsystem r, - Member TeamCollaboratorsSubsystem r + Member TeamCollaboratorsSubsystem r, + Member BrigAPIAccess r, + Member FeaturesConfigSubsystem r ) => TeamId -> UserId -> @@ -159,4 +197,9 @@ lookupTeamPrincipal :: lookupTeamPrincipal tid uid = internalGetTeamMember uid tid >>= \case Just m -> pure (Just (Right m)) - Nothing -> fmap Left <$> internalGetTeamCollaborator tid uid + Nothing -> + internalGetTeamCollaborator tid uid >>= \case + Nothing -> pure Nothing + Just c -> do + pseudo <- isPseudoSuspended tid uid + pure $ if pseudo then Nothing else Just (Left c) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index fdde7fdf4d..b6de187cd3 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -38,6 +38,7 @@ import Control.Monad.Trans.Except import Data.ByteString.Conversion (toByteString) import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Set qualified as Set import Data.Qualified import Data.Range import Data.Text.Encoding (encodeUtf8) @@ -56,12 +57,14 @@ import URI.ByteString (Absolute, URIRef, laxURIParserOptions, parseURI) import Util.Logging (logFunction, logTeam) import Wire.API.Error import Wire.API.Error.Brig -import Wire.API.Routes.Internal.Brig (FoundInvitationCode (FoundInvitationCode)) +import Wire.API.Routes.Internal.Brig (GetBy (..), FoundInvitationCode (FoundInvitationCode), getByNoFilters) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Named import Wire.API.Routes.Public.Brig (TeamsAPI) import Wire.API.Team import Wire.API.Team.Collaborator +import Wire.API.Team.Feature (AppsConfig, FeatureStatus (..), LockableFeature (..)) +import Wire.API.User (UserType (..)) import Wire.API.Team.Invitation import Wire.API.Team.Invitation qualified as Public import Wire.API.Team.Member (teamMembers) @@ -115,7 +118,36 @@ servantAPI = :<|> Named @"get-team-size" (\uid tid -> lift . liftSem $ teamSizePublic uid tid) :<|> Named @"accept-team-invitation" (\luid req -> lift $ liftSem $ acceptTeamInvitation luid req.password req.code) :<|> Named @"add-team-collaborator" (\zuid tid (NewTeamCollaborator uid perms) -> lift . liftSem $ createTeamCollaborator zuid uid tid perms) - :<|> Named @"get-team-collaborators" (\zuid tid -> lift . liftSem $ getAllTeamCollaborators zuid tid) + :<|> Named @"get-team-collaborators" (\zuidLocal tid -> lift . liftSem $ do + collabs <- getAllTeamCollaborators zuidLocal tid + enrichCollaboratorsWithStatus tid collabs) + +-- | Compute a 'CollaboratorStatus' for each collaborator. App-type collaborators +-- in a team whose @apps@ feature is disabled are returned as 'CollaboratorPseudoSuspended'. +enrichCollaboratorsWithStatus :: + ( Member GalleyAPIAccess r, + Member UserSubsystem r, + Member (Input (Local ())) r + ) => + TeamId -> + [TeamCollaborator] -> + Sem r [TeamCollaboratorView] +enrichCollaboratorsWithStatus _ [] = pure [] +enrichCollaboratorsWithStatus tid collabs = do + appsFeature <- GalleyAPIAccess.getFeatureConfigForTeam @_ @AppsConfig tid + if appsFeature.status == FeatureStatusEnabled + then pure (map (collaboratorToView CollaboratorActive) collabs) + else do + localUnit <- input @(Local ()) + let uids = map (.gUser) collabs + users <- getAccountsBy (qualifyAs localUnit (getByNoFilters {getByUserId = uids})) + let appUserIds = Set.fromList [qUnqualified u.userQualifiedId | u <- users, u.userType == UserTypeApp] + pure + [ collaboratorToView + (if c.gUser `Set.member` appUserIds then CollaboratorPseudoSuspended else CollaboratorActive) + c + | c <- collabs + ] teamSizePublic :: ( Member (Error UserSubsystemError) r,