WPB-18191: Add route to collaborator permissions from team

changelog.d/2-features/WPB-18190

@@ -0,0 +1 @@
+Allow collaborator to be removed from a team.

changelog.d/2-features/WPB-18191

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

integration/test/API/Brig.hs

@@ -1133,3 +1133,17 @@ getAllTeamCollaborators :: (MakesValue owner) => owner -> String -> App Response
 getAllTeamCollaborators owner tid = do
   req <- baseRequest owner Brig Versioned $ joinHttpPath ["teams", tid, "collaborators"]
   submit "GET" req
+
+updateTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> [String] -> App Response
+updateTeamCollaborator owner tid collaborator permissions = do
+  (_, collabId) <- objQid collaborator
+  req <- baseRequest owner Brig 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 Brig Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
+  submit "DELETE" req

integration/test/Test/TeamCollaborators.hs

@@ -156,4 +156,86 @@ testImplicitConnectionNoCollaborator = do
   -- Alice and Bob aren't connected at all.
   postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"
 
-  postOne2OneConversation alice bob team0 "chat-chit" >>= assertLabel 403 "non-binding-team-members"
+testRemoveMemberInO2O :: (HasCallStack) => App ()
+testRemoveMemberInO2O = do
+  (owner0, team0, [alice]) <- createTeam OwnDomain 2
+  (owner1, team1, [bob]) <- createTeam OwnDomain 2
+
+  -- At the time of writing, it wasn't clear if this should be a bot instead.
+  charlie <- randomUser OwnDomain def
+  addTeamCollaborator owner0 team0 charlie ["implicit_connection"] >>= assertSuccess
+  addTeamCollaborator owner1 team1 charlie ["implicit_connection"] >>= assertSuccess
+
+  postOne2OneConversation charlie alice team0 "chit-chat" >>= assertSuccess
+  postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess
+
+  removeTeamCollaborator owner0 team0 charlie >>= assertSuccess
+
+  getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected"
+  postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"
+  getMLSOne2OneConversation charlie bob >>= assertSuccess
+
+testRemoveMemberInO2OConnected :: (HasCallStack) => App ()
+testRemoveMemberInO2OConnected = do
+  (owner0, team0, [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 owner0 team0 bob ["implicit_connection"] >>= assertSuccess
+
+  postOne2OneConversation bob alice team0 "chit-chat" >>= assertSuccess
+  connectTwoUsers alice bob
+
+  removeTeamCollaborator owner0 team0 bob >>= assertSuccess
+
+  getMLSOne2OneConversation bob alice >>= assertSuccess
+
+testRemoveMemberInTeamConversation :: (HasCallStack) => App ()
+testRemoveMemberInTeamConversation = do
+  (owner, team, [alice, bob]) <- createTeam OwnDomain 3
+
+  aliceId <- alice %. "qualified_id"
+  bobId <- bob %. "qualified_id"
+  conv <-
+    postConversation
+      owner
+      defProteus {team = Just team, skipCreator = Just True, qualifiedUsers = [aliceId, bobId]}
+      >>= getJSON 201
+
+  removeTeamCollaborator owner team bob >>= assertSuccess
+
+  getConversation alice conv `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  getConversation bob conv `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 403
+
+testUpdateMember :: (HasCallStack) => App ()
+testUpdateMember = 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

@@ -124,6 +124,8 @@ data EventType
   | ConvCreate
   | ConvDelete
   | CollaboratorAdd
+  | CollaboratorUpdate
+  | CollaboratorRemove
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform EventType)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema EventType
@@ -140,7 +142,9 @@ instance ToSchema EventType where
           element "team.member-update" MemberUpdate,
           element "team.conversation-create" ConvCreate,
           element "team.conversation-delete" ConvDelete,
-          element "team.collaborator-add" CollaboratorAdd
+          element "team.collaborator-add" CollaboratorAdd,
+          element "team.collaborator-update" CollaboratorUpdate,
+          element "team.collaborator-remove" CollaboratorRemove
         ]
 
 --------------------------------------------------------------------------------
@@ -156,6 +160,8 @@ data EventData
   | EdConvCreate ConvId
   | EdConvDelete ConvId
   | EdCollaboratorAdd UserId [CollaboratorPermission]
+  | EdCollaboratorUpdate UserId [CollaboratorPermission]
+  | EdCollaboratorRemove UserId
   deriving stock (Eq, Show, Generic)
 
 -- FUTUREWORK: this is outright wrong; see "Wire.API.Event.Conversation" on how to do this properly.
