WPB-18191: Add route to collaborator permissions from team

changelog.d/2-features/WPB-18191

@@ -0,0 +1 @@
+Allow member permissions to be updated in a team.

integration/test/API/Brig.hs

@@ -1183,9 +1183,3 @@ refreshAppCookie :: (MakesValue u) => u -> String -> String -> App Response
 refreshAppCookie u tid appId = do
   req <- baseRequest u Brig Versioned $ joinHttpPath ["teams", tid, "apps", appId, "cookies"]
   submit "POST" req
-
-removeTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> App Response
-removeTeamCollaborator owner tid collaborator = do
-  (_, collabId) <- objQid collaborator
-  req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
-  submit "DELETE" req

integration/test/API/Galley.hs

@@ -867,3 +867,17 @@ resetConversation user groupId epoch = do
   req <- baseRequest user Galley Versioned (joinHttpPath ["mls", "reset-conversation"])
   let payload = object ["group_id" .= groupId, "epoch" .= epoch]
   submit "POST" $ req & addJSON payload
+
+updateTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> [String] -> App Response
+updateTeamCollaborator owner tid collaborator permissions = do
+  (_, collabId) <- objQid collaborator
+  req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
+  submit "PUT"
+    $ req
+    & addJSON permissions
+
+removeTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> App Response
+removeTeamCollaborator owner tid collaborator = do
+  (_, collabId) <- objQid collaborator
+  req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
+  submit "DELETE" req

integration/test/Test/TeamCollaborators.hs

@@ -271,3 +271,33 @@ testRemoveCollaboratorInTeamConversation = do
     resp.status `shouldMatchInt` 200
     otherMembers <- asList (resp.json %. "members.others")
     traverse (%. "qualified_id") otherMembers `shouldMatchSet` traverse (%. "qualified_id") [owner, alice]
+
+testUpdateCollaborator :: (HasCallStack) => App ()
+testUpdateCollaborator = do
+  (owner, team, [alice]) <- createTeam OwnDomain 2
+
+  -- At the time of writing, it wasn't clear if this should be a bot instead.
+  bob <- randomUser OwnDomain def
+  addTeamCollaborator
+    owner
+    team
+    bob
+    ["implicit_connection"]
+    >>= assertSuccess
+  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess
+
+  updateTeamCollaborator
+    owner
+    team
+    bob
+    ["create_team_conversation", "implicit_connection"]
+    >>= assertSuccess
+  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess
+
+  updateTeamCollaborator
+    owner
+    team
+    bob
+    []
+    >>= assertSuccess
+  postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "operation-denied"

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

@@ -125,6 +125,7 @@ data EventType
   | ConvDelete
   | CollaboratorAdd
   | AppCreate
+  | CollaboratorUpdate
   | CollaboratorRemove
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform EventType)
@@ -144,6 +145,7 @@ instance ToSchema EventType where
           element "team.conversation-delete" ConvDelete,
           element "team.collaborator-add" CollaboratorAdd,
           element "team.app-create" AppCreate,
+          element "team.collaborator-update" CollaboratorUpdate,
           element "team.collaborator-remove" CollaboratorRemove
         ]
 
@@ -161,6 +163,7 @@ data EventData
   | EdConvDelete ConvId
   | EdCollaboratorAdd UserId [CollaboratorPermission]
   | EdAppCreate UserId
+  | EdCollaboratorUpdate UserId [CollaboratorPermission]
   | EdCollaboratorRemove UserId
   deriving stock (Eq, Show, Generic)
 
@@ -192,6 +195,11 @@ instance ToJSON EventData where
         "permissions" A..= perms
       ]
   toJSON (EdAppCreate usr) = A.object ["user" A..= usr]
+  toJSON (EdCollaboratorUpdate usr perms) =
+    A.object
+      [ "user" A..= usr,
+        "permissions" A..= perms
+      ]
   toJSON (EdCollaboratorRemove usr) = A.object ["user" A..= usr]
 
 eventDataType :: EventData -> EventType
