diff --git a/changelog.d/5-internal/WPB-25521-refactor-access-control-rules-for-collaborators b/changelog.d/5-internal/WPB-25521-refactor-access-control-rules-for-collaborators new file mode 100644 index 0000000000..835189d6b4 --- /dev/null +++ b/changelog.d/5-internal/WPB-25521-refactor-access-control-rules-for-collaborators @@ -0,0 +1,3 @@ +Refactor access control rules for collaborators. + +TODO: if the behavior changes in this PR, we need to move this and explain how! (but with some luck, it'll remain a behavior-preserving refactoring job.) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index ac954d93d9..85fb09384b 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -1016,6 +1016,7 @@ data NewOne2OneConv = NewOne2OneConv { users :: [UserId], -- | A list of qualified users, which can include some local qualified users -- too. + -- TODO: why is this a list and not a pair, given the name `NewOne2OneConv`? qualifiedUsers :: [Qualified UserId], name :: Maybe (Range 1 256 Text), team :: Maybe ConvTeamInfo diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs index e28425c906..800fa1fd8a 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs @@ -637,25 +637,38 @@ checkBindingTeamPermissions :: TeamId -> Sem r (Maybe TeamId) checkBindingTeamPermissions lusr lother tid = do + -- TODO(fisx): i think this can be futher refactored to use + -- `getImplicitReachableLocals`. i'm also still not sure this logic + -- is sound, need to think about this more! + + -- TODO(fisx): also check the access control logic around + -- adding/removing conv members to/from group convs. can that also + -- be simplified? + + guardTeamBinding mTeamCollaborator <- internalGetTeamCollaborator tid (tUnqualified lusr) - zusrMembership <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid - case (mTeamCollaborator, zusrMembership) of + mTeamMember <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid + case (mTeamCollaborator, mTeamMember) of (Just collaborator, Nothing) -> guardPerm CollaboratorPermission.ImplicitConnection collaborator (Nothing, mbMember) -> void $ permissionCheck CreateConversation mbMember (Just collaborator, Just member) -> unless (hasPermission collaborator CollaboratorPermission.ImplicitConnection || hasPermission member CreateConversation) $ throwS @OperationDenied - TeamStore.getTeamBinding tid >>= \case - Just Binding -> do - when (isJust zusrMembership) $ - verifyMembership tid (tUnqualified lusr) - mOtherTeamCollaborator <- internalGetTeamCollaborator tid (tUnqualified lother) - unless (isJust mOtherTeamCollaborator) $ - verifyMembership tid (tUnqualified lother) - pure (Just tid) - Just _ -> throwS @'NonBindingTeam - Nothing -> throwS @'TeamNotFound + when (isJust mTeamMember) $ + verifyMembership tid (tUnqualified lusr) + mOtherTeamCollaborator <- internalGetTeamCollaborator tid (tUnqualified lother) + unless (isJust mOtherTeamCollaborator) $ + verifyMembership tid (tUnqualified lother) + pure (Just tid) where + -- it is unclear why we do this here; it can be removed once we + -- remove binding teams from the code. + guardTeamBinding = do + TeamStore.getTeamBinding tid >>= \case + Just Binding -> pure () + Just _ -> throwS @'NonBindingTeam + Nothing -> throwS @'TeamNotFound + guardPerm p m = if m `hasPermission` p then pure () diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs index 78d7019397..d2603a4cad 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs @@ -165,28 +165,39 @@ ensureConnectedToLocalsOrSameTeam :: Sem r () ensureConnectedToLocalsOrSameTeam _ [] = pure () ensureConnectedToLocalsOrSameTeam (tUnqualified -> u) uids = do - uTeams <- getUserTeams u + implicitConnections <- getImplicitReachableLocals u uids + ensureConnectedToLocals u (uids \\ implicitConnections) + +getImplicitReachableLocals :: + ( Member TeamStore r, + Member TeamCollaboratorsSubsystem r, + Member TeamSubsystem r + ) => + UserId -> + [UserId] -> + Sem r [UserId] +getImplicitReachableLocals reacher reachees = do + uTeams <- getUserTeams reacher icTeams <- getUserCollaborationTeams icUsers <- getTeamCollaborators uTeams - -- We collect all the relevant uids from same teams as the origin user + -- We collect all the relevant reachees from same teams as the origin user sameTeamUids <- forM (uTeams `union` icTeams) $ \team -> - fmap (view Mem.userId) <$> TeamSubsystem.internalSelectTeamMembers team uids - -- Do not check connections for users that are on the same team - ensureConnectedToLocals u ((uids \\ join sameTeamUids) \\ icUsers) + fmap (view Mem.userId) <$> TeamSubsystem.internalSelectTeamMembers team reachees + pure (join sameTeamUids `union` icUsers) where -- Teams in which the user who wants to reach out is member with -- `ImplicitConnection` permission. getUserCollaborationTeams :: (Member TeamCollaboratorsSubsystem r') => Sem r' [TeamId] getUserCollaborationTeams = gTeam - <$$> (filter (flip hasPermission CollaboratorPermission.ImplicitConnection) <$> internalGetTeamCollaborations u) + <$$> (filter (flip hasPermission CollaboratorPermission.ImplicitConnection) <$> internalGetTeamCollaborations reacher) -- We do not check the permissions of team collaborators if a user tries to -- reach out to them (if they are in the same team.) The reasoning behind -- this is that team collaborators have implicitly agreed to be -- collaborated with. getTeamCollaborators :: (Member TeamCollaboratorsSubsystem r') => [TeamId] -> Sem r' [UserId] - getTeamCollaborators teams = gUser <$$> internalGetTeamCollaboratorsWithIds (Set.fromList teams) (Set.fromList uids) + getTeamCollaborators teams = gUser <$$> internalGetTeamCollaboratorsWithIds (Set.fromList teams) (Set.fromList reachees) -- | Check that the user is connected to everybody else. --