WPB-18191: Add route to collaborator permissions from team

Author: blackheaven

changelog.d/2-features/WPB-18191

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

integration/test/API/Brig.hs

@@ -1206,9 +1206,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,