@@ -185,6 +191,12 @@ instance ToJSON EventData where
       [ "user" A..= usr,
         "permissions" A..= perms
       ]
+  toJSON (EdCollaboratorUpdate usr perms) =
+    A.object
+      [ "user" A..= usr,
+        "permissions" A..= perms
+      ]
+  toJSON (EdCollaboratorRemove usr) = A.object ["user" A..= usr]
 
 eventDataType :: EventData -> EventType
 eventDataType (EdTeamCreate _) = TeamCreate
@@ -196,6 +208,8 @@ eventDataType (EdMemberUpdate _ _) = MemberUpdate
 eventDataType (EdConvCreate _) = ConvCreate
 eventDataType (EdConvDelete _) = ConvDelete
 eventDataType (EdCollaboratorAdd _ _) = CollaboratorAdd
+eventDataType (EdCollaboratorUpdate _ _) = CollaboratorUpdate
+eventDataType (EdCollaboratorRemove _) = CollaboratorRemove
 
 parseEventData :: EventType -> Maybe Value -> Parser EventData
 parseEventData MemberJoin Nothing = fail "missing event data for type 'team.member-join'"
@@ -226,6 +240,14 @@ parseEventData CollaboratorAdd Nothing = fail "missing event data for type 'team
 parseEventData CollaboratorAdd (Just j) = do
   let f o = EdCollaboratorAdd <$> o .: "user" <*> o .: "permissions"
   withObject "collaborator add data" f j
+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
 parseEventData _ Nothing = pure EdTeamDelete
 parseEventData t (Just _) = fail $ "unexpected event data for type " <> show t
 
@@ -240,5 +262,7 @@ genEventData = \case
   ConvCreate -> EdConvCreate <$> arbitrary
   ConvDelete -> EdConvDelete <$> arbitrary
   CollaboratorAdd -> EdCollaboratorAdd <$> arbitrary <*> arbitrary
+  CollaboratorUpdate -> EdCollaboratorUpdate <$> arbitrary <*> arbitrary
+  CollaboratorRemove -> EdCollaboratorRemove <$> arbitrary
 
 makeLenses ''Event

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

@@ -248,6 +248,13 @@ type ITeamsAPIBase =
                  :> ReqBody '[JSON] NewTeamMember
                  :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "OK")
              )
+             :<|> Named
+                    "unchecked-remove-team-member"
+                    ( Summary
+                        "Remove a user from a team and conversations"
+                        :> ZLocalUser
+                        :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 200 "OK")
+                    )
              :<|> Named
                     "unchecked-get-team-members"
                     ( QueryParam' '[Strict] "maxResults" (Range 1 HardTruncationLimit Int32)
@@ -305,6 +312,12 @@ type ITeamsAPIBase =
                         :> MultiVerb1 'PUT '[JSON] (RespondEmpty 204 "OK")
                     )
          )
+    :<|> Named
+           "close-conversations-from"
+           ( "close-conversations-from"
+               :> Capture "uid" UserId
+               :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "OK")
+           )
 
 type IFeatureStatusGet cfg =
   Named

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

@@ -2015,6 +2015,29 @@ type TeamsAPI =
                :> ReqBody '[JSON] NewTeamCollaborator
                :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "")
            )
+    :<|> 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."
+               :> From 'V11
+               :> ZLocalUser
+               :> "teams"
+               :> Capture "tid" TeamId
+               :> "collaborators"
+               :> Capture "uid" UserId
+               :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 200 "")
+           )
     :<|> Named
            "get-team-collaborators"
            ( Summary "Get all collaborators of the team."

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

@@ -478,6 +478,8 @@ data HiddenPerm
   | ChangeTeamMemberProfiles
   | SearchContacts
   | NewTeamCollaborator
+  | UpdateTeamCollaborator
+  | RemoveTeamCollaborator
   deriving (Eq, Ord, Show)
 
 -- | See Note [hidden team roles]
@@ -562,7 +564,9 @@ roleHiddenPermissions role = HiddenPermissions p p
             CreateUpdateDeleteIdp,
             CreateReadDeleteScimToken,
             DownloadTeamMembersCsv,
-            NewTeamCollaborator
+            NewTeamCollaborator,
+            UpdateTeamCollaborator,
+            RemoveTeamCollaborator
           ]
     roleHiddenPerms RoleMember =
       (roleHiddenPerms RoleExternalPartner <>) $

libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs

