[WPB-25521] Refactor: make team conversation access control more collaborator-friendly.

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.

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 =

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

libs/wire-api/src/Wire/API/Team/Member.hs

@@ -71,6 +71,9 @@ module Wire.API.Team.Member
     IsPerm (..),
     HiddenPerm (..),
     mkSingleTeamMembersPage,
+
+    -- * TeamPrincipal
+    TeamPrincipal,
   )
 where
 
@@ -657,6 +660,12 @@ 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
+
 ----------------------------------------------------------------------
 
 makeLenses ''TeamMember'

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)
@@ -189,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,
@@ -794,7 +796,15 @@ 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
+      collabs <-
+        Map.fromList . map (\c -> (c.gUser, c))
+          <$> internalGetTeamCollaboratorsWithIds (Set.singleton tid) (Set.fromList newUsers)
+      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 activeCollabs)
+          userMembershipMap = map (Imports.id &&& principalFor) newUsers
       ensureAccessRole (convAccessRoles conv) userMembershipMap
       ensureConnectedToLocalsOrSameTeam lusr newUsers
     checkLocals lusr Nothing newUsers = do
@@ -991,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,
@@ -1315,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,

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)
@@ -330,11 +329,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
@@ -346,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) 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 ::

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 ->

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 ::

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 ::

libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs

@@ -645,9 +645,10 @@ 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
   ) =>
   Local UserId ->

libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs

@@ -741,6 +741,8 @@ joinConversationByReusableCode ::
     Member FeaturesConfigSubsystem r,
     Member HashPassword r,
     Member RateLimit r,
+    Member FeaturesConfigSubsystem r,
+    Member TeamCollaboratorsSubsystem r,
     Member TeamSubsystem r,
     Member Now r,
     Member (Input ConversationSubsystemConfig) r
@@ -769,7 +771,9 @@ joinConversationById ::
     Member BackendNotificationQueueAccess r,
     Member NotificationSubsystem r,
     Member E.ExternalAccess r,
+    Member FeaturesConfigSubsystem r,
     Member Now r,
+    Member TeamCollaboratorsSubsystem r,
     Member TeamSubsystem r
   ) =>
   Local UserId ->
@@ -792,8 +796,10 @@ joinConversation ::
     Member BackendNotificationQueueAccess r,
     Member E.ExternalAccess r,
     Member ConversationStore r,
+    Member FeaturesConfigSubsystem r,
     Member Now r,
     Member NotificationSubsystem r,
+    Member TeamCollaboratorsSubsystem r,
     Member TeamSubsystem r
   ) =>
   Local UserId ->
@@ -857,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
@@ -908,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
@@ -955,6 +963,7 @@ replaceMembers ::
     Member TeamCollaboratorsSubsystem r,
     Member UserGroupStore r,
     Member FederationSubsystem r,
+    Member FeaturesConfigSubsystem r,
     Member TeamSubsystem r,
     Member (Input ConversationSubsystemConfig) r
   ) =>

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)
@@ -115,7 +116,7 @@ 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
@@ -676,6 +677,8 @@ ensureConversationAccess ::
   ( Member BrigAPIAccess r,
     Member (ErrorS 'ConvAccessDenied) r,
     Member (ErrorS 'NotATeamMember) r,
+    Member FeaturesConfigSubsystem r,
+    Member TeamCollaboratorsSubsystem r,
     Member TeamSubsystem r
   ) =>
   UserId ->
@@ -684,8 +687,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, zusrMembership)]
+  zusrPrincipal <- maybe (pure Nothing) (\tid -> TeamSubsystem.lookupTeamPrincipal tid zusr) (Data.convTeam conv)
+  ensureAccessRole (Data.convAccessRoles conv) [(zusr, zusrPrincipal)]
 
 ensureAccess ::
   (Member (ErrorS 'ConvAccessDenied) r) =>

libs/wire-subsystems/src/Wire/TeamSubsystem.hs

@@ -22,17 +22,24 @@ 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
   PermissionCheckArgs ::
@@ -144,3 +151,55 @@ checkConsent ::
   Sem r ConsentGiven
 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, 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 BrigAPIAccess r,
+    Member FeaturesConfigSubsystem r
+  ) =>
+  TeamId ->
+  UserId ->
+  Sem r (Maybe TeamPrincipal)
+lookupTeamPrincipal tid uid =
+  internalGetTeamMember uid tid >>= \case
+    Just m -> pure (Just (Right m))
+    Nothing ->
+      internalGetTeamCollaborator tid uid >>= \case
+        Nothing -> pure Nothing
+        Just c -> do
+          pseudo <- isPseudoSuspended tid uid
+          pure $ if pseudo then Nothing else Just (Left c)