@@ -205,6 +213,7 @@ eventDataType (EdConvCreate _) = ConvCreate
 eventDataType (EdConvDelete _) = ConvDelete
 eventDataType (EdCollaboratorAdd _ _) = CollaboratorAdd
 eventDataType (EdAppCreate _) = AppCreate
+eventDataType (EdCollaboratorUpdate _ _) = CollaboratorUpdate
 eventDataType (EdCollaboratorRemove _) = CollaboratorRemove
 
 parseEventData :: EventType -> Maybe Value -> Parser EventData
@@ -232,15 +241,19 @@ parseEventData TeamCreate Nothing = fail "missing event data for type 'team.crea
 parseEventData TeamCreate (Just j) = EdTeamCreate <$> parseJSON j
 parseEventData TeamUpdate Nothing = fail "missing event data for type 'team.update'"
 parseEventData TeamUpdate (Just j) = EdTeamUpdate <$> parseJSON j
-parseEventData CollaboratorAdd Nothing = fail "missing event data for type 'team.collaborator-add"
+parseEventData CollaboratorAdd Nothing = fail "missing event data for type 'team.collaborator-add'"
 parseEventData CollaboratorAdd (Just j) = do
   let f o = EdCollaboratorAdd <$> o .: "user" <*> o .: "permissions"
   withObject "collaborator add data" f j
 parseEventData AppCreate Nothing = fail "missing event data for type 'team.app-create'"
 parseEventData AppCreate (Just j) = do
   let f o = EdAppCreate <$> o .: "user"
   withObject "app create data" f j
-parseEventData CollaboratorRemove Nothing = fail "missing event data for type 'team.collaborator-remove"
+parseEventData CollaboratorUpdate Nothing = fail "missing event data for type 'team.collaborator-update'"
+parseEventData CollaboratorUpdate (Just j) = do
+  let f o = EdCollaboratorUpdate <$> o .: "user" <*> o .: "permissions"
+  withObject "collaborator update data" f j
+parseEventData CollaboratorRemove Nothing = fail "missing event data for type 'team.collaborator-remove'"
 parseEventData CollaboratorRemove (Just j) = do
   let f o = EdCollaboratorRemove <$> o .: "user"
   withObject "collaborator remove data" f j
@@ -259,6 +272,7 @@ genEventData = \case
   ConvDelete -> EdConvDelete <$> arbitrary
   CollaboratorAdd -> EdCollaboratorAdd <$> arbitrary <*> arbitrary
   AppCreate -> EdAppCreate <$> arbitrary
+  CollaboratorUpdate -> EdCollaboratorUpdate <$> arbitrary <*> arbitrary
   CollaboratorRemove -> EdCollaboratorRemove <$> arbitrary
 
 makeLenses ''Event

libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs

@@ -20,6 +20,7 @@ module Wire.API.Routes.Public.Galley.TeamMember where
 import Data.Id
 import Data.Int
 import Data.Range
+import Data.Set (Set)
 import GHC.Generics
 import Generics.SOP qualified as GSOP
 import Servant
@@ -32,6 +33,7 @@ import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named
 import Wire.API.Routes.Public
 import Wire.API.Routes.Version
+import Wire.API.Team.Collaborator
 import Wire.API.Team.Member
 import Wire.API.User qualified as User
 
@@ -207,6 +209,18 @@ type TeamMemberAPI =
                     "CSV of team members"
                     CSV
            )
