From a9b5d0394b84536492e8f07c5d21ad0be7671318 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 9 May 2022 17:44:52 +0200 Subject: [PATCH] SQSERVICES-1012-backend-servantify-galley-team-member-api (#2309) --- changelog.d/5-internal/pr-2309 | 1 + libs/galley-types/src/Galley/Types/Teams.hs | 5 +- libs/wire-api/src/Wire/API/Error/Galley.hs | 8 + .../src/Wire/API/Routes/Public/Galley.hs | 153 +++++++++++ libs/wire-api/src/Wire/API/Swagger.hs | 7 - libs/wire-api/src/Wire/API/Team.hs | 27 +- libs/wire-api/src/Wire/API/Team/Member.hs | 117 +++------ services/galley/src/Galley/API/Error.hs | 12 - services/galley/src/Galley/API/Public.hs | 112 --------- .../galley/src/Galley/API/Public/Servant.hs | 11 + services/galley/src/Galley/API/Teams.hs | 237 +++++++----------- services/galley/test/integration/API/Teams.hs | 2 +- 12 files changed, 308 insertions(+), 384 deletions(-) create mode 100644 changelog.d/5-internal/pr-2309 diff --git a/changelog.d/5-internal/pr-2309 b/changelog.d/5-internal/pr-2309 new file mode 100644 index 00000000000..b6240a449d7 --- /dev/null +++ b/changelog.d/5-internal/pr-2309 @@ -0,0 +1 @@ +Team Member API has been migrated to Servant diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 9bfc10aa824..3e3a0e4bf17 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -76,6 +76,7 @@ module Galley.Types.Teams nInvitation, legalHoldStatus, TeamMemberList, + TeamMemberListOptPerms, ListType (..), newTeamMemberList, teamMembers, @@ -467,8 +468,8 @@ isTeamMember u = isJust . findTeamMember u findTeamMember :: Foldable m => UserId -> m TeamMember -> Maybe TeamMember findTeamMember u = find ((u ==) . view userId) -isTeamOwner :: TeamMember -> Bool -isTeamOwner tm = fullPermissions == (tm ^. permissions) +isTeamOwner :: TeamMemberOptPerms -> Bool +isTeamOwner tm = optionalPermissions tm == Just fullPermissions -- | Use this to construct the condition expected by 'teamMemberJson', 'teamMemberListJson' canSeePermsOf :: TeamMember -> TeamMember -> Bool diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 39425db6036..c7b1949ed11 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -44,6 +44,7 @@ import Wire.API.Conversation.Role import Wire.API.Error import qualified Wire.API.Error.Brig as BrigError import Wire.API.Routes.API +import Wire.API.Team.Member import Wire.API.Team.Permission import Wire.API.Util.Aeson (CustomEncoded (..)) @@ -106,6 +107,8 @@ data GalleyError | TooManyTeamMembersOnTeamWithLegalhold | NoLegalHoldDeviceAllocated | UserLegalHoldNotPending + | -- Team Member errors + BulkGetMemberLimitExceeded deriving (Show, Eq, Generic) deriving (FromJSON, ToJSON) via (CustomEncoded GalleyError) @@ -247,6 +250,11 @@ type instance MapError 'NoLegalHoldDeviceAllocated = 'StaticError 404 "legalhold type instance MapError 'LegalHoldCouldNotBlockConnections = 'StaticError 500 "legalhold-internal" "legal hold service: could not block connections when resolving policy conflicts." +-------------------------------------------------------------------------------- +-- Team Member errors + +type instance MapError 'BulkGetMemberLimitExceeded = 'StaticError 400 "too-many-uids" ("Can only process " `AppendSymbol` Show_ HardTruncationLimit `AppendSymbol` " user ids per request.") + -------------------------------------------------------------------------------- -- Authentication errors diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index d9e19f5af87..2dcd3df2daf 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -57,8 +57,10 @@ import Wire.API.Team import Wire.API.Team.Conversation import Wire.API.Team.Feature import Wire.API.Team.LegalHold +import Wire.API.Team.Member import Wire.API.Team.Permission (Perm (..)) import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) +import qualified Wire.API.User as User instance AsHeaders '[ConvId] Conversation Conversation where toHeaders c = (I (qUnqualified (cnvQualifiedId c)) :* Nil, c) @@ -167,6 +169,7 @@ type ServantAPI = :<|> MLSAPI :<|> CustomBackendAPI :<|> LegalHoldAPI + :<|> TeamMemberAPI type ConversationAPI = Named @@ -1514,6 +1517,156 @@ data GrantConsentResult instance GSOP.Generic GrantConsentResult +type TeamMemberAPI = + Named + "get-team-members" + ( Summary "Get team members" + :> CanThrow 'NotATeamMember + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> QueryParam' + [ Optional, + Strict, + Description "Maximum results to be returned" + ] + "maxResults" + (Range 1 HardTruncationLimit Int32) + :> Get '[JSON] TeamMemberListOptPerms + ) + :<|> Named + "get-team-member" + ( Summary "Get single team member" + :> CanThrow 'NotATeamMember + :> CanThrow 'TeamMemberNotFound + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> Get '[JSON] TeamMemberOptPerms + ) + :<|> Named + "get-team-members-by-ids" + ( Summary "Get team members by user id list" + :> Description "The `has_more` field in the response body is always `false`." + :> CanThrow 'NotATeamMember + :> CanThrow 'BulkGetMemberLimitExceeded + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "get-members-by-ids-using-post" + :> QueryParam' + [ Optional, + Strict, + Description "Maximum results to be returned" + ] + "maxResults" + (Range 1 HardTruncationLimit Int32) + :> ReqBody '[JSON] User.UserIdList + :> Post '[JSON] TeamMemberListOptPerms + ) + :<|> Named + "add-team-member" + ( Summary "Add a new team member" + :> CanThrow 'InvalidPermissions + :> CanThrow 'NoAddToBinding + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> CanThrow 'TooManyTeamMembers + :> CanThrow 'UserBindingExists + :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> ReqBody '[JSON] NewTeamMember + :> MultiVerb1 + 'POST + '[JSON] + (RespondEmpty 200 "") + ) + :<|> Named + "delete-team-member" + ( Summary "Remove an existing team member" + :> CanThrow AuthenticationError + :> CanThrow 'AccessDenied + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TeamNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> ReqBody '[JSON] TeamMemberDeleteData + :> MultiVerb + 'DELETE + '[JSON] + TeamMemberDeleteResultResponseType + TeamMemberDeleteResult + ) + :<|> Named + "delete-non-binding-team-member" + ( Summary "Remove an existing team member" + :> CanThrow AuthenticationError + :> CanThrow 'AccessDenied + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TeamNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> MultiVerb + 'DELETE + '[JSON] + TeamMemberDeleteResultResponseType + TeamMemberDeleteResult + ) + :<|> Named + "update-team-member" + ( Summary "Update an existing team member" + :> CanThrow 'AccessDenied + :> CanThrow 'InvalidPermissions + :> CanThrow 'TeamNotFound + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> ReqBody '[JSON] NewTeamMember + :> MultiVerb1 + 'PUT + '[JSON] + (RespondEmpty 200 "") + ) + +type TeamMemberDeleteResultResponseType = + '[ RespondEmpty 202 "Team member scheduled for deletion", + RespondEmpty 200 "" + ] + +data TeamMemberDeleteResult + = TeamMemberDeleteAccepted + | TeamMemberDeleteCompleted + deriving (Generic) + deriving (AsUnion TeamMemberDeleteResultResponseType) via GenericAsUnion TeamMemberDeleteResultResponseType TeamMemberDeleteResult + +instance GSOP.Generic TeamMemberDeleteResult + -- This is a work-around for the fact that we sometimes want to send larger lists of user ids -- in the filter query than fits the url length limit. For details, see -- https://github.com/zinfra/backend-issues/issues/1248 diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 8224a738670..7014e2e8936 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -35,7 +35,6 @@ import qualified Wire.API.Team as Team import qualified Wire.API.Team.Conversation as Team.Conversation import qualified Wire.API.Team.Feature as Team.Feature import qualified Wire.API.Team.Invitation as Team.Invitation -import qualified Wire.API.Team.Member as Team.Member import qualified Wire.API.Team.Permission as Team.Permission import qualified Wire.API.User as User import qualified Wire.API.User.Activation as User.Activation @@ -93,8 +92,6 @@ models = Push.Token.modelPushTokenList, Team.modelTeam, Team.modelTeamList, - Team.modelNewNonBindingTeam, - Team.modelUpdateData, Team.modelTeamDelete, Team.Conversation.modelTeamConversation, Team.Conversation.modelTeamConversationList, @@ -118,10 +115,6 @@ models = Team.Invitation.modelTeamInvitation, Team.Invitation.modelTeamInvitationList, Team.Invitation.modelTeamInvitationRequest, - Team.Member.modelTeamMember, - Team.Member.modelTeamMemberList, - Team.Member.modelNewTeamMember, - Team.Member.modelTeamMemberDelete, Team.Permission.modelPermissions, User.modelUserIdList, User.modelUser, diff --git a/libs/wire-api/src/Wire/API/Team.hs b/libs/wire-api/src/Wire/API/Team.hs index b74566377ab..14756370c48 100644 --- a/libs/wire-api/src/Wire/API/Team.hs +++ b/libs/wire-api/src/Wire/API/Team.hs @@ -66,13 +66,12 @@ module Wire.API.Team -- * Swagger modelTeam, modelTeamList, - modelNewNonBindingTeam, modelUpdateData, modelTeamDelete, ) where -import Control.Lens (makeLenses) +import Control.Lens (makeLenses, (?~)) import Data.Aeson (FromJSON, ToJSON, Value (..)) import Data.Aeson.Types (Parser) import qualified Data.Attoparsec.ByteString as Atto (Parser, string) @@ -90,7 +89,7 @@ import Imports import Test.QuickCheck.Gen (suchThat) import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) import Wire.API.Asset (AssetKey) -import Wire.API.Team.Member (TeamMember, modelTeamMember) +import Wire.API.Team.Member (TeamMember) -------------------------------------------------------------------------------- -- Team @@ -218,20 +217,6 @@ instance ToSchema NonBindingNewTeam where sch :: ValueSchema SwaggerDoc (Range 1 127 [TeamMember]) sch = fromRange .= rangedSchema (array schema) -modelNewNonBindingTeam :: Doc.Model -modelNewNonBindingTeam = Doc.defineModel "newNonBindingTeam" $ do - Doc.description "Required data when creating new regular teams" - Doc.property "name" Doc.string' $ - Doc.description "team name" - Doc.property "icon" Doc.string' $ - Doc.description "team icon (asset ID)" - Doc.property "icon_key" Doc.string' $ do - Doc.description "team icon asset key" - Doc.optional - Doc.property "members" (Doc.unique $ Doc.array (Doc.ref modelTeamMember)) $ do - Doc.description "initial team member ids (between 1 and 127)" - Doc.optional - data NewTeam a = NewTeam { _newTeamName :: Range 1 256 Text, _newTeamIcon :: Icon, @@ -247,10 +232,10 @@ newNewTeam nme ico = NewTeam nme ico Nothing Nothing newTeamObjectSchema :: ValueSchema SwaggerDoc a -> ObjectSchema SwaggerDoc (NewTeam a) newTeamObjectSchema sch = NewTeam - <$> _newTeamName .= field "name" schema - <*> _newTeamIcon .= field "icon" schema - <*> _newTeamIconKey .= maybe_ (optField "icon_key" schema) - <*> _newTeamMembers .= maybe_ (optField "members" sch) + <$> _newTeamName .= fieldWithDocModifier "name" (description ?~ "team name") schema + <*> _newTeamIcon .= fieldWithDocModifier "icon" (description ?~ "team icon (asset ID)") schema + <*> _newTeamIconKey .= maybe_ (optFieldWithDocModifier "icon_key" (description ?~ "team icon asset key") schema) + <*> _newTeamMembers .= maybe_ (optFieldWithDocModifier "members" (description ?~ "initial team member ids (between 1 and 127)") sch) -------------------------------------------------------------------------------- -- TeamUpdateData diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 4208458aed7..96388778716 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -28,13 +28,13 @@ module Wire.API.Team.Member invitation, legalHoldStatus, ntmNewTeamMember, - - -- * TODO: remove after servantification teamMemberJson, - teamMemberListJson, + setOptionalPerms, + setOptionalPermsMany, -- * TeamMemberList TeamMemberList, + TeamMemberListOptPerms, newTeamMemberList, teamMembers, teamMemberListType, @@ -46,38 +46,33 @@ module Wire.API.Team.Member -- * NewTeamMember NewTeamMember, + TeamMemberOptPerms, mkNewTeamMember, nUserId, nPermissions, + optionalPermissions, nInvitation, -- * TeamMemberDeleteData TeamMemberDeleteData, newTeamMemberDeleteData, tmdAuthPassword, - - -- * Swagger - modelTeamMember, - modelTeamMemberList, - modelNewTeamMember, - modelTeamMemberDelete, ) where -import Control.Lens (Lens, Lens', makeLenses, (%~)) +import Control.Lens (Lens, Lens', makeLenses, (%~), (?~)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..)) import Data.Id (UserId) import Data.Json.Util -import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus, typeUserLegalHoldStatus) +import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.Misc (PlainTextPassword (..)) import Data.Proxy import Data.Schema -import qualified Data.Swagger.Build.Api as Doc import qualified Data.Swagger.Schema as S import GHC.TypeLits import Imports import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) -import Wire.API.Team.Permission (Permissions, modelPermissions) +import Wire.API.Team.Permission (Permissions) data PermissionTag = Required | Optional @@ -90,6 +85,8 @@ type family PermissionType (tag :: PermissionTag) = (t :: *) | t -> tag where type TeamMember = TeamMember' 'Required +type TeamMemberOptPerms = TeamMember' 'Optional + data TeamMember' (tag :: PermissionTag) = TeamMember { _newTeamMember :: NewTeamMember' tag, _legalHoldStatus :: UserLegalHoldStatus @@ -140,42 +137,26 @@ instance ToSchema TeamMember where object "TeamMember" $ TeamMember <$> _newTeamMember .= newTeamMemberSchema - <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optField "legalhold_status" schema) + <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema) instance ToSchema (TeamMember' 'Optional) where schema = - object "TeamMember" $ + objectWithDocModifier "TeamMember" (description ?~ "team member data") $ TeamMember <$> _newTeamMember .= ( NewTeamMember - <$> _nUserId .= field "user" schema - <*> _nPermissions .= maybe_ (optField "permissions" schema) + <$> _nUserId .= fieldWithDocModifier "user" (description ?~ "user ID") schema + <*> _nPermissions .= maybe_ (optFieldWithDocModifier "permissions" (description ?~ permissionsDesc) schema) <*> _nInvitation .= invitedSchema' ) - <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optField "legalhold_status" schema) - -modelTeamMember :: Doc.Model -modelTeamMember = Doc.defineModel "TeamMember" $ do - Doc.description "team member data" - Doc.property "user" Doc.bytes' $ - Doc.description "user ID" - Doc.property "permissions" (Doc.ref modelPermissions) $ do - Doc.description - "The permissions this user has in the given team \ - \ (only visible with permission `GetMemberPermissions`)." - Doc.optional -- not optional in the type, but in the json instance. (in - -- servant, we could probably just add a helper type for this.) - -- TODO: even without servant, it would be nicer to introduce - -- a type with optional permissions. - Doc.property "created_at" Doc.dateTime' $ do - Doc.description "Timestamp of invitation creation. Requires created_by." - Doc.optional - Doc.property "created_by" Doc.bytes' $ do - Doc.description "ID of the inviting user. Requires created_at." - Doc.optional - Doc.property "legalhold_status" typeUserLegalHoldStatus $ do - Doc.description "The state of Legal Hold compliance for the member" - Doc.optional + <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema) + where + permissionsDesc = + "The permissions this user has in the given team \ + \ (only visible with permission `GetMemberPermissions`)." + +lhDesc :: Text +lhDesc = "The state of Legal Hold compliance for the member" setPerm :: Bool -> Permissions -> Maybe Permissions setPerm True = Just @@ -186,6 +167,8 @@ setPerm False = const Nothing type TeamMemberList = TeamMemberList' 'Required +type TeamMemberListOptPerms = TeamMemberList' 'Optional + data TeamMemberList' (tag :: PermissionTag) = TeamMemberList { _teamMembers :: [TeamMember' tag], _teamMemberListType :: ListType @@ -221,20 +204,12 @@ deriving via newTeamMemberList :: [TeamMember] -> ListType -> TeamMemberList newTeamMemberList = TeamMemberList -modelTeamMemberList :: Doc.Model -modelTeamMemberList = Doc.defineModel "TeamMemberList" $ do - Doc.description "list of team member" - Doc.property "members" (Doc.unique $ Doc.array (Doc.ref modelTeamMember)) $ - Doc.description "the array of team members" - Doc.property "hasMore" Doc.bool' $ - Doc.description "true if 'members' doesn't contain all team members" - instance ToSchema (TeamMember' tag) => ToSchema (TeamMemberList' tag) where schema = - object "TeamMemberList" $ + objectWithDocModifier "TeamMemberList" (description ?~ "list of team member") $ TeamMemberList - <$> _teamMembers .= field "members" (array schema) - <*> _teamMemberListType .= field "hasMore" schema + <$> _teamMembers .= fieldWithDocModifier "members" (description ?~ "the array of team members") (array schema) + <*> _teamMemberListType .= fieldWithDocModifier "hasMore" (description ?~ "true if 'members' doesn't contain all team members") schema type HardTruncationLimit = (2000 :: Nat) @@ -329,8 +304,8 @@ newTeamMemberSchema = invitedSchema :: ObjectSchemaP SwaggerDoc (Maybe (UserId, UTCTimeMillis)) (Maybe UserId, Maybe UTCTimeMillis) invitedSchema = - (,) <$> fmap fst .= optField "created_by" (maybeWithDefault Null schema) - <*> fmap snd .= optField "created_at" (maybeWithDefault Null schema) + (,) <$> fmap fst .= optFieldWithDocModifier "created_by" (description ?~ "ID of the inviting user. Requires created_at.") (maybeWithDefault Null schema) + <*> fmap snd .= optFieldWithDocModifier "created_at" (description ?~ "Timestamp of invitation creation. Requires created_by.") (maybeWithDefault Null schema) invitedSchema' :: ObjectSchema SwaggerDoc (Maybe (UserId, UTCTimeMillis)) invitedSchema' = withParser invitedSchema $ \(invby, invat) -> @@ -341,14 +316,8 @@ invitedSchema' = withParser invitedSchema $ \(invby, invat) -> instance ToSchema NewTeamMember where schema = - object "NewTeamMember" $ - field "member" $ unnamed (object "Unnamed" newTeamMemberSchema) - -modelNewTeamMember :: Doc.Model -modelNewTeamMember = Doc.defineModel "NewTeamMember" $ do - Doc.description "Required data when creating new team members" - Doc.property "member" (Doc.ref modelTeamMember) $ - Doc.description "the team member to add (the legalhold_status field must be null or missing!)" + objectWithDocModifier "NewTeamMember" (description ?~ "Required data when creating new team members") $ + fieldWithDocModifier "member" (description ?~ "the team member to add (the legalhold_status field must be null or missing!)") $ unnamed (object "Unnamed" newTeamMemberSchema) -------------------------------------------------------------------------------- -- TeamMemberDeleteData @@ -362,19 +331,12 @@ newtype TeamMemberDeleteData = TeamMemberDeleteData instance ToSchema TeamMemberDeleteData where schema = - object "TeamMemberDeleteData" $ - TeamMemberDeleteData <$> _tmdAuthPassword .= optField "password" (maybeWithDefault Null schema) + objectWithDocModifier "TeamMemberDeleteData" (description ?~ "Data for a team member deletion request in case of binding teams.") $ + TeamMemberDeleteData <$> _tmdAuthPassword .= optFieldWithDocModifier "password" (description ?~ "The account password to authorise the deletion.") (maybeWithDefault Null schema) newTeamMemberDeleteData :: Maybe PlainTextPassword -> TeamMemberDeleteData newTeamMemberDeleteData = TeamMemberDeleteData --- FUTUREWORK: fix name of model? -modelTeamMemberDelete :: Doc.Model -modelTeamMemberDelete = Doc.defineModel "teamDeleteData" $ do - Doc.description "Data for a team member deletion request in case of binding teams." - Doc.property "password" Doc.string' $ - Doc.description "The account password to authorise the deletion." - makeLenses ''TeamMember' makeLenses ''TeamMemberList' makeLenses ''NewTeamMember' @@ -383,22 +345,21 @@ makeLenses ''TeamMemberDeleteData userId :: Lens' TeamMember UserId userId = newTeamMember . nUserId +optionalPermissions :: TeamMemberOptPerms -> Maybe Permissions +optionalPermissions = _nPermissions . _newTeamMember + permissions :: Lens (TeamMember' tag1) (TeamMember' tag2) (PermissionType tag1) (PermissionType tag2) permissions = newTeamMember . nPermissions invitation :: Lens' TeamMember (Maybe (UserId, UTCTimeMillis)) invitation = newTeamMember . nInvitation --- JSON serialisation utilities (FUTUREWORK(leif): remove after servantification) - teamMemberJson :: (TeamMember -> Bool) -> TeamMember -> Value teamMemberJson withPerms = toJSON . setOptionalPerms withPerms setOptionalPerms :: (TeamMember -> Bool) -> TeamMember -> TeamMember' 'Optional setOptionalPerms withPerms m = m & permissions %~ setPerm (withPerms m) --- | Show a list of team members using 'teamMemberJson'. -teamMemberListJson :: (TeamMember -> Bool) -> TeamMemberList -> Value -teamMemberListJson withPerms l = - toJSON $ - l {_teamMembers = map (setOptionalPerms withPerms) (_teamMembers l)} +setOptionalPermsMany :: (TeamMember -> Bool) -> TeamMemberList -> TeamMemberList' 'Optional +setOptionalPermsMany withPerms l = + l {_teamMembers = map (setOptionalPerms withPerms) (_teamMembers l)} diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 5e550cad995..6d5714720f1 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -26,15 +26,12 @@ module Galley.API.Error legalHoldServiceUnavailable, -- * Errors thrown by wai-routing handlers - bulkGetMemberLimitExceeded, invalidTeamNotificationId, ) where import Data.Id -import Data.String.Conversions (cs) import Data.Text.Lazy as LT (pack) -import Galley.Types.Teams (hardTruncationLimit) import Imports import Network.HTTP.Types.Status import qualified Network.Wai.Utilities.Error as Wai @@ -58,7 +55,6 @@ data InvalidInput = CustomRolesNotSupported | InvalidRange LText | InvalidUUID4 - | BulkGetMemberLimitExceeded | InvalidPayload LText | InvalidTeamNotificationId @@ -66,7 +62,6 @@ instance APIError InvalidInput where toWai CustomRolesNotSupported = badRequest "Custom roles not supported" toWai (InvalidRange t) = invalidRange t toWai InvalidUUID4 = invalidUUID4 - toWai BulkGetMemberLimitExceeded = bulkGetMemberLimitExceeded toWai (InvalidPayload t) = invalidPayload t toWai InvalidTeamNotificationId = invalidTeamNotificationId @@ -97,13 +92,6 @@ badConvState cid = "Connect conversation with more than 2 members: " <> LT.pack (show cid) -bulkGetMemberLimitExceeded :: Wai.Error -bulkGetMemberLimitExceeded = - Wai.mkError - status400 - "too-many-uids" - ("Can only process " <> cs (show @Int hardTruncationLimit) <> " user ids per request.") - legalHoldServiceUnavailable :: Wai.Error legalHoldServiceUnavailable = Wai.mkError status412 "legalhold-unavailable" "legal hold service does not respond or tls handshake could not be completed (did you pin the wrong public key?)" diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index e2ae24f6dbe..4fe677e653a 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -63,10 +63,6 @@ import qualified Wire.API.Message as Public import qualified Wire.API.Notification as Public import Wire.API.Routes.API import qualified Wire.API.Swagger as Public.Swagger (models) -import qualified Wire.API.Team.Member as Public -import qualified Wire.API.Team.Permission as Public -import qualified Wire.API.User as Public (UserIdList, modelUserIdList) -import Wire.Swagger (int32Between) -- These are all the errors that can be thrown by wai-routing handlers. -- We don't do any static checks on these errors, so we simply remap them to @@ -115,21 +111,6 @@ errorSResponse = errorResponse (toWai (dynError @(MapError e))) sitemap :: Routes ApiBuilder (Sem GalleyEffects) () sitemap = do -- Team Member API ----------------------------------------------------- - get "/teams/:tid/members" (continueE Teams.getTeamMembersH) $ - zauthUserId - .&. capture "tid" - .&. def (unsafeRange Public.hardTruncationLimit) (query "maxResults") - .&. accept "application" "json" - document "GET" "getTeamMembers" $ do - summary "Get team members" - parameter Path "tid" bytes' $ - description "Team ID" - parameter Query "maxResults" (int32Between 1 Public.hardTruncationLimit) $ do - optional - description "Maximum Results to be returned" - returns (ref Public.modelTeamMemberList) - response 200 "Team members" end - errorSResponse @'NotATeamMember get "/teams/:tid/members/csv" (continueE Teams.getTeamMembersCSVH) $ -- we could discriminate based on accept header only, but having two paths makes building @@ -147,43 +128,6 @@ sitemap = do response 200 "Team members CSV file" end errorSResponse @'AccessDenied - post "/teams/:tid/get-members-by-ids-using-post" (continueE Teams.bulkGetTeamMembersH) $ - zauthUserId - .&. capture "tid" - .&. def (unsafeRange Public.hardTruncationLimit) (query "maxResults") - .&. jsonRequest @Public.UserIdList - .&. accept "application" "json" - document "POST" "bulkGetTeamMembers" $ do - summary "Get team members by user id list" - notes "The `has_more` field in the response body is always `false`." - parameter Path "tid" bytes' $ - description "Team ID" - parameter Query "maxResults" (int32Between 1 Public.hardTruncationLimit) $ do - optional - description "Maximum Results to be returned" - body (ref Public.modelUserIdList) $ - description "JSON body" - returns (ref Public.modelTeamMemberList) - response 200 "Team members" end - errorSResponse @'NotATeamMember - errorResponse Error.bulkGetMemberLimitExceeded - - get "/teams/:tid/members/:uid" (continueE Teams.getTeamMemberH) $ - zauthUserId - .&. capture "tid" - .&. capture "uid" - .&. accept "application" "json" - document "GET" "getTeamMember" $ do - summary "Get single team member" - parameter Path "tid" bytes' $ - description "Team ID" - parameter Path "uid" bytes' $ - description "User ID" - returns (ref Public.modelTeamMember) - response 200 "Team member" end - errorSResponse @'NotATeamMember - errorSResponse @'TeamMemberNotFound - get "/teams/notifications" (continueE Teams.getTeamNotificationsH) $ zauthUserId .&. opt (query "since") @@ -224,62 +168,6 @@ sitemap = do errorSResponse @'TeamNotFound errorResponse Error.invalidTeamNotificationId - post "/teams/:tid/members" (continueE Teams.addTeamMemberH) $ - zauthUserId - .&. zauthConnId - .&. capture "tid" - .&. jsonRequest @Public.NewTeamMember - .&. accept "application" "json" - document "POST" "addTeamMember" $ do - summary "Add a new team member" - parameter Path "tid" bytes' $ - description "Team ID" - body (ref Public.modelNewTeamMember) $ - description "JSON body" - errorSResponse @'NotATeamMember - errorSResponse @('MissingPermission ('Just 'Public.AddTeamMember)) - errorSResponse @'NotConnected - errorSResponse @'InvalidPermissions - errorSResponse @'TooManyTeamMembers - errorSResponse @'TooManyTeamMembersOnTeamWithLegalhold - - delete "/teams/:tid/members/:uid" (continueE Teams.deleteTeamMemberH) $ - zauthUserId - .&. zauthConnId - .&. capture "tid" - .&. capture "uid" - .&. optionalJsonRequest @Public.TeamMemberDeleteData - .&. accept "application" "json" - document "DELETE" "deleteTeamMember" $ do - summary "Remove an existing team member" - parameter Path "tid" bytes' $ - description "Team ID" - parameter Path "uid" bytes' $ - description "User ID" - body (ref Public.modelTeamMemberDelete) $ do - optional - description "JSON body, required only for binding teams." - response 202 "Team member scheduled for deletion" end - errorSResponse @'NotATeamMember - errorSResponse @('MissingPermission ('Just 'Public.RemoveTeamMember)) - errorSResponse @'ReAuthFailed - - put "/teams/:tid/members" (continueE Teams.updateTeamMemberH) $ - zauthUserId - .&. zauthConnId - .&. capture "tid" - .&. jsonRequest @Public.NewTeamMember - .&. accept "application" "json" - document "PUT" "updateTeamMember" $ do - summary "Update an existing team member" - parameter Path "tid" bytes' $ - description "Team ID" - body (ref Public.modelNewTeamMember) $ - description "JSON body" - errorSResponse @'NotATeamMember - errorSResponse @'TeamMemberNotFound - errorSResponse @('MissingPermission ('Just 'Public.SetMemberPermissions)) - -- Bot API ------------------------------------------------------------ get "/bot/conversation" (continueE getBotConversationH) $ diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 6824d6d3d1a..c98c887cd88 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -43,6 +43,7 @@ servantSitemap = <@> mls <@> customBackend <@> legalHold + <@> teamMember where conversations = mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation @@ -296,3 +297,13 @@ servantSitemap = <@> mkNamedAPI @"request-legal-hold-device" requestDevice <@> mkNamedAPI @"disable-legal-hold-for-user" disableForUser <@> mkNamedAPI @"approve-legal-hold-device" approveDevice + + teamMember :: API TeamMemberAPI GalleyEffects + teamMember = + mkNamedAPI @"get-team-members" getTeamMembers + <@> mkNamedAPI @"get-team-member" getTeamMember + <@> mkNamedAPI @"get-team-members-by-ids" bulkGetTeamMembers + <@> mkNamedAPI @"add-team-member" addTeamMember + <@> mkNamedAPI @"delete-team-member" deleteTeamMember + <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember + <@> mkNamedAPI @"update-team-member" updateTeamMember diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 464059d7c41..283279c6d38 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -28,15 +28,16 @@ module Galley.API.Teams getManyTeams, deleteTeam, uncheckedDeleteTeam, - addTeamMemberH, + addTeamMember, getTeamNotificationsH, getTeamConversationRoles, - getTeamMembersH, + getTeamMembers, getTeamMembersCSVH, - bulkGetTeamMembersH, - getTeamMemberH, - deleteTeamMemberH, - updateTeamMemberH, + bulkGetTeamMembers, + getTeamMember, + deleteTeamMember, + deleteNonBindingTeamMember, + updateTeamMember, getTeamConversations, getTeamConversation, deleteTeamConversation, @@ -103,11 +104,9 @@ import qualified Galley.Effects.SparAccess as Spar import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import qualified Galley.Effects.TeamMemberStore as E import qualified Galley.Effects.TeamStore as E -import Galley.Effects.WaiRoutes import qualified Galley.Intra.Journal as Journal import Galley.Intra.Push import Galley.Options -import Galley.Types (UserIdList (UserIdList)) import qualified Galley.Types as Conv import Galley.Types.Conversations.Roles as Roles import Galley.Types.Teams hiding (newTeam) @@ -132,15 +131,15 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Federation.Error import qualified Wire.API.Notification as Public +import Wire.API.Routes.Public.Galley import qualified Wire.API.Team as Public import qualified Wire.API.Team.Conversation as Public import Wire.API.Team.Export (TeamExportUser (..)) import qualified Wire.API.Team.Feature as Public -import Wire.API.Team.Member (ntmNewTeamMember, teamMemberJson, teamMemberListJson) +import Wire.API.Team.Member (TeamMemberOptPerms, ntmNewTeamMember, setOptionalPerms, setOptionalPermsMany) import qualified Wire.API.Team.Member as Public import qualified Wire.API.Team.SearchVisibility as Public -import Wire.API.User (User, UserSSOId (UserScimExternalId), userSCIMExternalId, userSSOId) -import qualified Wire.API.User as Public (UserIdList) +import Wire.API.User (User, UserIdList, UserSSOId (UserScimExternalId), userSCIMExternalId, userSSOId) import qualified Wire.API.User as U import Wire.API.User.Identity (UserSSOId (UserSSOId)) import Wire.API.User.RichInfo (RichInfo) @@ -478,25 +477,17 @@ getTeamConversationRoles zusr tid = do -- be merged with the team roles (if they exist) pure $ Public.ConversationRolesList wireConvRoles -getTeamMembersH :: - Members '[ErrorS 'NotATeamMember, TeamStore] r => - UserId ::: TeamId ::: Range 1 Public.HardTruncationLimit Int32 ::: JSON -> - Sem r Response -getTeamMembersH (zusr ::: tid ::: maxResults ::: _) = do - (memberList, withPerms) <- getTeamMembers zusr tid maxResults - pure . json $ teamMemberListJson withPerms memberList - getTeamMembers :: Members '[ErrorS 'NotATeamMember, TeamStore] r => - UserId -> + Local UserId -> TeamId -> - Range 1 Public.HardTruncationLimit Int32 -> - Sem r (Public.TeamMemberList, Public.TeamMember -> Bool) -getTeamMembers zusr tid maxResults = do - m <- E.getTeamMember tid zusr >>= noteS @'NotATeamMember - mems <- E.getTeamMembersWithLimit tid maxResults + Maybe (Range 1 Public.HardTruncationLimit Int32) -> + Sem r TeamMemberListOptPerms +getTeamMembers lzusr tid mbMaxResults = do + m <- E.getTeamMember tid (tUnqualified lzusr) >>= noteS @'NotATeamMember + memberList <- E.getTeamMembersWithLimit tid (fromMaybe (unsafeRange Public.hardTruncationLimit) mbMaxResults) let withPerms = (m `canSeePermsOf`) - pure (mems, withPerms) + pure $ setOptionalPermsMany withPerms memberList outputToStreamingBody :: Member (Final IO) r => Sem (Output LByteString ': r) () -> Sem r StreamingBody outputToStreamingBody action = withWeavingToFinal @IO $ \state weave _inspect -> @@ -610,59 +601,36 @@ getTeamMembersCSVH (zusr ::: tid ::: _) = do (UserSSOId (SAML.UserRef _idp nameId)) -> Just . CI.original . SAML.unsafeShowNameID $ nameId (UserScimExternalId _) -> Nothing -bulkGetTeamMembersH :: - Members - '[ Error InvalidInput, - ErrorS 'NotATeamMember, - TeamStore, - WaiRoutes - ] - r => - UserId ::: TeamId ::: Range 1 Public.HardTruncationLimit Int32 ::: JsonRequest Public.UserIdList ::: JSON -> - Sem r Response -bulkGetTeamMembersH (zusr ::: tid ::: maxResults ::: body ::: _) = do - UserIdList uids <- fromJsonBody body - (memberList, withPerms) <- bulkGetTeamMembers zusr tid maxResults uids - pure . json $ teamMemberListJson withPerms memberList - -- | like 'getTeamMembers', but with an explicit list of users we are to return. bulkGetTeamMembers :: - Members '[Error InvalidInput, ErrorS 'NotATeamMember, TeamStore] r => - UserId -> + Members '[ErrorS 'BulkGetMemberLimitExceeded, ErrorS 'NotATeamMember, TeamStore] r => + Local UserId -> TeamId -> - Range 1 HardTruncationLimit Int32 -> - [UserId] -> - Sem r (TeamMemberList, TeamMember -> Bool) -bulkGetTeamMembers zusr tid maxResults uids = do - unless (length uids <= fromIntegral (fromRange maxResults)) $ - throw BulkGetMemberLimitExceeded - m <- E.getTeamMember tid zusr >>= noteS @'NotATeamMember - mems <- E.selectTeamMembers tid uids + Maybe (Range 1 HardTruncationLimit Int32) -> + UserIdList -> + Sem r TeamMemberListOptPerms +bulkGetTeamMembers lzusr tid mbMaxResults uids = do + unless (length (U.mUsers uids) <= fromIntegral (fromRange (fromMaybe (unsafeRange Public.hardTruncationLimit) mbMaxResults))) $ + throwS @'BulkGetMemberLimitExceeded + m <- E.getTeamMember tid (tUnqualified lzusr) >>= noteS @'NotATeamMember + mems <- E.selectTeamMembers tid (U.mUsers uids) let withPerms = (m `canSeePermsOf`) hasMore = ListComplete - pure (newTeamMemberList mems hasMore, withPerms) - -getTeamMemberH :: - Members '[ErrorS 'TeamMemberNotFound, ErrorS 'NotATeamMember, TeamStore] r => - UserId ::: TeamId ::: UserId ::: JSON -> - Sem r Response -getTeamMemberH (zusr ::: tid ::: uid ::: _) = do - (member, withPerms) <- getTeamMember zusr tid uid - pure . json $ teamMemberJson withPerms member + pure $ setOptionalPermsMany withPerms (newTeamMemberList mems hasMore) getTeamMember :: Members '[ErrorS 'TeamMemberNotFound, ErrorS 'NotATeamMember, TeamStore] r => - UserId -> + Local UserId -> TeamId -> UserId -> - Sem r (Public.TeamMember, Public.TeamMember -> Bool) -getTeamMember zusr tid uid = do + Sem r TeamMemberOptPerms +getTeamMember lzusr tid uid = do m <- - E.getTeamMember tid zusr + E.getTeamMember tid (tUnqualified lzusr) >>= noteS @'NotATeamMember let withPerms = (m `canSeePermsOf`) member <- E.getTeamMember tid uid >>= noteS @'TeamMemberNotFound - pure (member, withPerms) + pure $ setOptionalPerms withPerms member uncheckedGetTeamMember :: Members '[ErrorS 'TeamMemberNotFound, TeamStore] r => @@ -711,12 +679,13 @@ addTeamMember :: P.TinyLog ] r => - UserId -> + Local UserId -> ConnId -> TeamId -> Public.NewTeamMember -> Sem r () -addTeamMember zusr zcon tid nmem = do +addTeamMember lzusr zcon tid nmem = do + let zusr = tUnqualified lzusr let uid = nmem ^. nUserId P.debug $ Log.field "targets" (toByteString uid) @@ -735,38 +704,6 @@ addTeamMember zusr zcon tid nmem = do memList <- getTeamMembersForFanout tid void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem memList -addTeamMemberH :: - Members - '[ BrigAccess, - GundeckAccess, - ErrorS 'InvalidPermissions, - ErrorS 'NoAddToBinding, - ErrorS 'NotATeamMember, - ErrorS 'NotConnected, - ErrorS OperationDenied, - ErrorS 'TeamNotFound, - ErrorS 'TooManyTeamMembers, - ErrorS 'UserBindingExists, - ErrorS 'TooManyTeamMembersOnTeamWithLegalhold, - Input (Local ()), - Input Opts, - Input UTCTime, - LegalHoldStore, - MemberStore, - P.TinyLog, - TeamFeatureStore, - TeamNotificationStore, - TeamStore, - WaiRoutes - ] - r => - UserId ::: ConnId ::: TeamId ::: JsonRequest Public.NewTeamMember ::: JSON -> - Sem r Response -addTeamMemberH (zusr ::: zcon ::: tid ::: req ::: _) = do - nmem <- fromJsonBody req - addTeamMember zusr zcon tid nmem - pure empty - -- This function is "unchecked" because there is no need to check for user binding (invite only). uncheckedAddTeamMember :: Members @@ -796,31 +733,6 @@ uncheckedAddTeamMember tid nmem = do billingUserIds <- Journal.getBillingUserIds tid $ Just $ newTeamMemberList (ntmNewTeamMember nmem : mems ^. teamMembers) (mems ^. teamMemberListType) Journal.teamUpdate tid (sizeBeforeAdd + 1) billingUserIds -updateTeamMemberH :: - Members - '[ BrigAccess, - ErrorS 'AccessDenied, - ErrorS 'InvalidPermissions, - ErrorS 'TeamNotFound, - ErrorS 'NotATeamMember, - ErrorS 'TeamMemberNotFound, - ErrorS OperationDenied, - Input Opts, - Input UTCTime, - GundeckAccess, - P.TinyLog, - TeamStore, - WaiRoutes - ] - r => - UserId ::: ConnId ::: TeamId ::: JsonRequest Public.NewTeamMember ::: JSON -> - Sem r Response -updateTeamMemberH (zusr ::: zcon ::: tid ::: req ::: _) = do - -- the team member to be updated - targetMember <- ntmNewTeamMember <$> fromJsonBody req - updateTeamMember zusr zcon tid targetMember - pure empty - updateTeamMember :: forall r. Members @@ -838,12 +750,14 @@ updateTeamMember :: TeamStore ] r => - UserId -> + Local UserId -> ConnId -> TeamId -> - TeamMember -> + NewTeamMember -> Sem r () -updateTeamMember zusr zcon tid targetMember = do +updateTeamMember lzusr zcon tid newMember = do + let zusr = tUnqualified lzusr + let targetMember = ntmNewTeamMember newMember let targetId = targetMember ^. userId targetPermissions = targetMember ^. permissions P.debug $ @@ -871,7 +785,7 @@ updateTeamMember zusr zcon tid targetMember = do updatedMembers <- getTeamMembersForFanout tid updateJournal team updatedMembers - updatePeers targetId targetPermissions updatedMembers + updatePeers zusr targetId targetMember targetPermissions updatedMembers where canDowngradeOwner = canDeleteMember @@ -887,8 +801,8 @@ updateTeamMember zusr zcon tid targetMember = do billingUserIds <- Journal.getBillingUserIds tid $ Just mems Journal.teamUpdate tid size billingUserIds - updatePeers :: UserId -> Permissions -> TeamMemberList -> Sem r () - updatePeers targetId targetPermissions updatedMembers = do + updatePeers :: UserId -> UserId -> TeamMember -> Permissions -> TeamMemberList -> Sem r () + updatePeers zusr targetId targetMember targetPermissions updatedMembers = do -- inform members of the team about the change -- some (privileged) users will be informed about which change was applied let privileged = filter (`canSeePermsOf` targetMember) (updatedMembers ^. teamMembers) @@ -901,43 +815,63 @@ updateTeamMember zusr zcon tid targetMember = do let pushPriv = newPushLocal (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients for_ pushPriv $ \p -> E.push1 $ p & pushConn .~ Just zcon -deleteTeamMemberH :: +deleteTeamMember :: Members '[ BrigAccess, ConversationStore, Error AuthenticationError, Error InvalidInput, ErrorS 'AccessDenied, - ErrorS 'NotATeamMember, ErrorS 'TeamMemberNotFound, ErrorS 'TeamNotFound, + ErrorS 'NotATeamMember, ErrorS OperationDenied, ExternalAccess, - GundeckAccess, - Input (Local ()), Input Opts, Input UTCTime, + GundeckAccess, MemberStore, - P.TinyLog, TeamStore, - WaiRoutes + P.TinyLog ] r => - UserId ::: ConnId ::: TeamId ::: UserId ::: OptionalJsonRequest Public.TeamMemberDeleteData ::: JSON -> - Sem r Response -deleteTeamMemberH (zusr ::: zcon ::: tid ::: remove ::: req ::: _) = do - lusr <- qualifyLocal zusr - mBody <- fromOptionalJsonBody req - deleteTeamMember lusr zcon tid remove mBody >>= \case - TeamMemberDeleteAccepted -> pure (empty & setStatus status202) - TeamMemberDeleteCompleted -> pure empty + Local UserId -> + ConnId -> + TeamId -> + UserId -> + Public.TeamMemberDeleteData -> + Sem r TeamMemberDeleteResult +deleteTeamMember lusr zcon tid remove body = deleteTeamMember' lusr zcon tid remove (Just body) -data TeamMemberDeleteResult - = TeamMemberDeleteAccepted - | TeamMemberDeleteCompleted +deleteNonBindingTeamMember :: + Members + '[ BrigAccess, + ConversationStore, + Error AuthenticationError, + Error InvalidInput, + ErrorS 'AccessDenied, + ErrorS 'TeamMemberNotFound, + ErrorS 'TeamNotFound, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, + ExternalAccess, + Input Opts, + Input UTCTime, + GundeckAccess, + MemberStore, + TeamStore, + P.TinyLog + ] + r => + Local UserId -> + ConnId -> + TeamId -> + UserId -> + Sem r TeamMemberDeleteResult +deleteNonBindingTeamMember lusr zcon tid remove = deleteTeamMember' lusr zcon tid remove Nothing -- | 'TeamMemberDeleteData' is only required for binding teams -deleteTeamMember :: +deleteTeamMember' :: Members '[ BrigAccess, ConversationStore, @@ -963,7 +897,7 @@ deleteTeamMember :: UserId -> Maybe Public.TeamMemberDeleteData -> Sem r TeamMemberDeleteResult -deleteTeamMember lusr zcon tid remove mBody = do +deleteTeamMember' lusr zcon tid remove mBody = do P.debug $ Log.field "targets" (toByteString remove) . Log.field "action" (Log.val "Teams.deleteTeamMember") @@ -1468,6 +1402,7 @@ userIsTeamOwner :: '[ ErrorS 'TeamMemberNotFound, ErrorS 'AccessDenied, ErrorS 'NotATeamMember, + Input (Local ()), TeamStore ] r => @@ -1475,8 +1410,8 @@ userIsTeamOwner :: UserId -> Sem r () userIsTeamOwner tid uid = do - let asking = uid - (mem, _) <- getTeamMember asking tid uid + asking <- qualifyLocal uid + mem <- getTeamMember asking tid uid unless (isTeamOwner mem) $ throwS @'AccessDenied -- Queues a team for async deletion diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 2d47b6e3264..3803e176280 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -532,7 +532,7 @@ testAddTeamMember = do Util.connectUsers (mem1 ^. userId) (list1 (mem3 ^. userId) []) Util.connectUsers (mem2 ^. userId) (list1 (mem3 ^. userId) []) -- `mem1` lacks permission to add new team members - post (g . paths ["teams", toByteString' tid, "members"] . zUser (mem1 ^. userId) . payload) + post (g . paths ["teams", toByteString' tid, "members"] . zUser (mem1 ^. userId) . zConn "conn" . payload) !!! const 403 === statusCode WS.bracketRN c [owner, (mem1 ^. userId), (mem2 ^. userId), (mem3 ^. userId)] $ \[wsOwner, wsMem1, wsMem2, wsMem3] -> do -- `mem2` has `AddTeamMember` permission