@@ -17,6 +17,7 @@
 
 module Wire.ConversationStore.Cassandra
   ( interpretConversationStoreToCassandra,
+    deleteConversation,
   )
 where
 

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

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Wire.ConversationsSubsystem where
+
+import Data.Id
+import Polysemy
+
+data ConversationsSubsystem m a where
+  InternalCloseConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m ()
+
+makeSem ''ConversationsSubsystem

libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs

@@ -0,0 +1,16 @@
+module Wire.ConversationsSubsystem.GalleyAPI
+  ( interpretConversationsSubsystemToGalleyAPI,
+  )
+where
+
+import Imports
+import Polysemy
+import Wire.ConversationsSubsystem
+import Wire.GalleyAPIAccess (GalleyAPIAccess)
+import Wire.GalleyAPIAccess qualified as GalleyAPIAccess
+
+interpretConversationsSubsystemToGalleyAPI :: (Member GalleyAPIAccess r) => InterpreterFor ConversationsSubsystem r
+interpretConversationsSubsystemToGalleyAPI =
+  interpret $
+    \case
+      InternalCloseConversationsFrom tid uid -> GalleyAPIAccess.closeConversationsFrom tid uid

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

@@ -72,6 +72,11 @@ data GalleyAPIAccess m a where
     Maybe (UserId, UTCTimeMillis) ->
     Role ->
     GalleyAPIAccess m Bool
+  RemoveTeamMember ::
+    Local UserId ->
+    UserId ->
+    TeamId ->
+    GalleyAPIAccess m ()
   CreateTeam ::
     UserId ->
     NewTeam ->
@@ -139,5 +144,6 @@ data GalleyAPIAccess m a where
     UserId ->
     GalleyAPIAccess m [EJPDConvInfo]
   GetTeamAdmins :: TeamId -> GalleyAPIAccess m Team.TeamMemberList
+  CloseConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m ()
 
 makeSem ''GalleyAPIAccess

libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs

@@ -74,6 +74,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
           NewClient id' ci -> newClient id' ci
           CheckUserCanJoinTeam id' -> checkUserCanJoinTeam id'
           AddTeamMember id' id'' a b -> addTeamMember id' id'' a b
+          RemoveTeamMember zUser' user team -> removeTeamMember zUser' user team
           CreateTeam id' bnt id'' -> createTeam id' bnt id''
           GetTeamMember id' id'' -> getTeamMember id' id''
           GetTeamMembers tid maxResults -> getTeamMembers tid maxResults
@@ -93,6 +94,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
           UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv
           GetEJPDConvInfo uid -> getEJPDConvInfo uid
           GetTeamAdmins tid -> getTeamAdmins tid
+          CloseConversationsFrom tid uid -> closeConversationsFrom tid uid
 
 getUserLegalholdStatus ::
   ( Member TinyLog r,
@@ -279,6 +281,29 @@ addTeamMember u tid minvmeta role = do
         . expect [status200, status403]
         . lbytes (encode bdy)
 
+-- | Calls 'Galley.API.uncheckedRemoveTeamMemberH'.
+removeTeamMember ::
+  ( Member Rpc r,
+    Member (Input Endpoint) r,
+    Member TinyLog r
+  ) =>
+  Local UserId ->
+  UserId ->
+  TeamId ->
+  Sem r ()
+removeTeamMember _puid tuid tid = do
+  debug $
+    remote "galley"
+      . msg (val "Removing member from team")
+  void $ galleyRequest req
+  where
+    req =
+      method DELETE
+        . paths ["i", "teams", toByteString' tid, "members"]
+        . header "Content-Type" "application/json"
+        . zUser tuid
+        . expect [status200, status403]
+
 -- | Calls 'Galley.API.createBindingTeamH'.
 createTeam ::
   ( Member Rpc r,
@@ -656,3 +681,22 @@ getEJPDConvInfo uid = do
     getReq =
       method GET
         . paths ["i", "user", toByteString' uid, "all-conversations"]
+
+-- | Calls 'Galley.API.updateTeamStatusH'.
+closeConversationsFrom ::
+  ( Member Rpc r,
+    Member (Input Endpoint) r,
+    Member TinyLog r
+  ) =>
+  TeamId ->
+  UserId ->
+  Sem r ()
+closeConversationsFrom tid uid = do
+  debug $ remote "galley" . msg (val "Close all conversations of a user in a team")
+  void $ galleyRequest req
+  where
+    req =
+      method POST
+        . paths ["i", "teams", toByteString' tid, "close-conversations-from", toByteString' uid]
+        . header "Content-Type" "application/json"
+        . expect2xx

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

@@ -13,5 +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