+    :<|> Named
+           "update-team-collaborator"
+           ( Summary "Update a collaborator permissions from the team."
+               :> From 'V11
+               :> ZLocalUser
+               :> "teams"
+               :> Capture "tid" TeamId
+               :> "collaborators"
+               :> Capture "uid" UserId
+               :> ReqBody '[JSON] (Set CollaboratorPermission)
+               :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "")
+           )
     :<|> Named
            "remove-team-collaborator"
            ( Summary "Remove a collaborator from the team."

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

@@ -482,6 +482,7 @@ data HiddenPerm
   | JoinRegularConversations
   | CreateApp
   | ManageApps
+  | UpdateTeamCollaborator
   | RemoveTeamCollaborator
   deriving (Eq, Ord, Show)
 
@@ -570,6 +571,7 @@ roleHiddenPermissions role = HiddenPermissions p p
             NewTeamCollaborator,
             CreateApp,
             ManageApps,
+            UpdateTeamCollaborator,
             RemoveTeamCollaborator
           ]
     roleHiddenPerms RoleMember =

libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs

@@ -93,7 +93,7 @@ createAppImpl lusr tid new = do
   Store.createUser u Nothing
 
   -- generate a team event
-  generateTeamEvent creator.id tid (EdAppCreate u.id)
+  generateTeamEvents creator.id tid [EdAppCreate u.id]
 
   c :: Cookie (Token U) <- newCookie u.id Nothing PersistentCookie (Just "app")
   pure

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

@@ -13,6 +13,7 @@ data TeamCollaboratorsStore m a where
   GetTeamCollaborator :: TeamId -> UserId -> TeamCollaboratorsStore m (Maybe TeamCollaborator)
   GetTeamCollaborations :: UserId -> TeamCollaboratorsStore m ([TeamCollaborator])
   GetTeamCollaboratorsWithIds :: Set TeamId -> Set UserId -> TeamCollaboratorsStore m [TeamCollaborator]
+  UpdateTeamCollaborator :: UserId -> TeamId -> Set CollaboratorPermission -> TeamCollaboratorsStore m ()
   RemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsStore m ()
 
 makeSem ''TeamCollaboratorsStore

libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs

@@ -38,6 +38,7 @@ interpretTeamCollaboratorsStoreToPostgres =
     GetTeamCollaborator teamId userId -> getTeamCollaboratorImpl teamId userId
     GetTeamCollaborations userId -> getTeamCollaborationsImpl userId
     GetTeamCollaboratorsWithIds teamIds userIds -> getTeamCollaboratorsWithIdsImpl teamIds userIds
+    UpdateTeamCollaborator userId teamId permissions -> updateTeamCollaboratorImpl userId teamId permissions
     RemoveTeamCollaborator userId teamId -> removeTeamCollaboratorImpl userId teamId
 
 getTeamCollaboratorImpl ::
@@ -125,6 +126,33 @@ getAllTeamCollaboratorsImpl teamId = do
           select user_id :: uuid, team_id :: uuid, permissions :: int2[] from collaborators where team_id = ($1 :: uuid)
           |]
 
+updateTeamCollaboratorImpl ::
+  ( Member (Input Pool) r,
+    Member (Embed IO) r,
+    Member (Error UsageError) r
+  ) =>
+  UserId ->
+  TeamId ->
+  Set CollaboratorPermission ->
+  Sem r ()
+updateTeamCollaboratorImpl userId teamId permissions = do
+  pool <- input
+  eitherErrorOrUnit <- liftIO $ use pool session
+  either throw pure eitherErrorOrUnit
+  where
+    session :: Session ()
+    session = statement (userId, teamId, permissions) updateStatement
+
+    updateStatement :: Statement (UserId, TeamId, Set CollaboratorPermission) ()
+    updateStatement =
+      lmap
+        ( \(uid, tid, pms) ->
+            (toUUID uid, toUUID tid, collaboratorPermissionToPostgreslRep <$> (Data.Vector.fromList . toAscList) pms)
+        )
+        $ [resultlessStatement|
+          update collaborators set permissions = ($3 :: smallint[]) where user_id = ($1 :: uuid) and team_id = ($2 :: uuid)
+          |]
+
 removeTeamCollaboratorImpl ::
   ( Member (Input Pool) r,
     Member (Embed IO) r,

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

@@ -14,6 +14,7 @@ data TeamCollaboratorsSubsystem m a where
   InternalGetTeamCollaborator :: TeamId -> UserId -> TeamCollaboratorsSubsystem m (Maybe TeamCollaborator)
   InternalGetTeamCollaborations :: UserId -> TeamCollaboratorsSubsystem m [TeamCollaborator]
   InternalGetTeamCollaboratorsWithIds :: Set TeamId -> Set UserId -> TeamCollaboratorsSubsystem m [TeamCollaborator]
+  InternalUpdateTeamCollaborator :: UserId -> TeamId -> Set CollaboratorPermission -> TeamCollaboratorsSubsystem m ()
   InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m ()
 
 makeSem ''TeamCollaboratorsSubsystem

libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs

@@ -34,6 +34,7 @@ interpretTeamCollaboratorsSubsystem = interpret $ \case
   InternalGetTeamCollaborator team user -> internalGetTeamCollaboratorImpl team user
   InternalGetTeamCollaborations userId -> internalGetTeamCollaborationsImpl userId
   InternalGetTeamCollaboratorsWithIds teams userIds -> internalGetTeamCollaboratorsWithIdsImpl teams userIds
+  InternalUpdateTeamCollaborator user team perms -> internalUpdateTeamCollaboratorImpl user team perms
   InternalRemoveTeamCollaborator user team -> internalRemoveTeamCollaboratorImpl user team
 
 internalGetTeamCollaboratorImpl ::
@@ -68,7 +69,7 @@ createTeamCollaboratorImpl zUser user team perms = do
   Store.createTeamCollaborator user team perms
 
   -- TODO: Review the event's values
-  generateTeamEvent (tUnqualified zUser) team (EdCollaboratorAdd user (Set.toList perms))
+  generateTeamEvents (tUnqualified zUser) team [EdCollaboratorAdd user (Set.toList perms)]
 
 getAllTeamCollaboratorsImpl ::
   ( Member TeamSubsystem r,
@@ -91,6 +92,16 @@ internalGetTeamCollaboratorsWithIdsImpl ::
 internalGetTeamCollaboratorsWithIdsImpl = do
   Store.getTeamCollaboratorsWithIds
 
+internalUpdateTeamCollaboratorImpl ::
+  ( Member Store.TeamCollaboratorsStore r
+  ) =>
+  UserId ->
+  TeamId ->
+  Set CollaboratorPermission ->
+  Sem r ()
+internalUpdateTeamCollaboratorImpl user team perms = do
+  Store.updateTeamCollaborator user team perms
+
 internalRemoveTeamCollaboratorImpl ::
   ( Member Store.TeamCollaboratorsStore r
   ) =>

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

@@ -13,24 +13,24 @@ import Wire.NotificationSubsystem
 import Wire.Sem.Now
 import Wire.TeamSubsystem
 
--- | Generate a team event and send it to all team admins
-generateTeamEvent ::
+-- | Generate team events and send them to all team admins
+generateTeamEvents ::
   ( Member Now r,
     Member TeamSubsystem r,
     Member NotificationSubsystem r
   ) =>
   UserId ->
   TeamId ->
-  EventData ->
+  [EventData] ->
   Sem r ()
-generateTeamEvent uid tid edata = do
+generateTeamEvents uid tid eventsData = do
   now <- get
-  let event = newEvent tid now edata
   admins <- internalGetTeamAdmins tid
-  pushNotifications
-    [ def
+  pushNotifications $
+    eventsData <&> \eData ->
+      def
         { origin = Just uid,
-          json = toJSONObject $ event,
+          json = toJSONObject $ newEvent tid now eData,
           recipients =
             [ Recipient
                 { recipientUserId = u,
@@ -40,4 +40,3 @@ generateTeamEvent uid tid edata = do
             ],
           transient = False
         }
-    ]

libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs

@@ -27,5 +27,11 @@ inMemoryTeamCollaboratorsStoreInterpreter =
     GetTeamCollaboratorsWithIds teamIds userIds ->
       gets $ \(s :: Map TeamId [TeamCollaborator]) ->
         concatMap (concatMap (filter (\tc -> tc.gUser `elem` userIds)) . (\(tid :: TeamId) -> Map.lookup tid s)) teamIds
+    UpdateTeamCollaborator userId teamId permissions ->
+      let updatePermissions teamCollaborator =
+            if teamCollaborator.gUser == userId
+              then teamCollaborator {gPermissions = permissions}
+              else teamCollaborator
+       in modify $ Map.adjust (fmap updatePermissions) teamId
     RemoveTeamCollaborator userId teamId ->
       modify $ Map.alter (fmap $ filter $ (/= userId) . gUser) teamId

services/galley/src/Galley/API/Public/TeamMember.hs

@@ -33,4 +33,5 @@ teamMemberAPI =
     <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember
     <@> mkNamedAPI @"update-team-member" updateTeamMember
     <@> mkNamedAPI @"get-team-members-csv" Export.getTeamMembersCSV
+    <@> mkNamedAPI @"update-team-collaborator" updateTeamCollaborator
     <@> mkNamedAPI @"remove-team-collaborator" removeTeamCollaborator

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

@@ -52,6 +52,7 @@ module Galley.API.Teams
     ensureNotTooLargeForLegalHold,
     ensureNotTooLargeToActivateLegalHold,
     internalDeleteBindingTeam,
+    updateTeamCollaborator,
     removeTeamCollaborator,
   )
 where
@@ -117,6 +118,8 @@ import Wire.API.Routes.MultiTablePaging (MultiTablePage (..), MultiTablePagingSt
 import Wire.API.Routes.Public.Galley.TeamMember
 import Wire.API.Team
 import Wire.API.Team qualified as Public
+import Wire.API.Team.Collaborator qualified as Collaborator
+import Wire.API.Team.Collaborator qualified as TeamCollaborator
 import Wire.API.Team.Conversation
 import Wire.API.Team.Conversation qualified as Public
 import Wire.API.Team.Feature
@@ -1305,6 +1308,36 @@ checkAdminLimit adminCount =
   when (adminCount > 2000) $
     throwS @'TooManyTeamAdmins
 
+-- | Updating a team collaborator permissions eventually cleaning their conversations
+updateTeamCollaborator ::
+  forall r.
+  ( Member BackendNotificationQueueAccess r,
+    Member ConversationStore r,
+    Member (Error FederationError) r,
+    Member (ErrorS OperationDenied) r,
+    Member (ErrorS NotATeamMember) r,
+    Member ExternalAccess r,
+    Member NotificationSubsystem r,
+    Member Now r,
+    Member P.TinyLog r,
+    Member TeamStore r,
+    Member TeamCollaboratorsSubsystem r
+  ) =>
+  Local UserId ->
+  TeamId ->
+  UserId ->
+  Set TeamCollaborator.CollaboratorPermission ->
+  Sem r ()
+updateTeamCollaborator lusr tid rusr perms = do
+  P.debug $
+    Log.field "targets" (toByteString rusr)
+      . Log.field "action" (Log.val "Teams.updateTeamCollaborator")
+  zusrMember <- E.getTeamMember tid (tUnqualified lusr)
+  void $ permissionCheck UpdateTeamCollaborator zusrMember
+  when (Set.null $ Set.intersection (Set.fromList [Collaborator.CreateTeamConversation, Collaborator.ImplicitConnection]) perms) $
+    removeFromConvsAndPushConvLeaveEvent lusr Nothing tid rusr
+  internalUpdateTeamCollaborator rusr tid perms
+
 -- | Removing a team collaborator and clean their conversations
 removeTeamCollaborator ::
   forall r.