From 4084173b490d0676b68db06d97632d8b807b9fdc Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 30 Jul 2025 17:59:37 +0200 Subject: [PATCH 01/50] WPB-18190: Add route to delete collaborator from team --- changelog.d/2-features/WPB-18190 | 1 + integration/test/API/Brig.hs | 6 +++ integration/test/Test/TeamCollaborators.hs | 16 +++++++- libs/wire-api/src/Wire/API/Event/Team.hs | 10 +++++ .../src/Wire/API/Routes/Public/Brig.hs | 11 ++++++ libs/wire-api/src/Wire/API/Team/Member.hs | 4 +- .../src/Wire/TeamCollaboratorsStore.hs | 1 + .../Wire/TeamCollaboratorsStore/Postgres.hs | 25 ++++++++++++ .../src/Wire/TeamCollaboratorsSubsystem.hs | 1 + .../TeamCollaboratorsSubsystem/Interpreter.hs | 39 +++++++++++++++++++ .../TeamCollaboratorsStore.hs | 2 + services/brig/src/Brig/Team/API.hs | 1 + 12 files changed, 115 insertions(+), 2 deletions(-) create mode 100644 changelog.d/2-features/WPB-18190 diff --git a/changelog.d/2-features/WPB-18190 b/changelog.d/2-features/WPB-18190 new file mode 100644 index 0000000000..a8a8268b9f --- /dev/null +++ b/changelog.d/2-features/WPB-18190 @@ -0,0 +1 @@ +Allow member to be removed from a team. diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 11f09b8052..43205da9be 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -1183,3 +1183,9 @@ 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 Brig Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId] + submit "DELETE" req diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index bcff88d58c..a687a17e45 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -156,4 +156,18 @@ 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" +testRemoveMember :: (HasCallStack) => App () +testRemoveMember = 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 + removeTeamCollaborator owner team bob >>= assertSuccess + + postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "no-team-member" diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index 9c1612770c..43cb9868b0 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -125,6 +125,7 @@ data EventType | ConvDelete | CollaboratorAdd | AppCreate + | CollaboratorRemove deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform EventType) deriving (FromJSON, ToJSON, S.ToSchema) via Schema EventType @@ -143,6 +144,7 @@ instance ToSchema EventType where element "team.conversation-delete" ConvDelete, element "team.collaborator-add" CollaboratorAdd, element "team.app-create" AppCreate + element "team.collaborator-remove" CollaboratorRemove ] -------------------------------------------------------------------------------- @@ -159,6 +161,7 @@ data EventData | EdConvDelete ConvId | EdCollaboratorAdd UserId [CollaboratorPermission] | EdAppCreate UserId + | EdCollaboratorRemove UserId deriving stock (Eq, Show, Generic) -- FUTUREWORK: this is outright wrong; see "Wire.API.Event.Conversation" on how to do this properly. @@ -189,6 +192,7 @@ instance ToJSON EventData where "permissions" A..= perms ] toJSON (EdAppCreate usr) = A.object ["user" A..= usr] + toJSON (EdCollaboratorRemove usr) = A.object ["user" A..= usr] eventDataType :: EventData -> EventType eventDataType (EdTeamCreate _) = TeamCreate @@ -201,6 +205,7 @@ eventDataType (EdConvCreate _) = ConvCreate eventDataType (EdConvDelete _) = ConvDelete eventDataType (EdCollaboratorAdd _ _) = CollaboratorAdd eventDataType (EdAppCreate _) = AppCreate +eventDataType (EdCollaboratorRemove _) = CollaboratorRemove parseEventData :: EventType -> Maybe Value -> Parser EventData parseEventData MemberJoin Nothing = fail "missing event data for type 'team.member-join'" @@ -235,6 +240,10 @@ parseEventData AppCreate Nothing = fail "missing event data for type 'team.app-c 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 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 @@ -250,5 +259,6 @@ genEventData = \case ConvDelete -> EdConvDelete <$> arbitrary CollaboratorAdd -> EdCollaboratorAdd <$> arbitrary <*> arbitrary AppCreate -> EdAppCreate <$> arbitrary + CollaboratorRemove -> EdCollaboratorRemove <$> arbitrary makeLenses ''Event diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b54f9db2a8..3ec9616536 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -2061,6 +2061,17 @@ type TeamsAPI = :> ReqBody '[JSON] NewTeamCollaborator :> MultiVerb1 'POST '[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." diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 82651202af..f6a75b1ebc 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -482,6 +482,7 @@ data HiddenPerm | JoinRegularConversations | CreateApp | ManageApps + | RemoveTeamCollaborator deriving (Eq, Ord, Show) -- | See Note [hidden team roles] @@ -568,7 +569,8 @@ roleHiddenPermissions role = HiddenPermissions p p DownloadTeamMembersCsv, NewTeamCollaborator, CreateApp, - ManageApps + ManageApps, + RemoveTeamCollaborator ] roleHiddenPerms RoleMember = (roleHiddenPerms RoleExternalPartner <>) $ diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs index 5d7e7962e7..55a0e4658d 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs @@ -13,5 +13,6 @@ 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] + RemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsStore m () makeSem ''TeamCollaboratorsStore diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs index af3114044e..cb9b3b4180 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs +++ b/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 + RemoveTeamCollaborator userId teamId -> removeTeamCollaboratorImpl userId teamId getTeamCollaboratorImpl :: ( Member (Input Pool) r, @@ -124,6 +125,30 @@ getAllTeamCollaboratorsImpl teamId = do select user_id :: uuid, team_id :: uuid, permissions :: int2[] from collaborators where team_id = ($1 :: uuid) |] +removeTeamCollaboratorImpl :: + ( Member (Input Pool) r, + Member (Embed IO) r, + Member (Error UsageError) r + ) => + UserId -> + TeamId -> + Sem r () +removeTeamCollaboratorImpl userId teamId = do + pool <- input + eitherErrorOrUnit <- liftIO $ use pool session + either throw pure eitherErrorOrUnit + where + session :: Session () + session = statement (userId, teamId) deleteStatement + + deleteStatement :: Statement (UserId, TeamId) () + deleteStatement = + lmap + (bimap toUUID toUUID) + $ [resultlessStatement| + delete from collaborators where user_id = ($1 :: uuid) and team_id = ($2 :: uuid) + |] + toTeamCollaborator :: (UUID, UUID, Vector Int16) -> TeamCollaborator toTeamCollaborator ((Id -> gUser), (Id -> gTeam), (toPermissions -> gPermissions)) = TeamCollaborator {..} diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index d7e7df2075..d743eb654e 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -14,5 +14,6 @@ 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] + RemoveTeamCollaborator :: Local UserId -> UserId -> TeamId -> TeamCollaboratorsSubsystem m () makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index b2a0c26a29..107a1cc027 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/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 + RemoveTeamCollaborator zUser user team -> removeTeamCollaboratorImpl zUser user team internalGetTeamCollaboratorImpl :: (Member Store.TeamCollaboratorsStore r) => @@ -81,6 +82,7 @@ getAllTeamCollaboratorsImpl zUser team = do guardPermission (tUnqualified zUser) team TeamMember.NewTeamCollaborator InsufficientRights Store.getAllTeamCollaborators team + internalGetTeamCollaboratorsWithIdsImpl :: ( Member Store.TeamCollaboratorsStore r ) => @@ -90,6 +92,43 @@ internalGetTeamCollaboratorsWithIdsImpl :: internalGetTeamCollaboratorsWithIdsImpl = do Store.getTeamCollaboratorsWithIds +removeTeamCollaboratorImpl :: + ( Member TeamSubsystem r, + Member (Error TeamCollaboratorsError) r, + Member Store.TeamCollaboratorsStore r, + Member Now r, + Member NotificationSubsystem r + ) => + Local UserId -> + UserId -> + TeamId -> + Sem r () +removeTeamCollaboratorImpl zUser user team = do + guardPermission (tUnqualified zUser) team TeamMember.RemoveTeamCollaborator InsufficientRights + Store.removeTeamCollaborator user team + -- TODO gdf remove O2O conversations + + now <- get + let event = newEvent team now (EdCollaboratorRemove user) + teamMembersList <- internalGetTeamAdmins team + let teamMembers :: [UserId] = view TeamMember.userId <$> (teamMembersList ^. TeamMember.teamMembers) + -- TODO: Review the event's values + pushNotifications + [ def + { origin = Just (tUnqualified zUser), + json = toJSONObject $ event, + recipients = + ( \uid -> + Recipient + { recipientUserId = uid, + recipientClients = Push.RecipientClientsAll + } + ) + <$> teamMembers, + transient = False + } + ] + -- This is of general usefulness. However, we cannot move this to wire-api as -- this would lead to a cyclic dependency. guardPermission :: diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs index 06ef6176bd..fab46b025d 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs @@ -27,3 +27,5 @@ inMemoryTeamCollaboratorsStoreInterpreter = GetTeamCollaboratorsWithIds teamIds userIds -> gets $ \(s :: Map TeamId [TeamCollaborator]) -> concatMap (concatMap (filter (\tc -> tc.gUser `elem` userIds)) . (\(tid :: TeamId) -> Map.lookup tid s)) teamIds + RemoveTeamCollaborator userId teamId -> + modify $ Map.alter (fmap $ filter $ (/= userId) . gUser) teamId diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index d9d375f157..01efc9e732 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -114,6 +114,7 @@ servantAPI = :<|> Named @"get-team-size" (\uid tid -> lift . liftSem $ teamSizePublic uid tid) :<|> Named @"accept-team-invitation" (\luid req -> lift $ liftSem $ acceptTeamInvitation luid req.password req.code) :<|> Named @"add-team-collaborator" (\zuid tid (NewTeamCollaborator uid perms) -> lift . liftSem $ createTeamCollaborator zuid uid tid perms) + :<|> Named @"remove-team-collaborator" (\zuid tid uid -> lift . liftSem $ removeTeamCollaborator zuid uid tid) :<|> Named @"get-team-collaborators" (\zuid tid -> lift . liftSem $ getAllTeamCollaborators zuid tid) teamSizePublic :: From 586f33154fa81a24f6afd75f539021051ed6edc1 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 1 Aug 2025 17:54:46 +0200 Subject: [PATCH 02/50] add conversation drop --- .../src/Wire/ConversationsStore.hs | 11 ++++++++++ .../src/Wire/ConversationsStore/Cassandra.hs | 20 +++++++++++++++++++ .../TeamCollaboratorsSubsystem/Interpreter.hs | 9 ++++++--- .../test/unit/Wire/MiniBackend.hs | 12 ++++++++++- .../brig/src/Brig/CanonicalInterpreter.hs | 4 ++++ services/galley/src/Galley/App.hs | 5 ++++- 6 files changed, 56 insertions(+), 5 deletions(-) create mode 100644 libs/wire-subsystems/src/Wire/ConversationsStore.hs create mode 100644 libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs diff --git a/libs/wire-subsystems/src/Wire/ConversationsStore.hs b/libs/wire-subsystems/src/Wire/ConversationsStore.hs new file mode 100644 index 0000000000..6027c31612 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationsStore.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.ConversationsStore where + +import Data.Id +import Polysemy + +data ConversationsStore m a where + CloseConversationsFrom :: TeamId -> UserId -> ConversationsStore m () + +makeSem ''ConversationsStore diff --git a/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs new file mode 100644 index 0000000000..a61ef2e855 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs @@ -0,0 +1,20 @@ +module Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) where + +import Cassandra +import Data.Id +import Imports +import Polysemy +import Polysemy.Embed +import Wire.ConversationsStore + +interpretConversationsStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor ConversationsStore r +interpretConversationsStoreCassandra casClient = + interpret $ + runEmbedded (runClient casClient) . embed . \case + CloseConversationsFrom tid uid -> closeConversationsFromImpl tid uid + +closeConversationsFromImpl :: TeamId -> UserId -> Client () +closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) + where + conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () + conversationsUpdate = "UPDATE conversation SET deleted = true WHERE team = ? AND author = ?" diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 107a1cc027..8ac6fb4e6d 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -12,6 +12,7 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator import Wire.API.Team.Member qualified as TeamMember +import Wire.ConversationsStore (ConversationsStore, closeConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -25,7 +26,8 @@ interpretTeamCollaboratorsSubsystem :: Member (Error TeamCollaboratorsError) r, Member Store.TeamCollaboratorsStore r, Member Now r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member ConversationsStore r ) => InterpreterFor TeamCollaboratorsSubsystem r interpretTeamCollaboratorsSubsystem = interpret $ \case @@ -97,7 +99,8 @@ removeTeamCollaboratorImpl :: Member (Error TeamCollaboratorsError) r, Member Store.TeamCollaboratorsStore r, Member Now r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member ConversationsStore r ) => Local UserId -> UserId -> @@ -106,7 +109,7 @@ removeTeamCollaboratorImpl :: removeTeamCollaboratorImpl zUser user team = do guardPermission (tUnqualified zUser) team TeamMember.RemoveTeamCollaborator InsufficientRights Store.removeTeamCollaborator user team - -- TODO gdf remove O2O conversations + closeConversationsFrom team user now <- get let event = newEvent team now (EdCollaboratorRemove user) diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 9673139026..0c84a709f9 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -77,6 +77,7 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Cookie.Limit import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore +import Wire.ConversationsStore (ConversationsStore (..)) import Wire.DeleteQueue import Wire.DeleteQueue.InMemory import Wire.DomainRegistrationStore qualified as DRS @@ -633,7 +634,16 @@ interpretMaybeFederationStackState mb = userSubsystemInterpreter :: InterpreterFor UserSubsystem (TeamCollaboratorsSubsystem ': MiniBackendLowerEffects `Append` r) userSubsystemInterpreter = runUserSubsystem authSubsystemInterpreter - in miniBackendLowerEffectsInterpreters mb . interpretTeamCollaboratorsSubsystem . userSubsystemInterpreter + interpretConversationsStore :: forall r0. InterpreterFor ConversationsStore r0 + interpretConversationsStore = + interpret $ + \case + CloseConversationsFrom _tid _uid -> pure () + in miniBackendLowerEffectsInterpreters mb + . interpretConversationsStore + . interpretTeamCollaboratorsSubsystem + . raiseUnder @ConversationsStore + . userSubsystemInterpreter liftInvitationInfoStoreState :: (Member (State MiniBackend) r) => Sem (State (Map InvitationCode StoredInvitation) : r) a -> Sem r a liftInvitationInfoStoreState = interpret \case diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 6e968f75ae..e190ba3343 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -47,6 +47,8 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore import Wire.BlockListStore.Cassandra +import Wire.ConversationsStore (ConversationsStore) +import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) import Wire.DeleteQueue import Wire.DomainRegistrationStore import Wire.DomainRegistrationStore.Cassandra @@ -175,6 +177,7 @@ type BrigLowerLevelEffects = HashPassword, UserKeyStore, UserStore, + ConversationsStore, IndexedUserStore, SessionStore, PasswordStore, @@ -341,6 +344,7 @@ runBrigToIO e (AppT ma) = do . interpretPasswordStore e.casClient . interpretSessionStoreCassandra e.casClient . interpretIndexedUserStoreES indexedUserStoreConfig + . interpretConversationsStoreCassandra e.casClient . interpretUserStoreCassandra e.casClient . interpretUserKeyStoreCassandra e.casClient . runHashPassword e.settings.passwordHashingOptions diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 99906c6a2a..aeb6408ed3 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -107,7 +107,8 @@ import Wire.API.Federation.Error import Wire.API.Team.Collaborator import Wire.API.Team.Feature import Wire.BrigAPIAccess.Rpc -import Wire.ConversationStore.Cassandra (interpretConversationStoreToCassandra) +import Wire.ConversationsStore (ConversationsStore) +import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) import Wire.Error import Wire.GundeckAPIAccess (runGundeckAPIAccess) import Wire.HashPassword.Interpreter @@ -312,7 +313,9 @@ evalGalley e = . runGundeckAPIAccess (e ^. options . gundeck) . interpretTeamSubsystem . runNotificationSubsystemGundeck (notificationSubsystemConfig e) + . interpretConversationsStoreCassandra e._cstate . interpretTeamCollaboratorsSubsystem + . raiseUnder @ConversationsStore . interpretSparAccess . interpretBrigAccess (e ^. brig) . interpretExternalAccess From cfead2ee5f88db0782c03d72c621d3c0a4b76417 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 4 Aug 2025 15:43:39 +0200 Subject: [PATCH 03/50] debug --- .../src/Wire/ConversationsStore/Cassandra.hs | 39 +++++++++++++++---- .../brig/src/Brig/CanonicalInterpreter.hs | 4 +- services/galley/src/Galley/App.hs | 2 +- 3 files changed, 35 insertions(+), 10 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs index a61ef2e855..7409912913 100644 --- a/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs @@ -1,20 +1,45 @@ -module Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) where +module Wire.ConversationsStore.Cassandra + ( interpretConversationsStoreCassandraOn, + interpretConversationsStoreCassandra, + ) +where import Cassandra import Data.Id import Imports import Polysemy -import Polysemy.Embed +import Polysemy.Input import Wire.ConversationsStore -interpretConversationsStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor ConversationsStore r -interpretConversationsStoreCassandra casClient = +interpretConversationsStoreCassandraOn :: + (Member (Embed IO) r) => + ClientState -> + InterpreterFor ConversationsStore r +interpretConversationsStoreCassandraOn casClient = + runInputConst casClient + . interpretConversationsStoreCassandra + . raiseUnder + +interpretConversationsStoreCassandra :: + ( Member (Embed IO) r, + Member (Input ClientState) r + ) => + InterpreterFor ConversationsStore r +interpretConversationsStoreCassandra = interpret $ - runEmbedded (runClient casClient) . embed . \case - CloseConversationsFrom tid uid -> closeConversationsFromImpl tid uid + \case + CloseConversationsFrom tid uid -> do + cs <- input + embed @IO $ runClient cs $ closeConversationsFromImpl tid uid closeConversationsFromImpl :: TeamId -> UserId -> Client () closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) where conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () - conversationsUpdate = "UPDATE conversation SET deleted = true WHERE team = ? AND author = ?" + conversationsUpdate = "update conversation set deleted = true where conv = ? and author = ?" + +_closeConversationsFromImpl :: TeamId -> UserId -> Client () +_closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) + where + conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () + conversationsUpdate = "update conversation set deleted = true where team = ? and author = ?" diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index e190ba3343..07cc0c8c3a 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -48,7 +48,7 @@ import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore import Wire.BlockListStore.Cassandra import Wire.ConversationsStore (ConversationsStore) -import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) +import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandraOn) import Wire.DeleteQueue import Wire.DomainRegistrationStore import Wire.DomainRegistrationStore.Cassandra @@ -344,7 +344,7 @@ runBrigToIO e (AppT ma) = do . interpretPasswordStore e.casClient . interpretSessionStoreCassandra e.casClient . interpretIndexedUserStoreES indexedUserStoreConfig - . interpretConversationsStoreCassandra e.casClient + . interpretConversationsStoreCassandraOn e.casClient . interpretUserStoreCassandra e.casClient . interpretUserKeyStoreCassandra e.casClient . runHashPassword e.settings.passwordHashingOptions diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index aeb6408ed3..3371587e4c 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -313,7 +313,7 @@ evalGalley e = . runGundeckAPIAccess (e ^. options . gundeck) . interpretTeamSubsystem . runNotificationSubsystemGundeck (notificationSubsystemConfig e) - . interpretConversationsStoreCassandra e._cstate + . interpretConversationsStoreCassandra . interpretTeamCollaboratorsSubsystem . raiseUnder @ConversationsStore . interpretSparAccess From 95712025c33f8b2f2bd1542ec7a98fa0c9a57d8b Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 4 Aug 2025 18:57:04 +0200 Subject: [PATCH 04/50] go through GalleyAPI --- .../src/Wire/API/Routes/Internal/Galley.hs | 6 +++ .../src/Wire/ConversationsStore.hs | 11 ----- .../src/Wire/ConversationsStore/Cassandra.hs | 45 ------------------- .../src/Wire/ConversationsSubsystem.hs | 11 +++++ .../Wire/ConversationsSubsystem/GalleyAPI.hs | 16 +++++++ .../src/Wire/GalleyAPIAccess.hs | 1 + .../src/Wire/GalleyAPIAccess/Rpc.hs | 20 +++++++++ .../TeamCollaboratorsSubsystem/Interpreter.hs | 8 ++-- .../test/unit/Wire/MiniBackend.hs | 12 ++--- .../Wire/MockInterpreters/GalleyAPIAccess.hs | 1 + libs/wire-subsystems/wire-subsystems.cabal | 2 + .../brig/src/Brig/CanonicalInterpreter.hs | 8 ++-- services/galley/galley.cabal | 3 ++ services/galley/src/Galley/API/Internal.hs | 2 + services/galley/src/Galley/App.hs | 6 +-- .../src/Galley/ConversationsSubsystem.hs | 33 ++++++++++++++ services/galley/src/Galley/Effects.hs | 3 +- 17 files changed, 113 insertions(+), 75 deletions(-) delete mode 100644 libs/wire-subsystems/src/Wire/ConversationsStore.hs delete mode 100644 libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs create mode 100644 libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs create mode 100644 libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs create mode 100644 services/galley/src/Galley/ConversationsSubsystem.hs diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 809cefde15..47741cedd8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -315,6 +315,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 diff --git a/libs/wire-subsystems/src/Wire/ConversationsStore.hs b/libs/wire-subsystems/src/Wire/ConversationsStore.hs deleted file mode 100644 index 6027c31612..0000000000 --- a/libs/wire-subsystems/src/Wire/ConversationsStore.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Wire.ConversationsStore where - -import Data.Id -import Polysemy - -data ConversationsStore m a where - CloseConversationsFrom :: TeamId -> UserId -> ConversationsStore m () - -makeSem ''ConversationsStore diff --git a/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs deleted file mode 100644 index 7409912913..0000000000 --- a/libs/wire-subsystems/src/Wire/ConversationsStore/Cassandra.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Wire.ConversationsStore.Cassandra - ( interpretConversationsStoreCassandraOn, - interpretConversationsStoreCassandra, - ) -where - -import Cassandra -import Data.Id -import Imports -import Polysemy -import Polysemy.Input -import Wire.ConversationsStore - -interpretConversationsStoreCassandraOn :: - (Member (Embed IO) r) => - ClientState -> - InterpreterFor ConversationsStore r -interpretConversationsStoreCassandraOn casClient = - runInputConst casClient - . interpretConversationsStoreCassandra - . raiseUnder - -interpretConversationsStoreCassandra :: - ( Member (Embed IO) r, - Member (Input ClientState) r - ) => - InterpreterFor ConversationsStore r -interpretConversationsStoreCassandra = - interpret $ - \case - CloseConversationsFrom tid uid -> do - cs <- input - embed @IO $ runClient cs $ closeConversationsFromImpl tid uid - -closeConversationsFromImpl :: TeamId -> UserId -> Client () -closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) - where - conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () - conversationsUpdate = "update conversation set deleted = true where conv = ? and author = ?" - -_closeConversationsFromImpl :: TeamId -> UserId -> Client () -_closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) - where - conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () - conversationsUpdate = "update conversation set deleted = true where team = ? and author = ?" diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs new file mode 100644 index 0000000000..561c7cf6eb --- /dev/null +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs new file mode 100644 index 0000000000..ef73a66e7d --- /dev/null +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index c4dd5fcc26..09fb702bc0 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -144,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 diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 2ac97e142e..197504a5f2 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -96,6 +96,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, @@ -680,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 diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 8ac6fb4e6d..9162ea84a7 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -12,7 +12,7 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator import Wire.API.Team.Member qualified as TeamMember -import Wire.ConversationsStore (ConversationsStore, closeConversationsFrom) +import Wire.ConversationsSubsystem (ConversationsSubsystem, internalCloseConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -27,7 +27,7 @@ interpretTeamCollaboratorsSubsystem :: Member Store.TeamCollaboratorsStore r, Member Now r, Member NotificationSubsystem r, - Member ConversationsStore r + Member ConversationsSubsystem r ) => InterpreterFor TeamCollaboratorsSubsystem r interpretTeamCollaboratorsSubsystem = interpret $ \case @@ -100,7 +100,7 @@ removeTeamCollaboratorImpl :: Member Store.TeamCollaboratorsStore r, Member Now r, Member NotificationSubsystem r, - Member ConversationsStore r + Member ConversationsSubsystem r ) => Local UserId -> UserId -> @@ -109,7 +109,7 @@ removeTeamCollaboratorImpl :: removeTeamCollaboratorImpl zUser user team = do guardPermission (tUnqualified zUser) team TeamMember.RemoveTeamCollaborator InsufficientRights Store.removeTeamCollaborator user team - closeConversationsFrom team user + internalCloseConversationsFrom team user now <- get let event = newEvent team now (EdCollaboratorRemove user) diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 0c84a709f9..cdb15aea22 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -77,7 +77,7 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Cookie.Limit import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore -import Wire.ConversationsStore (ConversationsStore (..)) +import Wire.ConversationsSubsystem (ConversationsSubsystem (..)) import Wire.DeleteQueue import Wire.DeleteQueue.InMemory import Wire.DomainRegistrationStore qualified as DRS @@ -634,15 +634,15 @@ interpretMaybeFederationStackState mb = userSubsystemInterpreter :: InterpreterFor UserSubsystem (TeamCollaboratorsSubsystem ': MiniBackendLowerEffects `Append` r) userSubsystemInterpreter = runUserSubsystem authSubsystemInterpreter - interpretConversationsStore :: forall r0. InterpreterFor ConversationsStore r0 - interpretConversationsStore = + interpretConversationsSubsystem :: forall r0. InterpreterFor ConversationsSubsystem r0 + interpretConversationsSubsystem = interpret $ \case - CloseConversationsFrom _tid _uid -> pure () + InternalCloseConversationsFrom _tid _uid -> pure () in miniBackendLowerEffectsInterpreters mb - . interpretConversationsStore + . interpretConversationsSubsystem . interpretTeamCollaboratorsSubsystem - . raiseUnder @ConversationsStore + . raiseUnder @ConversationsSubsystem . userSubsystemInterpreter liftInvitationInfoStoreState :: (Member (State MiniBackend) r) => Sem (State (Map InvitationCode StoredInvitation) : r) a -> Sem r a diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index a99e6ab713..630ead50e2 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -49,6 +49,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case GetEJPDConvInfo _ -> error "GetEJPDConvInfo not implemented in miniGalleyAPIAccess" GetTeamAdmins tid -> pure $ newTeamMemberList (maybe [] (filter (\tm -> isAdminOrOwner (tm ^. permissions))) $ Map.lookup tid teams) ListComplete SelectTeamMemberInfos tid uids -> pure $ selectTeamMemberInfosImpl teams tid uids + CloseConversationsFrom _ _ -> pure () -- this is called but the result is not needed in unit tests selectTeamMemberInfosImpl :: Map TeamId [TeamMember] -> TeamId -> [UserId] -> TeamMemberInfoList diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index ff514fc848..5910e4ed6b 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -191,6 +191,8 @@ library Wire.ConversationStore.Cassandra.Instances Wire.ConversationStore.Cassandra.Queries Wire.ConversationStore.MLS.Types + Wire.ConversationsSubsystem + Wire.ConversationsSubsystem.GalleyAPI Wire.DeleteQueue Wire.DeleteQueue.InMemory Wire.DomainRegistrationStore diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 07cc0c8c3a..c8b6ba918b 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -47,8 +47,8 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore import Wire.BlockListStore.Cassandra -import Wire.ConversationsStore (ConversationsStore) -import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandraOn) +import Wire.ConversationsSubsystem (ConversationsSubsystem) +import Wire.ConversationsSubsystem.GalleyAPI (interpretConversationsSubsystemToGalleyAPI) import Wire.DeleteQueue import Wire.DomainRegistrationStore import Wire.DomainRegistrationStore.Cassandra @@ -177,7 +177,7 @@ type BrigLowerLevelEffects = HashPassword, UserKeyStore, UserStore, - ConversationsStore, + ConversationsSubsystem, IndexedUserStore, SessionStore, PasswordStore, @@ -344,7 +344,7 @@ runBrigToIO e (AppT ma) = do . interpretPasswordStore e.casClient . interpretSessionStoreCassandra e.casClient . interpretIndexedUserStoreES indexedUserStoreConfig - . interpretConversationsStoreCassandraOn e.casClient + . interpretConversationsSubsystemToGalleyAPI . interpretUserStoreCassandra e.casClient . interpretUserKeyStoreCassandra e.casClient . runHashPassword e.settings.passwordHashingOptions diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 5df13bc880..180b97c2e0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -149,6 +149,9 @@ library Galley.Cassandra.TeamFeatures Galley.Cassandra.TeamNotifications Galley.Cassandra.Util + Galley.ConversationsSubsystem + Galley.Data.Conversation + Galley.Data.Conversation.Types Galley.Data.Scope Galley.Data.TeamNotifications Galley.Data.Types diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b6ad084273..8d7099ab52 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -95,6 +95,7 @@ import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client import Wire.ConversationStore import Wire.ConversationStore qualified as E +import Wire.ConversationsSubsystem qualified as ConversationsSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now @@ -228,6 +229,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) ( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid) <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid) ) + <@> mkNamedAPI @"close-conversations-from" (ConversationsSubsystem.internalCloseConversationsFrom tid) miscAPI :: API IMiscAPI GalleyEffects miscAPI = diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 3371587e4c..ced26d1541 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -64,6 +64,7 @@ import Galley.Cassandra.Services import Galley.Cassandra.Team import Galley.Cassandra.TeamFeatures import Galley.Cassandra.TeamNotifications +import Galley.ConversationsSubsystem (interpretConversationsSubsystemCassandra) import Galley.Effects import Galley.Effects.FireAndForget import Galley.Env @@ -107,8 +108,6 @@ import Wire.API.Federation.Error import Wire.API.Team.Collaborator import Wire.API.Team.Feature import Wire.BrigAPIAccess.Rpc -import Wire.ConversationsStore (ConversationsStore) -import Wire.ConversationsStore.Cassandra (interpretConversationsStoreCassandra) import Wire.Error import Wire.GundeckAPIAccess (runGundeckAPIAccess) import Wire.HashPassword.Interpreter @@ -311,11 +310,10 @@ evalGalley e = . interpretFederatorAccess . runRpcWithHttp (e ^. manager) (e ^. reqId) . runGundeckAPIAccess (e ^. options . gundeck) + . interpretConversationsSubsystemCassandra . interpretTeamSubsystem . runNotificationSubsystemGundeck (notificationSubsystemConfig e) - . interpretConversationsStoreCassandra . interpretTeamCollaboratorsSubsystem - . raiseUnder @ConversationsStore . interpretSparAccess . interpretBrigAccess (e ^. brig) . interpretExternalAccess diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs new file mode 100644 index 0000000000..e4c8386a28 --- /dev/null +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -0,0 +1,33 @@ +module Galley.ConversationsSubsystem + ( interpretConversationsSubsystemCassandra, + ) +where + +import Cassandra +import Data.Id +import Galley.Cassandra.Store (embedClient) +import Galley.Cassandra.Util (logEffect) +import Imports +import Polysemy +import Polysemy.Input +import Polysemy.TinyLog (TinyLog) +import Wire.ConversationsSubsystem + +interpretConversationsSubsystemCassandra :: + ( Member (Embed IO) r, + Member (Input ClientState) r, + Member TinyLog r + ) => + InterpreterFor ConversationsSubsystem r +interpretConversationsSubsystemCassandra = + interpret $ + \case + InternalCloseConversationsFrom tid uid -> do + logEffect "ConversationsSubsystem.internalCloseConversationsFrom" + embedClient $ closeConversationsFromImpl tid uid + +closeConversationsFromImpl :: TeamId -> UserId -> Client () +closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) + where + conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () + conversationsUpdate = "update conversation set deleted = true where team = ? and creator = ?" diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 22e10cc0c4..7643e081e5 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -90,7 +90,7 @@ import Polysemy.TinyLog import Wire.API.Error import Wire.API.Team.Feature import Wire.BrigAPIAccess -import Wire.ConversationStore (ConversationStore) +import Wire.ConversationsSubsystem (ConversationsSubsystem) import Wire.GundeckAPIAccess import Wire.HashPassword import Wire.ListItems @@ -112,6 +112,7 @@ type GalleyEffects1 = TeamCollaboratorsSubsystem, NotificationSubsystem, TeamSubsystem, + ConversationsSubsystem, GundeckAPIAccess, Rpc, FederatorAccess, From f6955b3363a413b6896b7535b66053c1758b1288 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 5 Aug 2025 12:58:26 +0200 Subject: [PATCH 05/50] filter then delete --- .../src/Galley/ConversationsSubsystem.hs | 26 ++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index e4c8386a28..92071a240c 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -4,7 +4,10 @@ module Galley.ConversationsSubsystem where import Cassandra +import Cassandra.Exec +import Conduit import Data.Id +import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) import Galley.Cassandra.Util (logEffect) import Imports @@ -12,6 +15,7 @@ import Polysemy import Polysemy.Input import Polysemy.TinyLog (TinyLog) import Wire.ConversationsSubsystem +import Wire.Sem.Paging.Cassandra (InternalPage (InternalPage), mkInternalPage) interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, @@ -27,7 +31,23 @@ interpretConversationsSubsystemCassandra = embedClient $ closeConversationsFromImpl tid uid closeConversationsFromImpl :: TeamId -> UserId -> Client () -closeConversationsFromImpl t u = retry x5 $ write conversationsUpdate (params LocalQuorum (t, Just u)) +closeConversationsFromImpl tid uid = + runConduit $ + paginateWithStateC listConversationsIds + .| mapMC performFilter + .| mapM_C performUpdate where - conversationsUpdate :: PrepQuery W (TeamId, Maybe UserId) () - conversationsUpdate = "update conversation set deleted = true where team = ? and creator = ?" + listConversationsIds pagingState = + fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) + performFilter :: [ConvId] -> Client [ConvId] + performFilter convIds = do + page <- paginate conversationsFilter (params LocalQuorum (Identity convIds)) + InternalPage (_, _, filteredConvIds) <- mkInternalPage page pure + pure $ + map (\(convId, _team, _mCreator) -> convId) $ + filter (\(_convId, team, mCreator) -> team == Just tid && mCreator == Just uid) filteredConvIds + conversationsFilter :: PrepQuery R (Identity [ConvId]) (ConvId, Maybe TeamId, Maybe UserId) + conversationsFilter = "select conv, team, creator from conversation where conv in ?" + performUpdate convIds = retry x5 $ write conversationsUpdate (params LocalQuorum (Identity convIds)) + conversationsUpdate :: PrepQuery W (Identity [ConvId]) () + conversationsUpdate = "update conversation set deleted = true where conv in ?" From 0c35a6fbba466cc909a87a314ed34d6d4de4f205 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 5 Aug 2025 12:59:16 +0200 Subject: [PATCH 06/50] missing dependency --- services/galley/galley.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 180b97c2e0..4d71b714f2 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -293,6 +293,7 @@ library , cassandra-util >=0.16.2 , cassava >=0.5.2 , comonad + , conduit , constraints , containers >=0.5 , crypton From 1bb0ac7cc1f0f54e600258a26ba1dc537669a7aa Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 5 Aug 2025 16:52:35 +0200 Subject: [PATCH 07/50] fix missing nix dependency --- services/galley/default.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/services/galley/default.nix b/services/galley/default.nix index ed562355f2..134e2a1756 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -147,6 +147,7 @@ mkDerivation { cassandra-util cassava comonad + conduit constraints containers crypton From f77061fd0c89a538f0ef1eb414b22fe0093bec7d Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 6 Aug 2025 17:31:48 +0200 Subject: [PATCH 08/50] fix: remove O2O Conversations and remove users from others --- .../src/Galley/ConversationsSubsystem.hs | 23 +++++++++++-------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index 92071a240c..a0a993ad07 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -6,7 +6,9 @@ where import Cassandra import Cassandra.Exec import Conduit +import Data.Bifoldable import Data.Id +import Galley.Cassandra.Conversation (deleteConversation) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) import Galley.Cassandra.Util (logEffect) @@ -14,6 +16,7 @@ import Imports import Polysemy import Polysemy.Input import Polysemy.TinyLog (TinyLog) +import Wire.API.Conversation (ConvType (..)) import Wire.ConversationsSubsystem import Wire.Sem.Paging.Cassandra (InternalPage (InternalPage), mkInternalPage) @@ -35,19 +38,21 @@ closeConversationsFromImpl tid uid = runConduit $ paginateWithStateC listConversationsIds .| mapMC performFilter - .| mapM_C performUpdate + .| mapM_C (bimapM_ (mapM_ deleteConversation) performConversationsRemoveUser) where listConversationsIds pagingState = fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) - performFilter :: [ConvId] -> Client [ConvId] + performFilter :: [ConvId] -> Client ([ConvId], [ConvId]) performFilter convIds = do page <- paginate conversationsFilter (params LocalQuorum (Identity convIds)) InternalPage (_, _, filteredConvIds) <- mkInternalPage page pure + let extractConv = map (\(convId, _team, _convType) -> convId) pure $ - map (\(convId, _team, _mCreator) -> convId) $ - filter (\(_convId, team, mCreator) -> team == Just tid && mCreator == Just uid) filteredConvIds - conversationsFilter :: PrepQuery R (Identity [ConvId]) (ConvId, Maybe TeamId, Maybe UserId) - conversationsFilter = "select conv, team, creator from conversation where conv in ?" - performUpdate convIds = retry x5 $ write conversationsUpdate (params LocalQuorum (Identity convIds)) - conversationsUpdate :: PrepQuery W (Identity [ConvId]) () - conversationsUpdate = "update conversation set deleted = true where conv in ?" + bimap extractConv extractConv $ + partition (\(_convId, _team, convType) -> convType == One2OneConv) $ + filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds + conversationsFilter :: PrepQuery R (Identity [ConvId]) (ConvId, Maybe TeamId, ConvType) + conversationsFilter = "select conv, team, type from conversation where conv in ?" + performConversationsRemoveUser convIds = retry x5 $ write conversationsRemoveUser (params LocalQuorum (uid, convIds)) + conversationsRemoveUser :: PrepQuery W (UserId, [ConvId]) () + conversationsRemoveUser = "delete from user where user = ? and conv in ?" From 0bc8ca521bad000d75130d27bf9124667866e608 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 14 Aug 2025 12:46:39 +0200 Subject: [PATCH 09/50] refactor: split team quitting and user deletion --- services/galley/galley.cabal | 2 - services/galley/src/Galley/API/Internal.hs | 48 ++++++++++++++++++---- 2 files changed, 41 insertions(+), 9 deletions(-) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 4d71b714f2..57ed69b986 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -150,8 +150,6 @@ library Galley.Cassandra.TeamNotifications Galley.Cassandra.Util Galley.ConversationsSubsystem - Galley.Data.Conversation - Galley.Data.Conversation.Types Galley.Data.Scope Galley.Data.TeamNotifications Galley.Data.Types diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 8d7099ab52..6ed7ec9bfe 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -348,13 +348,49 @@ rmUser :: Maybe ConnId -> Sem r () rmUser lusr conn = do - let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 tids <- listTeams (tUnqualified lusr) Nothing maxBound - leaveTeams tids - allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) - goConvPages nRange1000 allConvIds + let forTids page f = + for_ (pageItems page) $ \tid -> do + f tid + page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound + forTids page' f + leaveTeams lusr conn $ forTids tids deleteClients (tUnqualified lusr) + +leaveTeams :: + forall p1 r. + ( p1 ~ CassandraPaging, + Member BackendNotificationQueueAccess r, + Member ConversationStore r, + Member (Error DynError) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member ExternalAccess r, + Member NotificationSubsystem r, + Member (Input Env) r, + Member (Input Opts) r, + Member Now r, + Member (ListItems p1 ConvId) r, + Member (ListItems p1 (Remote ConvId)) r, + Member MemberStore r, + Member ProposalStore r, + Member P.TinyLog r, + Member Random r, + Member SubConversationStore r, + Member TeamFeatureStore r, + Member TeamStore r, + Member TeamCollaboratorsSubsystem r + ) => + Local UserId -> + Maybe ConnId -> + ((TeamId -> Sem r ()) -> Sem r ()) -> + Sem r () +leaveTeams lusr conn forTids = do + let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + forTids leaveTeams' + allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) + goConvPages nRange1000 allConvIds where goConvPages :: Range 1 1000 Int32 -> ConvIdsPage -> Sem r () goConvPages range page = do @@ -367,7 +403,7 @@ rmUser lusr conn = do newCids <- Query.conversationIdsPageFrom lusr nextQuery goConvPages range newCids - leaveTeams page = for_ (pageItems page) $ \tid -> do + leaveTeams' tid = do toNotify <- handleImpossibleErrors $ getFeatureForTeam @LimitedEventFanoutConfig tid @@ -377,8 +413,6 @@ rmUser lusr conn = do ) . (.status) uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - leaveTeams page' -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this -- point: the user is a team member because we fetched the list of teams From f449c50261794f705b2a8785b5b114309c257057 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 14 Aug 2025 19:15:18 +0200 Subject: [PATCH 10/50] rely on Galley --- .../src/Wire/API/Routes/Internal/Galley.hs | 7 ++ .../src/Wire/GalleyAPIAccess.hs | 5 ++ .../src/Wire/GalleyAPIAccess/Rpc.hs | 24 +++++++ .../src/Wire/TeamCollaboratorsStore.hs | 1 - .../Wire/TeamCollaboratorsStore/Postgres.hs | 25 ------- .../src/Wire/TeamCollaboratorsSubsystem.hs | 1 - .../TeamCollaboratorsSubsystem/Interpreter.hs | 69 +------------------ .../Wire/MockInterpreters/GalleyAPIAccess.hs | 1 + .../TeamCollaboratorsStore.hs | 2 - services/brig/src/Brig/Team/API.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 1 + 11 files changed, 40 insertions(+), 98 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 47741cedd8..53d905c016 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -252,6 +252,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) diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index 09fb702bc0..72f9ec506f 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -73,6 +73,11 @@ data GalleyAPIAccess m a where Maybe (UserId, UTCTimeMillis) -> Role -> GalleyAPIAccess m Bool + RemoveTeamMember :: + Local UserId -> + UserId -> + TeamId -> + GalleyAPIAccess m () CreateTeam :: UserId -> NewTeam -> diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 197504a5f2..68168f76b3 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -76,6 +76,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 @@ -283,6 +284,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, diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs index 55a0e4658d..5d7e7962e7 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs @@ -13,6 +13,5 @@ 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] - RemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsStore m () makeSem ''TeamCollaboratorsStore diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs index cb9b3b4180..af3114044e 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs @@ -38,7 +38,6 @@ interpretTeamCollaboratorsStoreToPostgres = GetTeamCollaborator teamId userId -> getTeamCollaboratorImpl teamId userId GetTeamCollaborations userId -> getTeamCollaborationsImpl userId GetTeamCollaboratorsWithIds teamIds userIds -> getTeamCollaboratorsWithIdsImpl teamIds userIds - RemoveTeamCollaborator userId teamId -> removeTeamCollaboratorImpl userId teamId getTeamCollaboratorImpl :: ( Member (Input Pool) r, @@ -125,30 +124,6 @@ getAllTeamCollaboratorsImpl teamId = do select user_id :: uuid, team_id :: uuid, permissions :: int2[] from collaborators where team_id = ($1 :: uuid) |] -removeTeamCollaboratorImpl :: - ( Member (Input Pool) r, - Member (Embed IO) r, - Member (Error UsageError) r - ) => - UserId -> - TeamId -> - Sem r () -removeTeamCollaboratorImpl userId teamId = do - pool <- input - eitherErrorOrUnit <- liftIO $ use pool session - either throw pure eitherErrorOrUnit - where - session :: Session () - session = statement (userId, teamId) deleteStatement - - deleteStatement :: Statement (UserId, TeamId) () - deleteStatement = - lmap - (bimap toUUID toUUID) - $ [resultlessStatement| - delete from collaborators where user_id = ($1 :: uuid) and team_id = ($2 :: uuid) - |] - toTeamCollaborator :: (UUID, UUID, Vector Int16) -> TeamCollaborator toTeamCollaborator ((Id -> gUser), (Id -> gTeam), (toPermissions -> gPermissions)) = TeamCollaborator {..} diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index d743eb654e..d7e7df2075 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -14,6 +14,5 @@ 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] - RemoveTeamCollaborator :: Local UserId -> UserId -> TeamId -> TeamCollaboratorsSubsystem m () makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 9162ea84a7..68cbe53d2f 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -12,7 +12,6 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator import Wire.API.Team.Member qualified as TeamMember -import Wire.ConversationsSubsystem (ConversationsSubsystem, internalCloseConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -26,8 +25,7 @@ interpretTeamCollaboratorsSubsystem :: Member (Error TeamCollaboratorsError) r, Member Store.TeamCollaboratorsStore r, Member Now r, - Member NotificationSubsystem r, - Member ConversationsSubsystem r + Member NotificationSubsystem r ) => InterpreterFor TeamCollaboratorsSubsystem r interpretTeamCollaboratorsSubsystem = interpret $ \case @@ -36,7 +34,6 @@ interpretTeamCollaboratorsSubsystem = interpret $ \case InternalGetTeamCollaborator team user -> internalGetTeamCollaboratorImpl team user InternalGetTeamCollaborations userId -> internalGetTeamCollaborationsImpl userId InternalGetTeamCollaboratorsWithIds teams userIds -> internalGetTeamCollaboratorsWithIdsImpl teams userIds - RemoveTeamCollaborator zUser user team -> removeTeamCollaboratorImpl zUser user team internalGetTeamCollaboratorImpl :: (Member Store.TeamCollaboratorsStore r) => @@ -84,7 +81,6 @@ getAllTeamCollaboratorsImpl zUser team = do guardPermission (tUnqualified zUser) team TeamMember.NewTeamCollaborator InsufficientRights Store.getAllTeamCollaborators team - internalGetTeamCollaboratorsWithIdsImpl :: ( Member Store.TeamCollaboratorsStore r ) => @@ -94,66 +90,3 @@ internalGetTeamCollaboratorsWithIdsImpl :: internalGetTeamCollaboratorsWithIdsImpl = do Store.getTeamCollaboratorsWithIds -removeTeamCollaboratorImpl :: - ( Member TeamSubsystem r, - Member (Error TeamCollaboratorsError) r, - Member Store.TeamCollaboratorsStore r, - Member Now r, - Member NotificationSubsystem r, - Member ConversationsSubsystem r - ) => - Local UserId -> - UserId -> - TeamId -> - Sem r () -removeTeamCollaboratorImpl zUser user team = do - guardPermission (tUnqualified zUser) team TeamMember.RemoveTeamCollaborator InsufficientRights - Store.removeTeamCollaborator user team - internalCloseConversationsFrom team user - - now <- get - let event = newEvent team now (EdCollaboratorRemove user) - teamMembersList <- internalGetTeamAdmins team - let teamMembers :: [UserId] = view TeamMember.userId <$> (teamMembersList ^. TeamMember.teamMembers) - -- TODO: Review the event's values - pushNotifications - [ def - { origin = Just (tUnqualified zUser), - json = toJSONObject $ event, - recipients = - ( \uid -> - Recipient - { recipientUserId = uid, - recipientClients = Push.RecipientClientsAll - } - ) - <$> teamMembers, - transient = False - } - ] - --- This is of general usefulness. However, we cannot move this to wire-api as --- this would lead to a cyclic dependency. -guardPermission :: - ( Member TeamSubsystem r, - Member (Error ex) r, - TeamMember.IsPerm TeamMember.TeamMember perm - ) => - UserId -> - TeamId -> - perm -> - ex -> - Sem r () -guardPermission user team perm ex = do - res <- - isJust <$> runMaybeT do - member <- MaybeT $ internalGetTeamMember user team - guard (member `TeamMember.hasPermission` perm) - unless res $ - throw ex - -teamCollaboratorsSubsystemErrorToHttpError :: TeamCollaboratorsError -> HttpError -teamCollaboratorsSubsystemErrorToHttpError = - StdError . \case - InsufficientRights -> errorToWai @E.InsufficientTeamPermissions - AlreadyExists -> errorToWai @E.DuplicateEntry diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index 630ead50e2..760c0232e4 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -27,6 +27,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case NewClient _ _ -> error "NewClient not implemented in miniGalleyAPIAccess" CheckUserCanJoinTeam _ -> pure Nothing AddTeamMember {} -> error "AddTeamMember not implemented in miniGalleyAPIAccess" + RemoveTeamMember {} -> error "RemoveTeamMember not implemented in miniGalleyAPIAccess" CreateTeam {} -> error "CreateTeam not implemented in miniGalleyAPIAccess" GetTeamMember uid tid -> pure $ getTeamMemberImpl teams uid tid GetTeamMembers tid maxResults -> pure $ getTeamMembersImpl teams tid maxResults diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs index fab46b025d..06ef6176bd 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs @@ -27,5 +27,3 @@ inMemoryTeamCollaboratorsStoreInterpreter = GetTeamCollaboratorsWithIds teamIds userIds -> gets $ \(s :: Map TeamId [TeamCollaborator]) -> concatMap (concatMap (filter (\tc -> tc.gUser `elem` userIds)) . (\(tid :: TeamId) -> Map.lookup tid s)) teamIds - RemoveTeamCollaborator userId teamId -> - modify $ Map.alter (fmap $ filter $ (/= userId) . gUser) teamId diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 01efc9e732..8938af09b3 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -114,7 +114,7 @@ servantAPI = :<|> Named @"get-team-size" (\uid tid -> lift . liftSem $ teamSizePublic uid tid) :<|> Named @"accept-team-invitation" (\luid req -> lift $ liftSem $ acceptTeamInvitation luid req.password req.code) :<|> Named @"add-team-collaborator" (\zuid tid (NewTeamCollaborator uid perms) -> lift . liftSem $ createTeamCollaborator zuid uid tid perms) - :<|> Named @"remove-team-collaborator" (\zuid tid uid -> lift . liftSem $ removeTeamCollaborator zuid uid tid) + :<|> Named @"remove-team-collaborator" (\zuid tid uid -> lift . liftSem $ GalleyAPIAccess.removeTeamMember zuid uid tid) :<|> Named @"get-team-collaborators" (\zuid tid -> lift . liftSem $ getAllTeamCollaborators zuid tid) teamSizePublic :: diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 6ed7ec9bfe..e93366ed4d 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -217,6 +217,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) <@> mkNamedAPI @"update-team-status" (Teams.updateTeamStatus tid) <@> hoistAPISegment ( mkNamedAPI @"unchecked-add-team-member" (Teams.uncheckedAddTeamMember tid) + <@> mkNamedAPI @"unchecked-remove-team-member" (\luid -> leaveTeams luid Nothing (for_ [tid])) <@> mkNamedAPI @"unchecked-get-team-members" (TeamSubsystem.internalGetTeamMembers tid) <@> mkNamedAPI @"unchecked-select-team-member-infos" (\userIds -> TeamSubsystem.internalSelectTeamMemberInfos tid (cUsers userIds)) <@> mkNamedAPI @"unchecked-get-team-member" (Teams.uncheckedGetTeamMember tid) From 120ca1b6bfd5010907b50703045bdc1bb5129ab8 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 15 Aug 2025 16:14:14 +0200 Subject: [PATCH 11/50] fix: restore team collaborator removal --- .../src/Wire/TeamCollaboratorsStore.hs | 1 + .../Wire/TeamCollaboratorsStore/Postgres.hs | 25 +++++++++++++++++++ .../src/Wire/TeamCollaboratorsSubsystem.hs | 1 + .../TeamCollaboratorsSubsystem/Interpreter.hs | 15 ++++++++++- .../TeamCollaboratorsStore.hs | 2 ++ services/galley/src/Galley/API/Internal.hs | 24 +++++++++--------- 6 files changed, 55 insertions(+), 13 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs index 5d7e7962e7..55a0e4658d 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore.hs @@ -13,5 +13,6 @@ 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] + RemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsStore m () makeSem ''TeamCollaboratorsStore diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs index af3114044e..cb9b3b4180 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsStore/Postgres.hs +++ b/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 + RemoveTeamCollaborator userId teamId -> removeTeamCollaboratorImpl userId teamId getTeamCollaboratorImpl :: ( Member (Input Pool) r, @@ -124,6 +125,30 @@ getAllTeamCollaboratorsImpl teamId = do select user_id :: uuid, team_id :: uuid, permissions :: int2[] from collaborators where team_id = ($1 :: uuid) |] +removeTeamCollaboratorImpl :: + ( Member (Input Pool) r, + Member (Embed IO) r, + Member (Error UsageError) r + ) => + UserId -> + TeamId -> + Sem r () +removeTeamCollaboratorImpl userId teamId = do + pool <- input + eitherErrorOrUnit <- liftIO $ use pool session + either throw pure eitherErrorOrUnit + where + session :: Session () + session = statement (userId, teamId) deleteStatement + + deleteStatement :: Statement (UserId, TeamId) () + deleteStatement = + lmap + (bimap toUUID toUUID) + $ [resultlessStatement| + delete from collaborators where user_id = ($1 :: uuid) and team_id = ($2 :: uuid) + |] + toTeamCollaborator :: (UUID, UUID, Vector Int16) -> TeamCollaborator toTeamCollaborator ((Id -> gUser), (Id -> gTeam), (toPermissions -> gPermissions)) = TeamCollaborator {..} diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index d7e7df2075..2e57f9729f 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -14,5 +14,6 @@ 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] + InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m () makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 68cbe53d2f..4893371b45 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -12,6 +12,7 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator import Wire.API.Team.Member qualified as TeamMember +import Wire.ConversationsSubsystem (ConversationsSubsystem, internalCloseConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -25,7 +26,8 @@ interpretTeamCollaboratorsSubsystem :: Member (Error TeamCollaboratorsError) r, Member Store.TeamCollaboratorsStore r, Member Now r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member ConversationsSubsystem r ) => InterpreterFor TeamCollaboratorsSubsystem r interpretTeamCollaboratorsSubsystem = interpret $ \case @@ -34,6 +36,7 @@ interpretTeamCollaboratorsSubsystem = interpret $ \case InternalGetTeamCollaborator team user -> internalGetTeamCollaboratorImpl team user InternalGetTeamCollaborations userId -> internalGetTeamCollaborationsImpl userId InternalGetTeamCollaboratorsWithIds teams userIds -> internalGetTeamCollaboratorsWithIdsImpl teams userIds + InternalRemoveTeamCollaborator user team -> internalRemoveTeamCollaboratorImpl user team internalGetTeamCollaboratorImpl :: (Member Store.TeamCollaboratorsStore r) => @@ -90,3 +93,13 @@ internalGetTeamCollaboratorsWithIdsImpl :: internalGetTeamCollaboratorsWithIdsImpl = do Store.getTeamCollaboratorsWithIds +internalRemoveTeamCollaboratorImpl :: + ( Member Store.TeamCollaboratorsStore r, + Member ConversationsSubsystem r + ) => + UserId -> + TeamId -> + Sem r () +internalRemoveTeamCollaboratorImpl user team = do + Store.removeTeamCollaborator user team + internalCloseConversationsFrom team user diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs index 06ef6176bd..fab46b025d 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/TeamCollaboratorsStore.hs @@ -27,3 +27,5 @@ inMemoryTeamCollaboratorsStoreInterpreter = GetTeamCollaboratorsWithIds teamIds userIds -> gets $ \(s :: Map TeamId [TeamCollaborator]) -> concatMap (concatMap (filter (\tc -> tc.gUser `elem` userIds)) . (\(tid :: TeamId) -> Map.lookup tid s)) teamIds + RemoveTeamCollaborator userId teamId -> + modify $ Map.alter (fmap $ filter $ (/= userId) . gUser) teamId diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index e93366ed4d..eb2f600bd5 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -389,7 +389,18 @@ leaveTeams :: Sem r () leaveTeams lusr conn forTids = do let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 - forTids leaveTeams' + forTids $ \tid -> do + toNotify <- + handleImpossibleErrors $ + getFeatureForTeam @LimitedEventFanoutConfig tid + >>= ( \case + FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid + FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid + ) + . (.status) + uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify + internalRemoveTeamCollaborator (tUnqualified lusr) tid + allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) goConvPages nRange1000 allConvIds where @@ -404,17 +415,6 @@ leaveTeams lusr conn forTids = do newCids <- Query.conversationIdsPageFrom lusr nextQuery goConvPages range newCids - leaveTeams' tid = do - toNotify <- - handleImpossibleErrors $ - getFeatureForTeam @LimitedEventFanoutConfig tid - >>= ( \case - FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid - FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid - ) - . (.status) - uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this -- point: the user is a team member because we fetched the list of teams -- they are member of, and conversely the list of teams was fetched exactly From 970e0548feaff64d62e2e22bdd82cab3a96340d4 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 19 Aug 2025 17:37:25 +0200 Subject: [PATCH 12/50] Update changelog.d/2-features/WPB-18190 Co-authored-by: Leif Battermann --- changelog.d/2-features/WPB-18190 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/2-features/WPB-18190 b/changelog.d/2-features/WPB-18190 index a8a8268b9f..98265f532d 100644 --- a/changelog.d/2-features/WPB-18190 +++ b/changelog.d/2-features/WPB-18190 @@ -1 +1 @@ -Allow member to be removed from a team. +Allow collaborator to be removed from a team. From 26aec51ac7cece910b857fb17378ae744a2b3ae5 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 19 Aug 2025 18:40:26 +0200 Subject: [PATCH 13/50] test: add multiple team & check get conv --- integration/test/Test/TeamCollaborators.hs | 23 ++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index a687a17e45..a65375bfb6 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -158,16 +158,19 @@ testImplicitConnectionNoCollaborator = do testRemoveMember :: (HasCallStack) => App () testRemoveMember = do - (owner, team, [alice]) <- createTeam OwnDomain 2 + (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. - bob <- randomUser OwnDomain def - addTeamCollaborator - owner - team - bob - ["implicit_connection"] - >>= assertSuccess - removeTeamCollaborator owner team bob >>= assertSuccess + 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 - postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "no-team-member" + getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" + postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" + postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess From 51c3b605bcaa89b8bc78cd58e5205e63f66d88d8 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 20 Aug 2025 10:50:12 +0200 Subject: [PATCH 14/50] fix: other connection test --- integration/test/Test/TeamCollaborators.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index a65375bfb6..4dc419e206 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -173,4 +173,4 @@ testRemoveMember = do getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" - postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess + getMLSOne2OneConversation charlie bob >>= assertSuccess From 7cdb9c722adc498b2e4f538be35389d830d13720 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 20 Aug 2025 16:39:09 +0200 Subject: [PATCH 15/50] test: add group conversation --- integration/test/Test/TeamCollaborators.hs | 24 ++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 4dc419e206..8ee42d4d1f 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -156,8 +156,8 @@ testImplicitConnectionNoCollaborator = do -- Alice and Bob aren't connected at all. postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" -testRemoveMember :: (HasCallStack) => App () -testRemoveMember = do +testRemoveMemberInO2O :: (HasCallStack) => App () +testRemoveMemberInO2O = do (owner0, team0, [alice]) <- createTeam OwnDomain 2 (owner1, team1, [bob]) <- createTeam OwnDomain 2 @@ -174,3 +174,23 @@ testRemoveMember = do getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" getMLSOne2OneConversation charlie bob >>= 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 From e6d1b3ecb63030a897403b4643e241355aadae1f Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 22 Aug 2025 17:57:12 +0200 Subject: [PATCH 16/50] fix: drop Cassandra IN search --- .../src/Galley/ConversationsSubsystem.hs | 24 ++++++++++++------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index a0a993ad07..c0cb3623f3 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -16,9 +16,9 @@ import Imports import Polysemy import Polysemy.Input import Polysemy.TinyLog (TinyLog) +import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) import Wire.ConversationsSubsystem -import Wire.Sem.Paging.Cassandra (InternalPage (InternalPage), mkInternalPage) interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, @@ -38,21 +38,27 @@ closeConversationsFromImpl tid uid = runConduit $ paginateWithStateC listConversationsIds .| mapMC performFilter - .| mapM_C (bimapM_ (mapM_ deleteConversation) performConversationsRemoveUser) + .| mapM_C (bimapM_ (mapM_ deleteConversation) (pooledMapConcurrentlyN_ 16 performConversationsRemoveUser)) where listConversationsIds pagingState = fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) performFilter :: [ConvId] -> Client ([ConvId], [ConvId]) performFilter convIds = do - page <- paginate conversationsFilter (params LocalQuorum (Identity convIds)) - InternalPage (_, _, filteredConvIds) <- mkInternalPage page pure + filteredConvIds <- + concat <$> pooledForConcurrentlyN 16 convIds performConversationsFilter let extractConv = map (\(convId, _team, _convType) -> convId) pure $ bimap extractConv extractConv $ partition (\(_convId, _team, convType) -> convType == One2OneConv) $ filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds - conversationsFilter :: PrepQuery R (Identity [ConvId]) (ConvId, Maybe TeamId, ConvType) - conversationsFilter = "select conv, team, type from conversation where conv in ?" - performConversationsRemoveUser convIds = retry x5 $ write conversationsRemoveUser (params LocalQuorum (uid, convIds)) - conversationsRemoveUser :: PrepQuery W (UserId, [ConvId]) () - conversationsRemoveUser = "delete from user where user = ? and conv in ?" + performConversationsFilter :: ConvId -> Client [(ConvId, Maybe TeamId, ConvType)] + performConversationsFilter convId = + retry x1 $ + query conversationsFilter $ + params LocalQuorum (Identity convId) + conversationsFilter :: PrepQuery R (Identity ConvId) (ConvId, Maybe TeamId, ConvType) + conversationsFilter = "select conv, team, type from conversation where conv = ?" + performConversationsRemoveUser convId = + retry x5 $ write conversationsRemoveUser (params LocalQuorum (uid, convId)) + conversationsRemoveUser :: PrepQuery W (UserId, ConvId) () + conversationsRemoveUser = "delete from user where user = ? and conv = ?" From 5f3bfbdb333bdc3c5fa19e284a69e413a3658454 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 27 Aug 2025 14:17:34 +0200 Subject: [PATCH 17/50] refactor: drop explicit queries --- .../src/Galley/ConversationsSubsystem.hs | 24 ++++++++++--------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index c0cb3623f3..39c0061379 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -9,6 +9,8 @@ import Conduit import Data.Bifoldable import Data.Id import Galley.Cassandra.Conversation (deleteConversation) +import Galley.Cassandra.Conversation.Members (removeMembersFromLocalConv) +import Galley.Cassandra.Queries (selectConv) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) import Galley.Cassandra.Util (logEffect) @@ -19,6 +21,7 @@ import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) import Wire.ConversationsSubsystem +import Wire.UserList (UserList (UserList)) interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, @@ -38,7 +41,7 @@ closeConversationsFromImpl tid uid = runConduit $ paginateWithStateC listConversationsIds .| mapMC performFilter - .| mapM_C (bimapM_ (mapM_ deleteConversation) (pooledMapConcurrentlyN_ 16 performConversationsRemoveUser)) + .| mapM_C (bimapM_ (mapM_ deleteConversation) (pooledMapConcurrentlyN_ 16 performConversationRemoveUser)) where listConversationsIds pagingState = fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) @@ -52,13 +55,12 @@ closeConversationsFromImpl tid uid = partition (\(_convId, _team, convType) -> convType == One2OneConv) $ filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds performConversationsFilter :: ConvId -> Client [(ConvId, Maybe TeamId, ConvType)] - performConversationsFilter convId = - retry x1 $ - query conversationsFilter $ - params LocalQuorum (Identity convId) - conversationsFilter :: PrepQuery R (Identity ConvId) (ConvId, Maybe TeamId, ConvType) - conversationsFilter = "select conv, team, type from conversation where conv = ?" - performConversationsRemoveUser convId = - retry x5 $ write conversationsRemoveUser (params LocalQuorum (uid, convId)) - conversationsRemoveUser :: PrepQuery W (UserId, ConvId) () - conversationsRemoveUser = "delete from user where user = ? and conv = ?" + performConversationsFilter convId = do + results <- retry x1 $ query selectConv $ params LocalQuorum (Identity convId) + pure $ + flip map results $ + \(convType, _mUserId, _mAccesses, _mRole, _mRoles, _mName, mTeam, _mDeleted, _mTimer, _mMode, _mProtocol, _mGroupId, _mEpoch, _mWriteEpoch, _mCiher, _mGroupConvType, _mChannelPerms, _mCellState) -> + (convId, mTeam, convType) + performConversationRemoveUser :: ConvId -> Client () + performConversationRemoveUser convId = + removeMembersFromLocalConv convId (UserList [uid] []) From 22221b62a8ddddd9e1f16a0d088fb681f02c6ff5 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 28 Aug 2025 18:20:53 +0200 Subject: [PATCH 18/50] feat: filter-out O2O connections --- integration/test/Test/TeamCollaborators.hs | 15 +++++++++++ services/galley/src/Galley/App.hs | 2 +- .../src/Galley/ConversationsSubsystem.hs | 27 ++++++++++++------- services/galley/src/Galley/Effects.hs | 2 +- 4 files changed, 35 insertions(+), 11 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 8ee42d4d1f..bd63b44f88 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -175,6 +175,21 @@ testRemoveMemberInO2O = do 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 diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index ced26d1541..d64f158492 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -310,12 +310,12 @@ evalGalley e = . interpretFederatorAccess . runRpcWithHttp (e ^. manager) (e ^. reqId) . runGundeckAPIAccess (e ^. options . gundeck) + . interpretBrigAccess (e ^. brig) . interpretConversationsSubsystemCassandra . interpretTeamSubsystem . runNotificationSubsystemGundeck (notificationSubsystemConfig e) . interpretTeamCollaboratorsSubsystem . interpretSparAccess - . interpretBrigAccess (e ^. brig) . interpretExternalAccess where lh = view (options . settings . featureFlags . to npProject) e diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index 39c0061379..ea5bed2482 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -9,7 +9,7 @@ import Conduit import Data.Bifoldable import Data.Id import Galley.Cassandra.Conversation (deleteConversation) -import Galley.Cassandra.Conversation.Members (removeMembersFromLocalConv) +import Galley.Cassandra.Conversation.Members (members, removeMembersFromLocalConv) import Galley.Cassandra.Queries (selectConv) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) @@ -20,12 +20,15 @@ import Polysemy.Input import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) +import Wire.BrigAPIAccess qualified as E import Wire.ConversationsSubsystem +import Wire.StoredConversation qualified import Wire.UserList (UserList (UserList)) interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, + Member E.BrigAPIAccess r, Member TinyLog r ) => InterpreterFor ConversationsSubsystem r @@ -34,10 +37,11 @@ interpretConversationsSubsystemCassandra = \case InternalCloseConversationsFrom tid uid -> do logEffect "ConversationsSubsystem.internalCloseConversationsFrom" - embedClient $ closeConversationsFromImpl tid uid + contacts <- E.getContactList uid + embedClient $ closeConversationsFromImpl tid uid contacts -closeConversationsFromImpl :: TeamId -> UserId -> Client () -closeConversationsFromImpl tid uid = +closeConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client () +closeConversationsFromImpl tid uid contacts = do runConduit $ paginateWithStateC listConversationsIds .| mapMC performFilter @@ -49,11 +53,16 @@ closeConversationsFromImpl tid uid = performFilter convIds = do filteredConvIds <- concat <$> pooledForConcurrentlyN 16 convIds performConversationsFilter - let extractConv = map (\(convId, _team, _convType) -> convId) - pure $ - bimap extractConv extractConv $ - partition (\(_convId, _team, convType) -> convType == One2OneConv) $ - filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds + let filteredTeamConvIds = filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds + extractConv = map (\(convId, _team, _convType) -> convId) + (o2os, mlss) = + bimap extractConv extractConv $ + partition (\(_convId, _team, convType) -> convType == One2OneConv) filteredTeamConvIds + isNotConnectedToMember convId = do + localMembers <- members convId + pure $ any (flip notElem (uid : contacts) . (.id_)) localMembers + o2osUnconnected <- filterM isNotConnectedToMember o2os + pure (o2osUnconnected, mlss) performConversationsFilter :: ConvId -> Client [(ConvId, Maybe TeamId, ConvType)] performConversationsFilter convId = do results <- retry x1 $ query selectConv $ params LocalQuorum (Identity convId) diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 7643e081e5..cf985eab37 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -107,12 +107,12 @@ import Wire.TeamSubsystem (TeamSubsystem) -- All the possible high-level effects. type GalleyEffects1 = '[ ExternalAccess, - BrigAPIAccess, SparAccess, TeamCollaboratorsSubsystem, NotificationSubsystem, TeamSubsystem, ConversationsSubsystem, + BrigAPIAccess, GundeckAPIAccess, Rpc, FederatorAccess, From 9b28702dff2af139edc7ac710d6a693b189a31f8 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 28 Aug 2025 20:06:31 +0200 Subject: [PATCH 19/50] fix: rebase --- .../src/Wire/ConversationStore/Cassandra.hs | 1 + services/galley/src/Galley/ConversationsSubsystem.hs | 11 +++++------ services/galley/src/Galley/Effects.hs | 1 + 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs index 63a429ba41..a4c0244e29 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs @@ -17,6 +17,7 @@ module Wire.ConversationStore.Cassandra ( interpretConversationStoreToCassandra, + deleteConversation, ) where diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index ea5bed2482..580c464137 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -8,10 +8,6 @@ import Cassandra.Exec import Conduit import Data.Bifoldable import Data.Id -import Galley.Cassandra.Conversation (deleteConversation) -import Galley.Cassandra.Conversation.Members (members, removeMembersFromLocalConv) -import Galley.Cassandra.Queries (selectConv) -import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) import Galley.Cassandra.Util (logEffect) import Imports @@ -21,7 +17,10 @@ import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) import Wire.BrigAPIAccess qualified as E +import Wire.ConversationStore.Cassandra (deleteConversation) +import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) import Wire.ConversationsSubsystem +import Wire.MemberStore.Cassandra (members, removeMembersFromLocalConv) import Wire.StoredConversation qualified import Wire.UserList (UserList (UserList)) @@ -48,7 +47,7 @@ closeConversationsFromImpl tid uid contacts = do .| mapM_C (bimapM_ (mapM_ deleteConversation) (pooledMapConcurrentlyN_ 16 performConversationRemoveUser)) where listConversationsIds pagingState = - fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) + fmap runIdentity <$> paginateWithState selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) performFilter :: [ConvId] -> Client ([ConvId], [ConvId]) performFilter convIds = do filteredConvIds <- @@ -68,7 +67,7 @@ closeConversationsFromImpl tid uid contacts = do results <- retry x1 $ query selectConv $ params LocalQuorum (Identity convId) pure $ flip map results $ - \(convType, _mUserId, _mAccesses, _mRole, _mRoles, _mName, mTeam, _mDeleted, _mTimer, _mMode, _mProtocol, _mGroupId, _mEpoch, _mWriteEpoch, _mCiher, _mGroupConvType, _mChannelPerms, _mCellState) -> + \(convType, _mUserId, _mAccesses, _mRole, _mRoles, _mName, mTeam, _mDeleted, _mTimer, _mMode, _mProtocol, _mGroupId, _mEpoch, _mWriteEpoch, _mCiher, _mGroupConvType, _mChannelPerms, _mCellState, _mParentConvId) -> (convId, mTeam, convType) performConversationRemoveUser :: ConvId -> Client () performConversationRemoveUser convId = diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index cf985eab37..847f02e42b 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -90,6 +90,7 @@ import Polysemy.TinyLog import Wire.API.Error import Wire.API.Team.Feature import Wire.BrigAPIAccess +import Wire.ConversationStore import Wire.ConversationsSubsystem (ConversationsSubsystem) import Wire.GundeckAPIAccess import Wire.HashPassword From 55cbe593bc95f3c4fe3ebf17f12704b4432cb6e8 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 28 Aug 2025 23:24:40 +0200 Subject: [PATCH 20/50] fix: missing parts --- .../TeamCollaboratorsSubsystem/Interpreter.hs | 26 +++++++++++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 4 +-- services/galley/src/Galley/API/Internal.hs | 2 +- services/galley/src/Galley/App.hs | 1 + 4 files changed, 30 insertions(+), 3 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 4893371b45..10ab570bdc 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -103,3 +103,29 @@ internalRemoveTeamCollaboratorImpl :: internalRemoveTeamCollaboratorImpl user team = do Store.removeTeamCollaborator user team internalCloseConversationsFrom team user + +-- This is of general usefulness. However, we cannot move this to wire-api as +-- this would lead to a cyclic dependency. +guardPermission :: + ( Member TeamSubsystem r, + Member (Error ex) r, + TeamMember.IsPerm TeamMember.TeamMember perm + ) => + UserId -> + TeamId -> + perm -> + ex -> + Sem r () +guardPermission user team perm ex = do + res <- + isJust <$> runMaybeT do + member <- MaybeT $ internalGetTeamMember user team + guard (member `TeamMember.hasPermission` perm) + unless res $ + throw ex + +teamCollaboratorsSubsystemErrorToHttpError :: TeamCollaboratorsError -> HttpError +teamCollaboratorsSubsystemErrorToHttpError = + StdError . \case + InsufficientRights -> errorToWai @E.InsufficientTeamPermissions + AlreadyExists -> errorToWai @E.DuplicateEntry diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 5910e4ed6b..0df2cf3521 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -186,13 +186,13 @@ library Wire.BlockListStore.Cassandra Wire.BrigAPIAccess Wire.BrigAPIAccess.Rpc + Wire.ConversationsSubsystem + Wire.ConversationsSubsystem.GalleyAPI Wire.ConversationStore Wire.ConversationStore.Cassandra Wire.ConversationStore.Cassandra.Instances Wire.ConversationStore.Cassandra.Queries Wire.ConversationStore.MLS.Types - Wire.ConversationsSubsystem - Wire.ConversationsSubsystem.GalleyAPI Wire.DeleteQueue Wire.DeleteQueue.InMemory Wire.DomainRegistrationStore diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index eb2f600bd5..ef814efb89 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -94,8 +94,8 @@ import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client import Wire.ConversationStore -import Wire.ConversationStore qualified as E import Wire.ConversationsSubsystem qualified as ConversationsSubsystem +import Wire.ConversationStore qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index d64f158492..dda3fdf348 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -108,6 +108,7 @@ import Wire.API.Federation.Error import Wire.API.Team.Collaborator import Wire.API.Team.Feature import Wire.BrigAPIAccess.Rpc +import Wire.ConversationStore.Cassandra (interpretConversationStoreToCassandra) import Wire.Error import Wire.GundeckAPIAccess (runGundeckAPIAccess) import Wire.HashPassword.Interpreter From b3e2b60ee7fc28eb0b6f6b8abaf10f4439b4b303 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 29 Aug 2025 10:32:46 +0000 Subject: [PATCH 21/50] wip extend tests --- integration/test/Test/TeamCollaborators.hs | 38 +++++++++++++++++++--- 1 file changed, 33 insertions(+), 5 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index bd63b44f88..fd0f669796 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -3,6 +3,7 @@ module Test.TeamCollaborators where import API.Brig import API.Galley import Data.Tuple.Extra +import API.GalleyInternal qualified as Internal import Notifications (isTeamCollaboratorAddedNotif) import SetupHelpers import Testlib.Prelude @@ -168,10 +169,12 @@ testRemoveMemberInO2O = do postOne2OneConversation charlie alice team0 "chit-chat" >>= assertSuccess postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess + -- also verify via internal API that the conversation exists removeTeamCollaborator owner0 team0 charlie >>= assertSuccess getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" + -- check internal API that conversation does not extist postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" getMLSOne2OneConversation charlie bob >>= assertSuccess @@ -181,10 +184,11 @@ testRemoveMemberInO2OConnected = do -- At the time of writing, it wasn't clear if this should be a bot instead. bob <- randomUser OwnDomain def + connectTwoUsers alice bob + addTeamCollaborator owner0 team0 bob ["implicit_connection"] >>= assertSuccess postOne2OneConversation bob alice team0 "chit-chat" >>= assertSuccess - connectTwoUsers alice bob removeTeamCollaborator owner0 team0 bob >>= assertSuccess @@ -192,20 +196,44 @@ testRemoveMemberInO2OConnected = do testRemoveMemberInTeamConversation :: (HasCallStack) => App () testRemoveMemberInTeamConversation = do - (owner, team, [alice, bob]) <- createTeam OwnDomain 3 + (owner, team, [alice, alex, alan]) <- createTeam OwnDomain 4 - aliceId <- alice %. "qualified_id" - bobId <- bob %. "qualified_id" + bob <- randomUser OwnDomain def + + connectTwoUsers bob alex + connectTwoUsers bob alan + nonTeamConv <- + postConversation + alex + defProteus {qualifiedUsers = [alan, bob]} + >>= getJSON 201 + getConversation bob nonTeamConv >>= assertSuccess + + addTeamCollaborator owner team bob ["implicit_connection"] >>= assertSuccess conv <- postConversation owner - defProteus {team = Just team, skipCreator = Just True, qualifiedUsers = [aliceId, bobId]} + defProteus {team = Just team, qualifiedUsers = [alice, bob]} >>= getJSON 201 + -- check that admins/owners get events: member removed from conversations, and team member removed removeTeamCollaborator owner team bob >>= assertSuccess getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 + -- check bob is not a member + pure () getConversation bob conv `bindResponse` \resp -> do + -- should be 404 resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "not-connected" + + Internal.getConversation conv `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + -- check bob is not a member + members <- resp.json %. "members" >>= asList + pure () + + -- non team conv still exists + getConversation bob nonTeamConv >>= assertSuccess From 0e4ba6a17504013d538ad8abe2b6a1eba1f2e9e5 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 1 Sep 2025 10:24:24 +0200 Subject: [PATCH 22/50] Revert "wip extend tests" This reverts commit ed93ec6a5f590a8136058da977bd0841299d2dee. --- integration/test/Test/TeamCollaborators.hs | 38 +++------------------- 1 file changed, 5 insertions(+), 33 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index fd0f669796..bd63b44f88 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -3,7 +3,6 @@ module Test.TeamCollaborators where import API.Brig import API.Galley import Data.Tuple.Extra -import API.GalleyInternal qualified as Internal import Notifications (isTeamCollaboratorAddedNotif) import SetupHelpers import Testlib.Prelude @@ -169,12 +168,10 @@ testRemoveMemberInO2O = do postOne2OneConversation charlie alice team0 "chit-chat" >>= assertSuccess postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess - -- also verify via internal API that the conversation exists removeTeamCollaborator owner0 team0 charlie >>= assertSuccess getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" - -- check internal API that conversation does not extist postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" getMLSOne2OneConversation charlie bob >>= assertSuccess @@ -184,11 +181,10 @@ testRemoveMemberInO2OConnected = do -- At the time of writing, it wasn't clear if this should be a bot instead. bob <- randomUser OwnDomain def - connectTwoUsers alice bob - addTeamCollaborator owner0 team0 bob ["implicit_connection"] >>= assertSuccess postOne2OneConversation bob alice team0 "chit-chat" >>= assertSuccess + connectTwoUsers alice bob removeTeamCollaborator owner0 team0 bob >>= assertSuccess @@ -196,44 +192,20 @@ testRemoveMemberInO2OConnected = do testRemoveMemberInTeamConversation :: (HasCallStack) => App () testRemoveMemberInTeamConversation = do - (owner, team, [alice, alex, alan]) <- createTeam OwnDomain 4 + (owner, team, [alice, bob]) <- createTeam OwnDomain 3 - bob <- randomUser OwnDomain def - - connectTwoUsers bob alex - connectTwoUsers bob alan - nonTeamConv <- - postConversation - alex - defProteus {qualifiedUsers = [alan, bob]} - >>= getJSON 201 - getConversation bob nonTeamConv >>= assertSuccess - - addTeamCollaborator owner team bob ["implicit_connection"] >>= assertSuccess + aliceId <- alice %. "qualified_id" + bobId <- bob %. "qualified_id" conv <- postConversation owner - defProteus {team = Just team, qualifiedUsers = [alice, bob]} + defProteus {team = Just team, skipCreator = Just True, qualifiedUsers = [aliceId, bobId]} >>= getJSON 201 - -- check that admins/owners get events: member removed from conversations, and team member removed removeTeamCollaborator owner team bob >>= assertSuccess getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 - -- check bob is not a member - pure () getConversation bob conv `bindResponse` \resp -> do - -- should be 404 resp.status `shouldMatchInt` 403 - resp.json %. "label" `shouldMatch` "not-connected" - - Internal.getConversation conv `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - -- check bob is not a member - members <- resp.json %. "members" >>= asList - pure () - - -- non team conv still exists - getConversation bob nonTeamConv >>= assertSuccess From bff2966f2ae6f5cd66a901874b76c23ccc96a7e3 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 1 Sep 2025 19:46:01 +0200 Subject: [PATCH 23/50] fix: tests and correct conversation removal --- integration/test/Test/TeamCollaborators.hs | 40 ++++++++++++++++++---- services/galley/src/Galley/API/Internal.hs | 2 +- 2 files changed, 34 insertions(+), 8 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index bd63b44f88..a70e7548c9 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -2,8 +2,9 @@ module Test.TeamCollaborators where import API.Brig import API.Galley +import qualified API.GalleyInternal as Internal import Data.Tuple.Extra -import Notifications (isTeamCollaboratorAddedNotif) +import Notifications (isTeamCollaboratorAddedNotif, isTeamMemberLeaveNotif) import SetupHelpers import Testlib.Prelude @@ -166,13 +167,18 @@ testRemoveMemberInO2O = do addTeamCollaborator owner0 team0 charlie ["implicit_connection"] >>= assertSuccess addTeamCollaborator owner1 team1 charlie ["implicit_connection"] >>= assertSuccess - postOne2OneConversation charlie alice team0 "chit-chat" >>= assertSuccess + convId <- + postOne2OneConversation charlie alice team0 "chit-chat" `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "qualified_id" postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess + Internal.getConversation convId >>= assertSuccess removeTeamCollaborator owner0 team0 charlie >>= assertSuccess getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" + Internal.getConversation convId >>= assertLabel 404 "no-conversation" getMLSOne2OneConversation charlie bob >>= assertSuccess testRemoveMemberInO2OConnected :: (HasCallStack) => App () @@ -181,10 +187,11 @@ testRemoveMemberInO2OConnected = do -- At the time of writing, it wasn't clear if this should be a bot instead. bob <- randomUser OwnDomain def + connectTwoUsers alice bob + addTeamCollaborator owner0 team0 bob ["implicit_connection"] >>= assertSuccess postOne2OneConversation bob alice team0 "chit-chat" >>= assertSuccess - connectTwoUsers alice bob removeTeamCollaborator owner0 team0 bob >>= assertSuccess @@ -194,18 +201,37 @@ 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]} + defProteus {team = Just team, qualifiedUsers = [alice, bob]} >>= getJSON 201 - removeTeamCollaborator owner team bob >>= assertSuccess + withWebSockets [owner, alice] $ \[wsOwner, wsAlice] -> do + removeTeamCollaborator owner team bob >>= assertSuccess + + bobId <- bob %. "qualified_id" + bobUnqualifiedId <- bobId %. "id" + let checkEvent :: (MakesValue a) => a -> App () + checkEvent evt = do + evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId + evt %. "payload.0.team" `shouldMatch` team + evt %. "transient" `shouldMatch` True + + awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkEvent + assertNoEvent 0 wsAlice getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 + otherMember <- assertOne =<< asList (resp.json %. "members.others") + otherMember %. "qualified_id" `shouldNotMatch` (bob %. "qualified_id") getConversation bob conv `bindResponse` \resp -> do + -- should be 404 resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "access-denied" + + Internal.getConversation conv `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + otherMembers <- asList (resp.json %. "members.others") + traverse (%. "qualified_id") otherMembers `shouldMatchSet` traverse (%. "qualified_id") [owner, alice] diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index ef814efb89..b8f09ed92a 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -398,8 +398,8 @@ leaveTeams lusr conn forTids = do FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid ) . (.status) - uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify internalRemoveTeamCollaborator (tUnqualified lusr) tid + uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) goConvPages nRange1000 allConvIds From c572f53f05cb950d267fa7d0575251f0ef1fc862 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 1 Sep 2025 20:49:29 +0200 Subject: [PATCH 24/50] fix: rebase --- libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs | 2 ++ services/galley/src/Galley/API/Internal.hs | 4 +--- services/galley/src/Galley/ConversationsSubsystem.hs | 3 +-- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs index a4c0244e29..8e62014dc7 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs @@ -18,6 +18,8 @@ module Wire.ConversationStore.Cassandra ( interpretConversationStoreToCassandra, deleteConversation, + members, + removeMembersFromLocalConv, ) where diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b8f09ed92a..ff19bc00ff 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -94,8 +94,8 @@ import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client import Wire.ConversationStore -import Wire.ConversationsSubsystem qualified as ConversationsSubsystem import Wire.ConversationStore qualified as E +import Wire.ConversationsSubsystem qualified as ConversationsSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now @@ -374,11 +374,9 @@ leaveTeams :: Member Now r, Member (ListItems p1 ConvId) r, Member (ListItems p1 (Remote ConvId)) r, - Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, Member Random r, - Member SubConversationStore r, Member TeamFeatureStore r, Member TeamStore r, Member TeamCollaboratorsSubsystem r diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index 580c464137..f5342785ca 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -17,10 +17,9 @@ import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) import Wire.BrigAPIAccess qualified as E -import Wire.ConversationStore.Cassandra (deleteConversation) +import Wire.ConversationStore.Cassandra (deleteConversation, members, removeMembersFromLocalConv) import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) import Wire.ConversationsSubsystem -import Wire.MemberStore.Cassandra (members, removeMembersFromLocalConv) import Wire.StoredConversation qualified import Wire.UserList (UserList (UserList)) From c2178012e893771636f63053ad13f2387f904768 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 3 Sep 2025 13:52:41 +0200 Subject: [PATCH 25/50] fix: pass around changes to trigger notifications --- .../src/Wire/API/Routes/Internal/Galley.hs | 7 +-- .../src/Wire/API/Team/Conversation.hs | 27 ++++++++++ .../src/Wire/ConversationsSubsystem.hs | 3 +- .../Wire/ConversationsSubsystem/GalleyAPI.hs | 2 +- .../src/Wire/GalleyAPIAccess.hs | 3 +- .../src/Wire/GalleyAPIAccess/Rpc.hs | 18 ++++--- .../src/Wire/TeamCollaboratorsSubsystem.hs | 3 +- .../TeamCollaboratorsSubsystem/Interpreter.hs | 7 +-- .../test/unit/Wire/MiniBackend.hs | 3 +- .../Wire/MockInterpreters/GalleyAPIAccess.hs | 3 +- services/galley/src/Galley/API/Internal.hs | 52 +++++++++++-------- .../src/Galley/ConversationsSubsystem.hs | 23 ++++---- 12 files changed, 100 insertions(+), 51 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 53d905c016..a68e47b64b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -50,6 +50,7 @@ import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version import Wire.API.Team +import Wire.API.Team.Conversation (LeftConversations) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info @@ -323,10 +324,10 @@ type ITeamsAPIBase = ) ) :<|> Named - "close-conversations-from" - ( "close-conversations-from" + "leave-conversations-from" + ( "leave-conversations-from" :> Capture "uid" UserId - :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "OK") + :> Post '[JSON] LeftConversations ) type IFeatureStatusGet cfg = diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index d3b240d9f5..214b3e9996 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -29,6 +29,10 @@ module Wire.API.Team.Conversation TeamConversationList, newTeamConversationList, teamConversations, + + -- * LeftConversations + LeftConversations (..), + newLeftConversations, ) where @@ -95,3 +99,26 @@ newTeamConversationList :: [TeamConversation] -> TeamConversationList newTeamConversationList = TeamConversationList makeLenses ''TeamConversation + +-------------------------------------------------------------------------------- +-- LeftConversations + +data LeftConversations = LeftConversations {left :: [ConvId], closed :: [ConvId]} + deriving (Generic) + deriving stock (Eq, Show) + deriving (Arbitrary) via (GenericUniform LeftConversations) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema LeftConversations) + +instance ToSchema LeftConversations where + schema = + objectWithDocModifier + "LeftConversations" + (description ?~ "Conversations left or closed") + $ LeftConversations + <$> left .= field "left" (array schema) + <*> closed .= field "closed" (array schema) + +newLeftConversations :: [ConvId] -> [ConvId] -> LeftConversations +newLeftConversations = LeftConversations + +makeLenses ''LeftConversations diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs index 561c7cf6eb..ab0048f2f5 100644 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs @@ -4,8 +4,9 @@ module Wire.ConversationsSubsystem where import Data.Id import Polysemy +import Wire.API.Team.Conversation (LeftConversations) data ConversationsSubsystem m a where - InternalCloseConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m () + InternalLeaveConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m LeftConversations makeSem ''ConversationsSubsystem diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs index ef73a66e7d..bc0339c85a 100644 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs +++ b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs @@ -13,4 +13,4 @@ interpretConversationsSubsystemToGalleyAPI :: (Member GalleyAPIAccess r) => Inte interpretConversationsSubsystemToGalleyAPI = interpret $ \case - InternalCloseConversationsFrom tid uid -> GalleyAPIAccess.closeConversationsFrom tid uid + InternalLeaveConversationsFrom tid uid -> GalleyAPIAccess.leaveConversationsFrom tid uid diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index 72f9ec506f..274a661414 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -30,6 +30,7 @@ import Wire.API.Conversation import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Team +import Wire.API.Team.Conversation (LeftConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -149,6 +150,6 @@ data GalleyAPIAccess m a where UserId -> GalleyAPIAccess m [EJPDConvInfo] GetTeamAdmins :: TeamId -> GalleyAPIAccess m Team.TeamMemberList - CloseConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m () + LeaveConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m LeftConversations makeSem ''GalleyAPIAccess diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 68168f76b3..9a840ff2d5 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -45,6 +45,7 @@ import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Version import Wire.API.Team +import Wire.API.Team.Conversation (LeftConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -97,7 +98,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 + LeaveConversationsFrom tid uid -> leaveConversationsFrom tid uid getUserLegalholdStatus :: ( Member TinyLog r, @@ -707,20 +708,21 @@ getEJPDConvInfo uid = do . paths ["i", "user", toByteString' uid, "all-conversations"] -- | Calls 'Galley.API.updateTeamStatusH'. -closeConversationsFrom :: - ( Member Rpc r, +leaveConversationsFrom :: + ( Member (Error ParseException) r, + 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 + Sem r LeftConversations +leaveConversationsFrom tid uid = do + debug $ remote "galley" . msg (val "Leave all conversations of a user in a team") + decodeBodyOrThrow "galley" =<< galleyRequest req where req = method POST - . paths ["i", "teams", toByteString' tid, "close-conversations-from", toByteString' uid] + . paths ["i", "teams", toByteString' tid, "leave-conversations-from", toByteString' uid] . header "Content-Type" "application/json" . expect2xx diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index 2e57f9729f..6624b6b384 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -7,6 +7,7 @@ import Data.Qualified import Imports import Polysemy import Wire.API.Team.Collaborator +import Wire.API.Team.Conversation (LeftConversations) data TeamCollaboratorsSubsystem m a where CreateTeamCollaborator :: Local UserId -> UserId -> TeamId -> Set CollaboratorPermission -> TeamCollaboratorsSubsystem m () @@ -14,6 +15,6 @@ 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] - InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m () + InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m LeftConversations makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 10ab570bdc..d3e704e35c 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -11,8 +11,9 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator +import Wire.API.Team.Conversation (LeftConversations) import Wire.API.Team.Member qualified as TeamMember -import Wire.ConversationsSubsystem (ConversationsSubsystem, internalCloseConversationsFrom) +import Wire.ConversationsSubsystem (ConversationsSubsystem, internalLeaveConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -99,10 +100,10 @@ internalRemoveTeamCollaboratorImpl :: ) => UserId -> TeamId -> - Sem r () + Sem r LeftConversations internalRemoveTeamCollaboratorImpl user team = do Store.removeTeamCollaborator user team - internalCloseConversationsFrom team user + internalLeaveConversationsFrom team user -- This is of general usefulness. However, we cannot move this to wire-api as -- this would lead to a cyclic dependency. diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index cdb15aea22..aa91cae03a 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -64,6 +64,7 @@ import Wire.API.Federation.API import Wire.API.Federation.Component import Wire.API.Federation.Error import Wire.API.Team.Collaborator +import Wire.API.Team.Conversation (LeftConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member hiding (userId) import Wire.API.User as User hiding (DeleteUser) @@ -638,7 +639,7 @@ interpretMaybeFederationStackState mb = interpretConversationsSubsystem = interpret $ \case - InternalCloseConversationsFrom _tid _uid -> pure () + InternalLeaveConversationsFrom _tid _uid -> pure $ LeftConversations {left = [], closed = []} in miniBackendLowerEffectsInterpreters mb . interpretConversationsSubsystem . interpretTeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index 760c0232e4..40277e65c0 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -7,6 +7,7 @@ import Data.Proxy import Data.Range import Imports import Polysemy +import Wire.API.Team.Conversation (LeftConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info (TeamMemberInfoList (..)) @@ -50,7 +51,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case GetEJPDConvInfo _ -> error "GetEJPDConvInfo not implemented in miniGalleyAPIAccess" GetTeamAdmins tid -> pure $ newTeamMemberList (maybe [] (filter (\tm -> isAdminOrOwner (tm ^. permissions))) $ Map.lookup tid teams) ListComplete SelectTeamMemberInfos tid uids -> pure $ selectTeamMemberInfosImpl teams tid uids - CloseConversationsFrom _ _ -> pure () + LeaveConversationsFrom _tid _uid -> pure $ LeftConversations {left = [], closed = []} -- this is called but the result is not needed in unit tests selectTeamMemberInfosImpl :: Map TeamId [TeamMember] -> TeamId -> [UserId] -> TeamMemberInfoList diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index ff19bc00ff..2d1d4e7dba 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -90,6 +90,7 @@ import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiTablePaging qualified as MTP +import Wire.API.Team.Conversation (LeftConversations (..)) import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client @@ -230,7 +231,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) ( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid) <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid) ) - <@> mkNamedAPI @"close-conversations-from" (ConversationsSubsystem.internalCloseConversationsFrom tid) + <@> mkNamedAPI @"leave-conversations-from" (ConversationsSubsystem.internalLeaveConversationsFrom tid) miscAPI :: API IMiscAPI GalleyEffects miscAPI = @@ -396,9 +397,14 @@ leaveTeams lusr conn forTids = do FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid ) . (.status) - internalRemoveTeamCollaborator (tUnqualified lusr) tid + leftConversations <- internalRemoveTeamCollaborator (tUnqualified lusr) tid uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify + let qUser = tUntagged lusr + now <- Now.get + convs <- getConversations leftConversations.left + pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs + allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) goConvPages nRange1000 allConvIds where @@ -444,29 +450,33 @@ leaveTeams lusr conn forTids = do Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) Right _ -> pure () E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) - let e = - Event - { evtConv = tUntagged (qualifyAs lusr c.id_), - evtSubConv = Nothing, - evtFrom = tUntagged lusr, - evtTime = now, - evtTeam = Nothing, - evtData = EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser]) - } - for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c - pure . Just $ - def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = map localMemberToRecipient c.localMembers, - isCellsEvent = shouldPushToCells c.metadata e, - conn, - route = PushV2.RouteDirect - } + Just <$> notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c | otherwise -> pure Nothing pushNotifications (catMaybes pp) + notifyRemoteMembersAndPrepareLocalMembersLeft :: UTCTime -> Qualified UserId -> StoredConversation -> Sem r Push + notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c = do + let e = + Event + { evtConv = tUntagged (qualifyAs lusr c.id_), + evtSubConv = Nothing, + evtFrom = tUntagged lusr, + evtTime = now, + evtTeam = Nothing, + evtData = EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser]) + } + for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c + pure $ + def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = map localMemberToRecipient c.localMembers, + isCellsEvent = shouldPushToCells c.metadata e, + conn, + route = PushV2.RouteDirect + } + -- FUTUREWORK: This could be optimized to reduce the number of RPCs -- made. When a team is deleted the burst of RPCs created here could -- lead to performance issues. We should cover this in a performance diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index f5342785ca..0fb6891d3a 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -16,6 +16,7 @@ import Polysemy.Input import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) +import Wire.API.Team.Conversation (LeftConversations, newLeftConversations) import Wire.BrigAPIAccess qualified as E import Wire.ConversationStore.Cassandra (deleteConversation, members, removeMembersFromLocalConv) import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) @@ -33,17 +34,19 @@ interpretConversationsSubsystemCassandra :: interpretConversationsSubsystemCassandra = interpret $ \case - InternalCloseConversationsFrom tid uid -> do - logEffect "ConversationsSubsystem.internalCloseConversationsFrom" + InternalLeaveConversationsFrom tid uid -> do + logEffect "ConversationsSubsystem.internalLeaveConversationsFrom" contacts <- E.getContactList uid - embedClient $ closeConversationsFromImpl tid uid contacts + embedClient $ leaveConversationsFromImpl tid uid contacts -closeConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client () -closeConversationsFromImpl tid uid contacts = do - runConduit $ - paginateWithStateC listConversationsIds - .| mapMC performFilter - .| mapM_C (bimapM_ (mapM_ deleteConversation) (pooledMapConcurrentlyN_ 16 performConversationRemoveUser)) +leaveConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client LeftConversations +leaveConversationsFromImpl tid uid contacts = + fmap (uncurry newLeftConversations) $ + runConduit $ + paginateWithStateC listConversationsIds + .| mapMC performFilter + .| iterMC (bimapM_ (pooledMapConcurrentlyN_ 16 performConversationRemoveUser) (mapM_ deleteConversation)) + .| foldC where listConversationsIds pagingState = fmap runIdentity <$> paginateWithState selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) @@ -60,7 +63,7 @@ closeConversationsFromImpl tid uid contacts = do localMembers <- members convId pure $ any (flip notElem (uid : contacts) . (.id_)) localMembers o2osUnconnected <- filterM isNotConnectedToMember o2os - pure (o2osUnconnected, mlss) + pure (mlss, o2osUnconnected) performConversationsFilter :: ConvId -> Client [(ConvId, Maybe TeamId, ConvType)] performConversationsFilter convId = do results <- retry x1 $ query selectConv $ params LocalQuorum (Identity convId) From 869c0aba1a84b28ba57379e5937f7c73e6a9cc12 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 3 Sep 2025 17:06:26 +0200 Subject: [PATCH 26/50] fix: add tests assertions HasCallStack --- integration/test/Notifications.hs | 62 +++++++++++++++---------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 62d845cfe4..65812df202 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -106,47 +106,47 @@ awaitNotification user lastNotifId selector = do since0 <- mapM objId lastNotifId head <$> awaitNotifications user (Nothing :: Maybe ()) since0 1 selector -isDeleteUserNotif :: (MakesValue a) => a -> App Bool +isDeleteUserNotif :: (HasCallStack, MakesValue a) => a -> App Bool isDeleteUserNotif n = nPayload n %. "type" `isEqual` "user.delete" -isFeatureConfigUpdateNotif :: (MakesValue a) => a -> App Bool +isFeatureConfigUpdateNotif :: (HasCallStack, MakesValue a) => a -> App Bool isFeatureConfigUpdateNotif n = nPayload n %. "type" `isEqual` "feature-config.update" -isNewMessageNotif :: (MakesValue a) => a -> App Bool +isNewMessageNotif :: (HasCallStack, MakesValue a) => a -> App Bool isNewMessageNotif n = fieldEquals n "payload.0.type" "conversation.otr-message-add" -isNewMLSMessageNotif :: (MakesValue a) => a -> App Bool +isNewMLSMessageNotif :: (HasCallStack, MakesValue a) => a -> App Bool isNewMLSMessageNotif n = fieldEquals n "payload.0.type" "conversation.mls-message-add" -isWelcomeNotif :: (MakesValue a) => a -> App Bool +isWelcomeNotif :: (HasCallStack, MakesValue a) => a -> App Bool isWelcomeNotif n = fieldEquals n "payload.0.type" "conversation.mls-welcome" -isMemberJoinNotif :: (MakesValue a) => a -> App Bool +isMemberJoinNotif :: (HasCallStack, MakesValue a) => a -> App Bool isMemberJoinNotif n = fieldEquals n "payload.0.type" "conversation.member-join" -isConvLeaveNotif :: (MakesValue a) => a -> App Bool +isConvLeaveNotif :: (HasCallStack, MakesValue a) => a -> App Bool isConvLeaveNotif n = fieldEquals n "payload.0.type" "conversation.member-leave" -isConvLeaveNotifWithLeaver :: (MakesValue user, MakesValue a) => user -> a -> App Bool +isConvLeaveNotifWithLeaver :: (HasCallStack, MakesValue user, MakesValue a) => user -> a -> App Bool isConvLeaveNotifWithLeaver user n = fieldEquals n "payload.0.type" "conversation.member-leave" &&~ (n %. "payload.0.data.user_ids.0") `isEqual` (user %. "id") -isNotifConv :: (MakesValue conv, MakesValue a, HasCallStack) => conv -> a -> App Bool +isNotifConv :: (HasCallStack, MakesValue conv, MakesValue a, HasCallStack) => conv -> a -> App Bool isNotifConv conv n = fieldEquals n "payload.0.qualified_conversation" (objQidObject conv) -isNotifConvId :: (MakesValue a, HasCallStack) => ConvId -> a -> App Bool +isNotifConvId :: (HasCallStack, MakesValue a, HasCallStack) => ConvId -> a -> App Bool isNotifConvId conv n = do let subconvField = "payload.0.subconv" fieldEquals n "payload.0.qualified_conversation" (convIdToQidObject conv) &&~ maybe (isNothing <$> lookupField n subconvField) (fieldEquals n subconvField) conv.subconvId -isNotifForUser :: (MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool +isNotifForUser :: (HasCallStack, MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool isNotifForUser user n = fieldEquals n "payload.0.data.qualified_user_ids.0" (objQidObject user) -isNotifFromUser :: (MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool +isNotifFromUser :: (HasCallStack, MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool isNotifFromUser user n = fieldEquals n "payload.0.qualified_from" (objQidObject user) isConvNameChangeNotif :: (HasCallStack, MakesValue a) => a -> App Bool @@ -171,55 +171,55 @@ isConvAccessUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool isConvAccessUpdateNotif n = fieldEquals n "payload.0.type" "conversation.access-update" -isConvCreateNotif :: (MakesValue a) => a -> App Bool +isConvCreateNotif :: (HasCallStack, MakesValue a) => a -> App Bool isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create" -- | like 'isConvCreateNotif' but excludes self conversations -isConvCreateNotifNotSelf :: (MakesValue a) => a -> App Bool +isConvCreateNotifNotSelf :: (HasCallStack, MakesValue a) => a -> App Bool isConvCreateNotifNotSelf n = fieldEquals n "payload.0.type" "conversation.create" &&~ do not <$> fieldEquals n "payload.0.data.access" ["private"] -isConvDeleteNotif :: (MakesValue a) => a -> App Bool +isConvDeleteNotif :: (HasCallStack, MakesValue a) => a -> App Bool isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete" -notifTypeIsEqual :: (MakesValue a) => String -> a -> App Bool +notifTypeIsEqual :: (HasCallStack, MakesValue a) => String -> a -> App Bool notifTypeIsEqual typ n = nPayload n %. "type" `isEqual` typ -isTeamMemberJoinNotif :: (MakesValue a) => a -> App Bool +isTeamMemberJoinNotif :: (HasCallStack, MakesValue a) => a -> App Bool isTeamMemberJoinNotif = notifTypeIsEqual "team.member-join" -isTeamMemberLeaveNotif :: (MakesValue a) => a -> App Bool +isTeamMemberLeaveNotif :: (HasCallStack, MakesValue a) => a -> App Bool isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave" -isTeamCollaboratorAddedNotif :: (MakesValue a) => a -> App Bool +isTeamCollaboratorAddedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isTeamCollaboratorAddedNotif = notifTypeIsEqual "team.collaborator-add" -isUserActivateNotif :: (MakesValue a) => a -> App Bool +isUserActivateNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserActivateNotif = notifTypeIsEqual "user.activate" -isUserClientAddNotif :: (MakesValue a) => a -> App Bool +isUserClientAddNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserClientAddNotif = notifTypeIsEqual "user.client-add" -isUserUpdatedNotif :: (MakesValue a) => a -> App Bool +isUserUpdatedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserUpdatedNotif = notifTypeIsEqual "user.update" -isUserClientRemoveNotif :: (MakesValue a) => a -> App Bool +isUserClientRemoveNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserClientRemoveNotif = notifTypeIsEqual "user.client-remove" -isUserLegalholdRequestNotif :: (MakesValue a) => a -> App Bool +isUserLegalholdRequestNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserLegalholdRequestNotif = notifTypeIsEqual "user.legalhold-request" -isUserLegalholdEnabledNotif :: (MakesValue a) => a -> App Bool +isUserLegalholdEnabledNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserLegalholdEnabledNotif = notifTypeIsEqual "user.legalhold-enable" -isUserLegalholdDisabledNotif :: (MakesValue a) => a -> App Bool +isUserLegalholdDisabledNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserLegalholdDisabledNotif = notifTypeIsEqual "user.legalhold-disable" -isUserConnectionNotif :: (MakesValue a) => a -> App Bool +isUserConnectionNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserConnectionNotif = notifTypeIsEqual "user.connection" -isConnectionNotif :: (MakesValue a) => String -> a -> App Bool +isConnectionNotif :: (HasCallStack, MakesValue a) => String -> a -> App Bool isConnectionNotif status n = -- NB: -- (&&) <$> (print "hello" *> pure False) <*> fail "bla" === _|_ @@ -227,10 +227,10 @@ isConnectionNotif status n = nPayload n %. "type" `isEqual` "user.connection" &&~ nPayload n %. "connection.status" `isEqual` status -isUserGroupCreatedNotif :: (MakesValue a) => a -> App Bool +isUserGroupCreatedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserGroupCreatedNotif = notifTypeIsEqual "user-group.created" -isUserGroupUpdatedNotif :: (MakesValue a) => a -> App Bool +isUserGroupUpdatedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserGroupUpdatedNotif = notifTypeIsEqual "user-group.updated" isConvResetNotif :: (HasCallStack, MakesValue n) => n -> App Bool @@ -264,7 +264,7 @@ assertLeaveNotification fromUser conv user client leaver = ] ) -assertConvUserDeletedNotif :: (MakesValue leaverId) => WebSocket -> leaverId -> App () +assertConvUserDeletedNotif :: (HasCallStack, MakesValue leaverId) => WebSocket -> leaverId -> App () assertConvUserDeletedNotif ws leaverId = do n <- awaitMatch isConvLeaveNotif ws nPayload n %. "data.qualified_user_ids.0" `shouldMatch` leaverId From cc93c00c037bd983c9c51b136c1729352695ba0e Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 4 Sep 2025 15:41:34 +0200 Subject: [PATCH 27/50] fix: could it finally work? --- .../src/Wire/API/Routes/Internal/Galley.hs | 4 +- .../src/Wire/API/Team/Conversation.hs | 34 +++++++------ .../src/Wire/ConversationsSubsystem.hs | 4 +- .../Wire/ConversationsSubsystem/GalleyAPI.hs | 2 +- .../src/Wire/GalleyAPIAccess.hs | 4 +- .../src/Wire/GalleyAPIAccess/Rpc.hs | 10 ++-- .../src/Wire/TeamCollaboratorsSubsystem.hs | 4 +- .../TeamCollaboratorsSubsystem/Interpreter.hs | 8 +-- .../test/unit/Wire/MiniBackend.hs | 4 +- .../Wire/MockInterpreters/GalleyAPIAccess.hs | 4 +- services/galley/src/Galley/API/Internal.hs | 49 ++++++++++--------- .../src/Galley/ConversationsSubsystem.hs | 26 ++++------ 12 files changed, 77 insertions(+), 76 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index a68e47b64b..afd62d5eed 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -50,7 +50,7 @@ import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version import Wire.API.Team -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info @@ -327,7 +327,7 @@ type ITeamsAPIBase = "leave-conversations-from" ( "leave-conversations-from" :> Capture "uid" UserId - :> Post '[JSON] LeftConversations + :> Post '[JSON] LeavingConversations ) type IFeatureStatusGet cfg = diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index 214b3e9996..680e347402 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -30,9 +30,9 @@ module Wire.API.Team.Conversation newTeamConversationList, teamConversations, - -- * LeftConversations - LeftConversations (..), - newLeftConversations, + -- * LeavingConversations + LeavingConversations (..), + newLeavingConversations, ) where @@ -41,6 +41,7 @@ import Data.Aeson qualified as A import Data.Id (ConvId) import Data.OpenApi qualified as S import Data.Schema +import GHC.Generics (Generically(..)) import Imports import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -101,24 +102,25 @@ newTeamConversationList = TeamConversationList makeLenses ''TeamConversation -------------------------------------------------------------------------------- --- LeftConversations +-- LeavingConversations -data LeftConversations = LeftConversations {left :: [ConvId], closed :: [ConvId]} +data LeavingConversations = LeavingConversations {leave :: [ConvId], close :: [ConvId]} deriving (Generic) deriving stock (Eq, Show) - deriving (Arbitrary) via (GenericUniform LeftConversations) - deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema LeftConversations) + deriving (Arbitrary) via (GenericUniform LeavingConversations) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema LeavingConversations) + deriving (Semigroup, Monoid) via (Generically LeavingConversations) -instance ToSchema LeftConversations where +instance ToSchema LeavingConversations where schema = objectWithDocModifier - "LeftConversations" - (description ?~ "Conversations left or closed") - $ LeftConversations - <$> left .= field "left" (array schema) - <*> closed .= field "closed" (array schema) + "LeavingConversations" + (description ?~ "Conversations to leave or close") + $ LeavingConversations + <$> leave .= field "leave" (array schema) + <*> close .= field "close" (array schema) -newLeftConversations :: [ConvId] -> [ConvId] -> LeftConversations -newLeftConversations = LeftConversations +newLeavingConversations :: [ConvId] -> [ConvId] -> LeavingConversations +newLeavingConversations = LeavingConversations -makeLenses ''LeftConversations +makeLenses ''LeavingConversations diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs index ab0048f2f5..333047aa11 100644 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs @@ -4,9 +4,9 @@ module Wire.ConversationsSubsystem where import Data.Id import Polysemy -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) data ConversationsSubsystem m a where - InternalLeaveConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m LeftConversations + InternalLeavingConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m LeavingConversations makeSem ''ConversationsSubsystem diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs index bc0339c85a..325342c43e 100644 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs +++ b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs @@ -13,4 +13,4 @@ interpretConversationsSubsystemToGalleyAPI :: (Member GalleyAPIAccess r) => Inte interpretConversationsSubsystemToGalleyAPI = interpret $ \case - InternalLeaveConversationsFrom tid uid -> GalleyAPIAccess.leaveConversationsFrom tid uid + InternalLeavingConversationsFrom tid uid -> GalleyAPIAccess.leavingConversationsFrom tid uid diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index 274a661414..87fa3fa85a 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -30,7 +30,7 @@ import Wire.API.Conversation import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Team -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -150,6 +150,6 @@ data GalleyAPIAccess m a where UserId -> GalleyAPIAccess m [EJPDConvInfo] GetTeamAdmins :: TeamId -> GalleyAPIAccess m Team.TeamMemberList - LeaveConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m LeftConversations + LeavingConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m LeavingConversations makeSem ''GalleyAPIAccess diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 9a840ff2d5..19c241c74c 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -45,7 +45,7 @@ import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Version import Wire.API.Team -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -98,7 +98,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint = UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv GetEJPDConvInfo uid -> getEJPDConvInfo uid GetTeamAdmins tid -> getTeamAdmins tid - LeaveConversationsFrom tid uid -> leaveConversationsFrom tid uid + LeavingConversationsFrom tid uid -> leavingConversationsFrom tid uid getUserLegalholdStatus :: ( Member TinyLog r, @@ -708,7 +708,7 @@ getEJPDConvInfo uid = do . paths ["i", "user", toByteString' uid, "all-conversations"] -- | Calls 'Galley.API.updateTeamStatusH'. -leaveConversationsFrom :: +leavingConversationsFrom :: ( Member (Error ParseException) r, Member Rpc r, Member (Input Endpoint) r, @@ -716,8 +716,8 @@ leaveConversationsFrom :: ) => TeamId -> UserId -> - Sem r LeftConversations -leaveConversationsFrom tid uid = do + Sem r LeavingConversations +leavingConversationsFrom tid uid = do debug $ remote "galley" . msg (val "Leave all conversations of a user in a team") decodeBodyOrThrow "galley" =<< galleyRequest req where diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index 6624b6b384..d2be56dd51 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -7,7 +7,7 @@ import Data.Qualified import Imports import Polysemy import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) data TeamCollaboratorsSubsystem m a where CreateTeamCollaborator :: Local UserId -> UserId -> TeamId -> Set CollaboratorPermission -> TeamCollaboratorsSubsystem m () @@ -15,6 +15,6 @@ 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] - InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m LeftConversations + InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m LeavingConversations makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index d3e704e35c..1a8be245e0 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -11,9 +11,9 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeftConversations) +import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Member qualified as TeamMember -import Wire.ConversationsSubsystem (ConversationsSubsystem, internalLeaveConversationsFrom) +import Wire.ConversationsSubsystem (ConversationsSubsystem, internalLeavingConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -100,10 +100,10 @@ internalRemoveTeamCollaboratorImpl :: ) => UserId -> TeamId -> - Sem r LeftConversations + Sem r LeavingConversations internalRemoveTeamCollaboratorImpl user team = do Store.removeTeamCollaborator user team - internalLeaveConversationsFrom team user + internalLeavingConversationsFrom team user -- This is of general usefulness. However, we cannot move this to wire-api as -- this would lead to a cyclic dependency. diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index aa91cae03a..27b65a22f8 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -64,7 +64,7 @@ import Wire.API.Federation.API import Wire.API.Federation.Component import Wire.API.Federation.Error import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeftConversations (..)) +import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member hiding (userId) import Wire.API.User as User hiding (DeleteUser) @@ -639,7 +639,7 @@ interpretMaybeFederationStackState mb = interpretConversationsSubsystem = interpret $ \case - InternalLeaveConversationsFrom _tid _uid -> pure $ LeftConversations {left = [], closed = []} + InternalLeavingConversationsFrom _tid _uid -> pure $ LeavingConversations {leave = [], close = []} in miniBackendLowerEffectsInterpreters mb . interpretConversationsSubsystem . interpretTeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index 40277e65c0..625a509025 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -7,7 +7,7 @@ import Data.Proxy import Data.Range import Imports import Polysemy -import Wire.API.Team.Conversation (LeftConversations (..)) +import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info (TeamMemberInfoList (..)) @@ -51,7 +51,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case GetEJPDConvInfo _ -> error "GetEJPDConvInfo not implemented in miniGalleyAPIAccess" GetTeamAdmins tid -> pure $ newTeamMemberList (maybe [] (filter (\tm -> isAdminOrOwner (tm ^. permissions))) $ Map.lookup tid teams) ListComplete SelectTeamMemberInfos tid uids -> pure $ selectTeamMemberInfosImpl teams tid uids - LeaveConversationsFrom _tid _uid -> pure $ LeftConversations {left = [], closed = []} + LeavingConversationsFrom _tid _uid -> pure $ LeavingConversations {leave = [], close = []} -- this is called but the result is not needed in unit tests selectTeamMemberInfosImpl :: Map TeamId [TeamMember] -> TeamId -> [UserId] -> TeamMemberInfoList diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 2d1d4e7dba..ce6ace6365 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -32,6 +32,7 @@ import Data.Default import Data.Id as Id import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map +import Data.Set qualified as Set import Data.Qualified import Data.Range import Data.Singletons @@ -90,7 +91,7 @@ import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiTablePaging qualified as MTP -import Wire.API.Team.Conversation (LeftConversations (..)) +import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client @@ -218,7 +219,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) <@> mkNamedAPI @"update-team-status" (Teams.updateTeamStatus tid) <@> hoistAPISegment ( mkNamedAPI @"unchecked-add-team-member" (Teams.uncheckedAddTeamMember tid) - <@> mkNamedAPI @"unchecked-remove-team-member" (\luid -> leaveTeams luid Nothing (for_ [tid])) + <@> mkNamedAPI @"unchecked-remove-team-member" (\luid -> leaveTeams luid Nothing [tid]) <@> mkNamedAPI @"unchecked-get-team-members" (TeamSubsystem.internalGetTeamMembers tid) <@> mkNamedAPI @"unchecked-select-team-member-infos" (\userIds -> TeamSubsystem.internalSelectTeamMemberInfos tid (cUsers userIds)) <@> mkNamedAPI @"unchecked-get-team-member" (Teams.uncheckedGetTeamMember tid) @@ -231,7 +232,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) ( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid) <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid) ) - <@> mkNamedAPI @"leave-conversations-from" (ConversationsSubsystem.internalLeaveConversationsFrom tid) + <@> mkNamedAPI @"leave-conversations-from" (ConversationsSubsystem.internalLeavingConversationsFrom tid) miscAPI :: API IMiscAPI GalleyEffects miscAPI = @@ -350,14 +351,15 @@ rmUser :: Maybe ConnId -> Sem r () rmUser lusr conn = do - tids <- listTeams (tUnqualified lusr) Nothing maxBound - let forTids page f = - for_ (pageItems page) $ \tid -> do - f tid + let fetchTids acc page = + if null (pageItems page) + then pure acc + else do page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - forTids page' f + fetchTids (pageItems page <> acc) page' - leaveTeams lusr conn $ forTids tids + tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound + leaveTeams lusr conn tids deleteClients (tUnqualified lusr) leaveTeams :: @@ -384,11 +386,12 @@ leaveTeams :: ) => Local UserId -> Maybe ConnId -> - ((TeamId -> Sem r ()) -> Sem r ()) -> + [TeamId] -> Sem r () -leaveTeams lusr conn forTids = do +leaveTeams lusr conn tids = do let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 - forTids $ \tid -> do + leavingConversations <- fold <$> mapM (internalRemoveTeamCollaborator (tUnqualified lusr)) tids + forM_ tids $ \tid -> do toNotify <- handleImpossibleErrors $ getFeatureForTeam @LimitedEventFanoutConfig tid @@ -397,27 +400,29 @@ leaveTeams lusr conn forTids = do FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid ) . (.status) - leftConversations <- internalRemoveTeamCollaborator (tUnqualified lusr) tid uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - let qUser = tUntagged lusr - now <- Now.get - convs <- getConversations leftConversations.left - pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs + -- let qUser = tUntagged lusr + -- now <- Now.get + -- convs <- getConversations leftConversations.leave + -- pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) - goConvPages nRange1000 allConvIds + goConvPages (Set.fromList $ leavingConversations.leave <> leavingConversations.close) nRange1000 allConvIds + + leaveLocalConversations leavingConversations.leave + mapM_ E.deleteConversation leavingConversations.close where - goConvPages :: Range 1 1000 Int32 -> ConvIdsPage -> Sem r () - goConvPages range page = do + goConvPages :: Set.Set ConvId -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () + goConvPages otherConvs range page = do let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) - leaveLocalConversations localConvs + leaveLocalConversations $ filter (`Set.member` otherConvs) localConvs traverse_ leaveRemoteConversations (rangedChunks remoteConvs) when (mtpHasMore page) $ do let nextState = mtpPagingState page nextQuery = GetPaginatedConversationIds (Just nextState) range newCids <- Query.conversationIdsPageFrom lusr nextQuery - goConvPages range newCids + goConvPages otherConvs range newCids -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this -- point: the user is a team member because we fetched the list of teams diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index 0fb6891d3a..245379ce6e 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -6,7 +6,6 @@ where import Cassandra import Cassandra.Exec import Conduit -import Data.Bifoldable import Data.Id import Galley.Cassandra.Store (embedClient) import Galley.Cassandra.Util (logEffect) @@ -14,15 +13,14 @@ import Imports import Polysemy import Polysemy.Input import Polysemy.TinyLog (TinyLog) -import UnliftIO.Async (pooledForConcurrentlyN, pooledMapConcurrentlyN_) +import UnliftIO.Async (pooledForConcurrentlyN) +import Wire.ConversationStore.Cassandra (members) +import Wire.StoredConversation qualified import Wire.API.Conversation (ConvType (..)) -import Wire.API.Team.Conversation (LeftConversations, newLeftConversations) +import Wire.API.Team.Conversation (LeavingConversations, newLeavingConversations) import Wire.BrigAPIAccess qualified as E -import Wire.ConversationStore.Cassandra (deleteConversation, members, removeMembersFromLocalConv) import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) import Wire.ConversationsSubsystem -import Wire.StoredConversation qualified -import Wire.UserList (UserList (UserList)) interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, @@ -34,18 +32,17 @@ interpretConversationsSubsystemCassandra :: interpretConversationsSubsystemCassandra = interpret $ \case - InternalLeaveConversationsFrom tid uid -> do - logEffect "ConversationsSubsystem.internalLeaveConversationsFrom" + InternalLeavingConversationsFrom tid uid -> do + logEffect "ConversationsSubsystem.internalLeavingConversationsFrom" contacts <- E.getContactList uid - embedClient $ leaveConversationsFromImpl tid uid contacts + embedClient $ leavingConversationsFromImpl tid uid contacts -leaveConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client LeftConversations -leaveConversationsFromImpl tid uid contacts = - fmap (uncurry newLeftConversations) $ +leavingConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client LeavingConversations +leavingConversationsFromImpl tid uid contacts = + fmap (uncurry newLeavingConversations) $ runConduit $ paginateWithStateC listConversationsIds .| mapMC performFilter - .| iterMC (bimapM_ (pooledMapConcurrentlyN_ 16 performConversationRemoveUser) (mapM_ deleteConversation)) .| foldC where listConversationsIds pagingState = @@ -71,6 +68,3 @@ leaveConversationsFromImpl tid uid contacts = flip map results $ \(convType, _mUserId, _mAccesses, _mRole, _mRoles, _mName, mTeam, _mDeleted, _mTimer, _mMode, _mProtocol, _mGroupId, _mEpoch, _mWriteEpoch, _mCiher, _mGroupConvType, _mChannelPerms, _mCellState, _mParentConvId) -> (convId, mTeam, convType) - performConversationRemoveUser :: ConvId -> Client () - performConversationRemoveUser convId = - removeMembersFromLocalConv convId (UserList [uid] []) From a8454430ded30e5b01e99b83a1030ce791929684 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 4 Sep 2025 16:15:49 +0200 Subject: [PATCH 28/50] fix: filter duplicated convs --- services/galley/src/Galley/API/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index ce6ace6365..ede17b44fe 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -416,7 +416,7 @@ leaveTeams lusr conn tids = do goConvPages :: Set.Set ConvId -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () goConvPages otherConvs range page = do let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) - leaveLocalConversations $ filter (`Set.member` otherConvs) localConvs + leaveLocalConversations $ filter (`Set.notMember` otherConvs) localConvs traverse_ leaveRemoteConversations (rangedChunks remoteConvs) when (mtpHasMore page) $ do let nextState = mtpPagingState page From 0b1bc4a5352083ea9981ee12110a00f47a5ade2f Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 4 Sep 2025 16:53:28 +0200 Subject: [PATCH 29/50] fix: ormolu --- .../wire-api/src/Wire/API/Team/Conversation.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 18 +++++++++--------- .../src/Galley/ConversationsSubsystem.hs | 4 ++-- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index 680e347402..48e637a552 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -41,7 +41,7 @@ import Data.Aeson qualified as A import Data.Id (ConvId) import Data.OpenApi qualified as S import Data.Schema -import GHC.Generics (Generically(..)) +import GHC.Generics (Generically (..)) import Imports import Wire.Arbitrary (Arbitrary, GenericUniform (..)) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index ede17b44fe..bd40ca1ec3 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -32,9 +32,9 @@ import Data.Default import Data.Id as Id import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map -import Data.Set qualified as Set import Data.Qualified import Data.Range +import Data.Set qualified as Set import Data.Singletons import Data.Time import Galley.API.Action @@ -353,10 +353,10 @@ rmUser :: rmUser lusr conn = do let fetchTids acc page = if null (pageItems page) - then pure acc - else do - page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - fetchTids (pageItems page <> acc) page' + then pure acc + else do + page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound + fetchTids (pageItems page <> acc) page' tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound leaveTeams lusr conn tids @@ -402,10 +402,10 @@ leaveTeams lusr conn tids = do . (.status) uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - -- let qUser = tUntagged lusr - -- now <- Now.get - -- convs <- getConversations leftConversations.leave - -- pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs + -- let qUser = tUntagged lusr + -- now <- Now.get + -- convs <- getConversations leftConversations.leave + -- pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) goConvPages (Set.fromList $ leavingConversations.leave <> leavingConversations.close) nRange1000 allConvIds diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs index 245379ce6e..b734ec3663 100644 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ b/services/galley/src/Galley/ConversationsSubsystem.hs @@ -14,13 +14,13 @@ import Polysemy import Polysemy.Input import Polysemy.TinyLog (TinyLog) import UnliftIO.Async (pooledForConcurrentlyN) -import Wire.ConversationStore.Cassandra (members) -import Wire.StoredConversation qualified import Wire.API.Conversation (ConvType (..)) import Wire.API.Team.Conversation (LeavingConversations, newLeavingConversations) import Wire.BrigAPIAccess qualified as E +import Wire.ConversationStore.Cassandra (members) import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) import Wire.ConversationsSubsystem +import Wire.StoredConversation qualified interpretConversationsSubsystemCassandra :: ( Member (Embed IO) r, From 2e080489f7726d0f13b19f4a37c20a190ce55a09 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 4 Sep 2025 18:00:52 +0200 Subject: [PATCH 30/50] fix: comment --- services/galley/src/Galley/API/Internal.hs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index bd40ca1ec3..a6146ce2b8 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -32,9 +32,9 @@ import Data.Default import Data.Id as Id import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map +import Data.Set qualified as Set import Data.Qualified import Data.Range -import Data.Set qualified as Set import Data.Singletons import Data.Time import Galley.API.Action @@ -353,10 +353,10 @@ rmUser :: rmUser lusr conn = do let fetchTids acc page = if null (pageItems page) - then pure acc - else do - page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - fetchTids (pageItems page <> acc) page' + then pure acc + else do + page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound + fetchTids (pageItems page <> acc) page' tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound leaveTeams lusr conn tids @@ -402,11 +402,6 @@ leaveTeams lusr conn tids = do . (.status) uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - -- let qUser = tUntagged lusr - -- now <- Now.get - -- convs <- getConversations leftConversations.leave - -- pushNotifications =<< mapM (notifyRemoteMembersAndPrepareLocalMembersLeft now qUser) convs - allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) goConvPages (Set.fromList $ leavingConversations.leave <> leavingConversations.close) nRange1000 allConvIds From f71e5e49cf0fcfb05be82b30c458b0c72d5d7517 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 4 Sep 2025 18:17:21 +0200 Subject: [PATCH 31/50] fix: ormolu --- services/galley/src/Galley/API/Internal.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index a6146ce2b8..48238296b4 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -32,9 +32,9 @@ import Data.Default import Data.Id as Id import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map -import Data.Set qualified as Set import Data.Qualified import Data.Range +import Data.Set qualified as Set import Data.Singletons import Data.Time import Galley.API.Action @@ -353,10 +353,10 @@ rmUser :: rmUser lusr conn = do let fetchTids acc page = if null (pageItems page) - then pure acc - else do - page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - fetchTids (pageItems page <> acc) page' + then pure acc + else do + page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound + fetchTids (pageItems page <> acc) page' tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound leaveTeams lusr conn tids From d6c5c6f510cf233816ac4ef30b6ab66868ab8777 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 5 Sep 2025 18:18:33 +0200 Subject: [PATCH 32/50] fix: rebase --- libs/wire-api/src/Wire/API/Event/Team.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index 43cb9868b0..5cfcde53c7 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -143,7 +143,7 @@ instance ToSchema EventType where element "team.conversation-create" ConvCreate, element "team.conversation-delete" ConvDelete, element "team.collaborator-add" CollaboratorAdd, - element "team.app-create" AppCreate + element "team.app-create" AppCreate, element "team.collaborator-remove" CollaboratorRemove ] From 485bbcf72aa475ade86e448cd1f3c763aa5f138c Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 9 Sep 2025 16:31:59 +0200 Subject: [PATCH 33/50] refactor: move to galley --- .../src/Wire/API/Routes/Internal/Galley.hs | 14 -- .../src/Wire/API/Routes/Public/Brig.hs | 11 - .../API/Routes/Public/Galley/TeamMember.hs | 11 + .../src/Wire/API/Team/Conversation.hs | 29 --- .../src/Wire/ConversationsSubsystem.hs | 12 - .../Wire/ConversationsSubsystem/GalleyAPI.hs | 16 -- .../src/Wire/GalleyAPIAccess.hs | 7 - .../src/Wire/GalleyAPIAccess/Rpc.hs | 46 ---- .../src/Wire/TeamCollaboratorsSubsystem.hs | 3 +- .../TeamCollaboratorsSubsystem/Interpreter.hs | 11 +- .../test/unit/Wire/MiniBackend.hs | 13 +- .../Wire/MockInterpreters/GalleyAPIAccess.hs | 3 - libs/wire-subsystems/wire-subsystems.cabal | 2 - .../brig/src/Brig/CanonicalInterpreter.hs | 4 - services/brig/src/Brig/Team/API.hs | 1 - services/galley/default.nix | 1 - services/galley/galley.cabal | 2 - services/galley/src/Galley/API/Internal.hs | 171 +-------------- .../src/Galley/API/Public/TeamMember.hs | 1 + services/galley/src/Galley/API/Teams.hs | 205 +++++++++++++++++- services/galley/src/Galley/App.hs | 6 +- .../src/Galley/ConversationsSubsystem.hs | 70 ------ services/galley/src/Galley/Effects.hs | 11 +- 23 files changed, 232 insertions(+), 418 deletions(-) delete mode 100644 libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs delete mode 100644 libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs delete mode 100644 services/galley/src/Galley/ConversationsSubsystem.hs diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index afd62d5eed..809cefde15 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -50,7 +50,6 @@ import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version import Wire.API.Team -import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info @@ -253,13 +252,6 @@ 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) @@ -323,12 +315,6 @@ type ITeamsAPIBase = :> MultiVerb1 'PUT '[JSON] (RespondEmpty 204 "OK") ) ) - :<|> Named - "leave-conversations-from" - ( "leave-conversations-from" - :> Capture "uid" UserId - :> Post '[JSON] LeavingConversations - ) type IFeatureStatusGet cfg = Named diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 3ec9616536..b54f9db2a8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -2061,17 +2061,6 @@ type TeamsAPI = :> ReqBody '[JSON] NewTeamCollaborator :> MultiVerb1 'POST '[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." diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index ef66057baa..da315661ed 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -207,6 +207,17 @@ type TeamMemberAPI = "CSV of team members" CSV ) + :<|> 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 "") + ) type TeamMemberDeleteResultResponseType = '[ RespondEmpty 202 "Team member scheduled for deletion", diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index 48e637a552..d3b240d9f5 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -29,10 +29,6 @@ module Wire.API.Team.Conversation TeamConversationList, newTeamConversationList, teamConversations, - - -- * LeavingConversations - LeavingConversations (..), - newLeavingConversations, ) where @@ -41,7 +37,6 @@ import Data.Aeson qualified as A import Data.Id (ConvId) import Data.OpenApi qualified as S import Data.Schema -import GHC.Generics (Generically (..)) import Imports import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -100,27 +95,3 @@ newTeamConversationList :: [TeamConversation] -> TeamConversationList newTeamConversationList = TeamConversationList makeLenses ''TeamConversation - --------------------------------------------------------------------------------- --- LeavingConversations - -data LeavingConversations = LeavingConversations {leave :: [ConvId], close :: [ConvId]} - deriving (Generic) - deriving stock (Eq, Show) - deriving (Arbitrary) via (GenericUniform LeavingConversations) - deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema LeavingConversations) - deriving (Semigroup, Monoid) via (Generically LeavingConversations) - -instance ToSchema LeavingConversations where - schema = - objectWithDocModifier - "LeavingConversations" - (description ?~ "Conversations to leave or close") - $ LeavingConversations - <$> leave .= field "leave" (array schema) - <*> close .= field "close" (array schema) - -newLeavingConversations :: [ConvId] -> [ConvId] -> LeavingConversations -newLeavingConversations = LeavingConversations - -makeLenses ''LeavingConversations diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs deleted file mode 100644 index 333047aa11..0000000000 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Wire.ConversationsSubsystem where - -import Data.Id -import Polysemy -import Wire.API.Team.Conversation (LeavingConversations) - -data ConversationsSubsystem m a where - InternalLeavingConversationsFrom :: TeamId -> UserId -> ConversationsSubsystem m LeavingConversations - -makeSem ''ConversationsSubsystem diff --git a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs b/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs deleted file mode 100644 index 325342c43e..0000000000 --- a/libs/wire-subsystems/src/Wire/ConversationsSubsystem/GalleyAPI.hs +++ /dev/null @@ -1,16 +0,0 @@ -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 - InternalLeavingConversationsFrom tid uid -> GalleyAPIAccess.leavingConversationsFrom tid uid diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index 87fa3fa85a..c4dd5fcc26 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -30,7 +30,6 @@ import Wire.API.Conversation import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Team -import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -74,11 +73,6 @@ data GalleyAPIAccess m a where Maybe (UserId, UTCTimeMillis) -> Role -> GalleyAPIAccess m Bool - RemoveTeamMember :: - Local UserId -> - UserId -> - TeamId -> - GalleyAPIAccess m () CreateTeam :: UserId -> NewTeam -> @@ -150,6 +144,5 @@ data GalleyAPIAccess m a where UserId -> GalleyAPIAccess m [EJPDConvInfo] GetTeamAdmins :: TeamId -> GalleyAPIAccess m Team.TeamMemberList - LeavingConversationsFrom :: TeamId -> UserId -> GalleyAPIAccess m LeavingConversations makeSem ''GalleyAPIAccess diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 19c241c74c..2ac97e142e 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -45,7 +45,6 @@ import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Version import Wire.API.Team -import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature import Wire.API.Team.LegalHold @@ -77,7 +76,6 @@ 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 @@ -98,7 +96,6 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint = UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv GetEJPDConvInfo uid -> getEJPDConvInfo uid GetTeamAdmins tid -> getTeamAdmins tid - LeavingConversationsFrom tid uid -> leavingConversationsFrom tid uid getUserLegalholdStatus :: ( Member TinyLog r, @@ -285,29 +282,6 @@ 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, @@ -706,23 +680,3 @@ getEJPDConvInfo uid = do getReq = method GET . paths ["i", "user", toByteString' uid, "all-conversations"] - --- | Calls 'Galley.API.updateTeamStatusH'. -leavingConversationsFrom :: - ( Member (Error ParseException) r, - Member Rpc r, - Member (Input Endpoint) r, - Member TinyLog r - ) => - TeamId -> - UserId -> - Sem r LeavingConversations -leavingConversationsFrom tid uid = do - debug $ remote "galley" . msg (val "Leave all conversations of a user in a team") - decodeBodyOrThrow "galley" =<< galleyRequest req - where - req = - method POST - . paths ["i", "teams", toByteString' tid, "leave-conversations-from", toByteString' uid] - . header "Content-Type" "application/json" - . expect2xx diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs index d2be56dd51..2e57f9729f 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem.hs @@ -7,7 +7,6 @@ import Data.Qualified import Imports import Polysemy import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeavingConversations) data TeamCollaboratorsSubsystem m a where CreateTeamCollaborator :: Local UserId -> UserId -> TeamId -> Set CollaboratorPermission -> TeamCollaboratorsSubsystem m () @@ -15,6 +14,6 @@ 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] - InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m LeavingConversations + InternalRemoveTeamCollaborator :: UserId -> TeamId -> TeamCollaboratorsSubsystem m () makeSem ''TeamCollaboratorsSubsystem diff --git a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs index 1a8be245e0..4430d129ad 100644 --- a/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamCollaboratorsSubsystem/Interpreter.hs @@ -11,9 +11,7 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Event.Team import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeavingConversations) import Wire.API.Team.Member qualified as TeamMember -import Wire.ConversationsSubsystem (ConversationsSubsystem, internalLeavingConversationsFrom) import Wire.Error import Wire.NotificationSubsystem import Wire.Sem.Now @@ -27,8 +25,7 @@ interpretTeamCollaboratorsSubsystem :: Member (Error TeamCollaboratorsError) r, Member Store.TeamCollaboratorsStore r, Member Now r, - Member NotificationSubsystem r, - Member ConversationsSubsystem r + Member NotificationSubsystem r ) => InterpreterFor TeamCollaboratorsSubsystem r interpretTeamCollaboratorsSubsystem = interpret $ \case @@ -95,15 +92,13 @@ internalGetTeamCollaboratorsWithIdsImpl = do Store.getTeamCollaboratorsWithIds internalRemoveTeamCollaboratorImpl :: - ( Member Store.TeamCollaboratorsStore r, - Member ConversationsSubsystem r + ( Member Store.TeamCollaboratorsStore r ) => UserId -> TeamId -> - Sem r LeavingConversations + Sem r () internalRemoveTeamCollaboratorImpl user team = do Store.removeTeamCollaborator user team - internalLeavingConversationsFrom team user -- This is of general usefulness. However, we cannot move this to wire-api as -- this would lead to a cyclic dependency. diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 27b65a22f8..9673139026 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -64,7 +64,6 @@ import Wire.API.Federation.API import Wire.API.Federation.Component import Wire.API.Federation.Error import Wire.API.Team.Collaborator -import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member hiding (userId) import Wire.API.User as User hiding (DeleteUser) @@ -78,7 +77,6 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Cookie.Limit import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore -import Wire.ConversationsSubsystem (ConversationsSubsystem (..)) import Wire.DeleteQueue import Wire.DeleteQueue.InMemory import Wire.DomainRegistrationStore qualified as DRS @@ -635,16 +633,7 @@ interpretMaybeFederationStackState mb = userSubsystemInterpreter :: InterpreterFor UserSubsystem (TeamCollaboratorsSubsystem ': MiniBackendLowerEffects `Append` r) userSubsystemInterpreter = runUserSubsystem authSubsystemInterpreter - interpretConversationsSubsystem :: forall r0. InterpreterFor ConversationsSubsystem r0 - interpretConversationsSubsystem = - interpret $ - \case - InternalLeavingConversationsFrom _tid _uid -> pure $ LeavingConversations {leave = [], close = []} - in miniBackendLowerEffectsInterpreters mb - . interpretConversationsSubsystem - . interpretTeamCollaboratorsSubsystem - . raiseUnder @ConversationsSubsystem - . userSubsystemInterpreter + in miniBackendLowerEffectsInterpreters mb . interpretTeamCollaboratorsSubsystem . userSubsystemInterpreter liftInvitationInfoStoreState :: (Member (State MiniBackend) r) => Sem (State (Map InvitationCode StoredInvitation) : r) a -> Sem r a liftInvitationInfoStoreState = interpret \case diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index 625a509025..a99e6ab713 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -7,7 +7,6 @@ import Data.Proxy import Data.Range import Imports import Polysemy -import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member.Info (TeamMemberInfoList (..)) @@ -28,7 +27,6 @@ miniGalleyAPIAccess teams configs = interpret $ \case NewClient _ _ -> error "NewClient not implemented in miniGalleyAPIAccess" CheckUserCanJoinTeam _ -> pure Nothing AddTeamMember {} -> error "AddTeamMember not implemented in miniGalleyAPIAccess" - RemoveTeamMember {} -> error "RemoveTeamMember not implemented in miniGalleyAPIAccess" CreateTeam {} -> error "CreateTeam not implemented in miniGalleyAPIAccess" GetTeamMember uid tid -> pure $ getTeamMemberImpl teams uid tid GetTeamMembers tid maxResults -> pure $ getTeamMembersImpl teams tid maxResults @@ -51,7 +49,6 @@ miniGalleyAPIAccess teams configs = interpret $ \case GetEJPDConvInfo _ -> error "GetEJPDConvInfo not implemented in miniGalleyAPIAccess" GetTeamAdmins tid -> pure $ newTeamMemberList (maybe [] (filter (\tm -> isAdminOrOwner (tm ^. permissions))) $ Map.lookup tid teams) ListComplete SelectTeamMemberInfos tid uids -> pure $ selectTeamMemberInfosImpl teams tid uids - LeavingConversationsFrom _tid _uid -> pure $ LeavingConversations {leave = [], close = []} -- this is called but the result is not needed in unit tests selectTeamMemberInfosImpl :: Map TeamId [TeamMember] -> TeamId -> [UserId] -> TeamMemberInfoList diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 0df2cf3521..ff514fc848 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -186,8 +186,6 @@ library Wire.BlockListStore.Cassandra Wire.BrigAPIAccess Wire.BrigAPIAccess.Rpc - Wire.ConversationsSubsystem - Wire.ConversationsSubsystem.GalleyAPI Wire.ConversationStore Wire.ConversationStore.Cassandra Wire.ConversationStore.Cassandra.Instances diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index c8b6ba918b..6e968f75ae 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -47,8 +47,6 @@ import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore import Wire.BlockListStore.Cassandra -import Wire.ConversationsSubsystem (ConversationsSubsystem) -import Wire.ConversationsSubsystem.GalleyAPI (interpretConversationsSubsystemToGalleyAPI) import Wire.DeleteQueue import Wire.DomainRegistrationStore import Wire.DomainRegistrationStore.Cassandra @@ -177,7 +175,6 @@ type BrigLowerLevelEffects = HashPassword, UserKeyStore, UserStore, - ConversationsSubsystem, IndexedUserStore, SessionStore, PasswordStore, @@ -344,7 +341,6 @@ runBrigToIO e (AppT ma) = do . interpretPasswordStore e.casClient . interpretSessionStoreCassandra e.casClient . interpretIndexedUserStoreES indexedUserStoreConfig - . interpretConversationsSubsystemToGalleyAPI . interpretUserStoreCassandra e.casClient . interpretUserKeyStoreCassandra e.casClient . runHashPassword e.settings.passwordHashingOptions diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 8938af09b3..d9d375f157 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -114,7 +114,6 @@ servantAPI = :<|> Named @"get-team-size" (\uid tid -> lift . liftSem $ teamSizePublic uid tid) :<|> Named @"accept-team-invitation" (\luid req -> lift $ liftSem $ acceptTeamInvitation luid req.password req.code) :<|> Named @"add-team-collaborator" (\zuid tid (NewTeamCollaborator uid perms) -> lift . liftSem $ createTeamCollaborator zuid uid tid perms) - :<|> Named @"remove-team-collaborator" (\zuid tid uid -> lift . liftSem $ GalleyAPIAccess.removeTeamMember zuid uid tid) :<|> Named @"get-team-collaborators" (\zuid tid -> lift . liftSem $ getAllTeamCollaborators zuid tid) teamSizePublic :: diff --git a/services/galley/default.nix b/services/galley/default.nix index 134e2a1756..ed562355f2 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -147,7 +147,6 @@ mkDerivation { cassandra-util cassava comonad - conduit constraints containers crypton diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 57ed69b986..5df13bc880 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -149,7 +149,6 @@ library Galley.Cassandra.TeamFeatures Galley.Cassandra.TeamNotifications Galley.Cassandra.Util - Galley.ConversationsSubsystem Galley.Data.Scope Galley.Data.TeamNotifications Galley.Data.Types @@ -291,7 +290,6 @@ library , cassandra-util >=0.16.2 , cassava >=0.5.2 , comonad - , conduit , constraints , containers >=0.5 , crypton diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 48238296b4..d66a0a94c6 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -28,23 +28,17 @@ where import Control.Exception.Safe (catchAny) import Control.Lens hiding (Getter, Setter, (.=)) import Data.ByteString.UTF8 qualified as UTF8 -import Data.Default import Data.Id as Id -import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map import Data.Qualified import Data.Range -import Data.Set qualified as Set import Data.Singletons -import Data.Time import Galley.API.Action -import Galley.API.Cells import Galley.API.Clients qualified as Clients import Galley.API.Create qualified as Create import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts -import Galley.API.MLS.Removal import Galley.API.One2One import Galley.API.Public.Servant import Galley.API.Query qualified as Query @@ -56,58 +50,42 @@ import Galley.API.Update qualified as Update import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.CustomBackendStore import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.ServiceStore import Galley.Effects.TeamStore -import Galley.Effects.TeamStore qualified as E import Galley.Monad import Galley.Options hiding (brig) import Galley.Queue qualified as Q import Imports hiding (head) -import Network.AMQP qualified as Q import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P import Servant import System.Logger.Class hiding (Path, name) -import System.Logger.Class qualified as Log import Wire.API.Conversation hiding (Member) -import Wire.API.Conversation.Action import Wire.API.Error import Wire.API.Error.Galley -import Wire.API.Event.Conversation -import Wire.API.Event.LeaveReason -import Wire.API.Federation.API -import Wire.API.Federation.API.Galley import Wire.API.Federation.Error -import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.API import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra -import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiTablePaging qualified as MTP -import Wire.API.Team.Conversation (LeavingConversations (..)) import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client import Wire.ConversationStore import Wire.ConversationStore qualified as E -import Wire.ConversationsSubsystem qualified as ConversationsSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) -import Wire.Sem.Now qualified as Now import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra import Wire.StoredConversation -import Wire.StoredConversation qualified as Data import Wire.TeamCollaboratorsSubsystem import Wire.TeamSubsystem qualified as TeamSubsystem -import Wire.UserList internalAPI :: API InternalAPI GalleyEffects internalAPI = @@ -219,7 +197,6 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) <@> mkNamedAPI @"update-team-status" (Teams.updateTeamStatus tid) <@> hoistAPISegment ( mkNamedAPI @"unchecked-add-team-member" (Teams.uncheckedAddTeamMember tid) - <@> mkNamedAPI @"unchecked-remove-team-member" (\luid -> leaveTeams luid Nothing [tid]) <@> mkNamedAPI @"unchecked-get-team-members" (TeamSubsystem.internalGetTeamMembers tid) <@> mkNamedAPI @"unchecked-select-team-member-infos" (\userIds -> TeamSubsystem.internalSelectTeamMemberInfos tid (cUsers userIds)) <@> mkNamedAPI @"unchecked-get-team-member" (Teams.uncheckedGetTeamMember tid) @@ -232,7 +209,6 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) ( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid) <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid) ) - <@> mkNamedAPI @"leave-conversations-from" (ConversationsSubsystem.internalLeavingConversationsFrom tid) miscAPI :: API IMiscAPI GalleyEffects miscAPI = @@ -345,7 +321,8 @@ rmUser :: Member Random r, Member TeamFeatureStore r, Member TeamStore r, - Member TeamCollaboratorsSubsystem r + Member TeamCollaboratorsSubsystem r, + Member BrigAPIAccess r ) => Local UserId -> Maybe ConnId -> @@ -359,151 +336,9 @@ rmUser lusr conn = do fetchTids (pageItems page <> acc) page' tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound - leaveTeams lusr conn tids + uncheckedLeaveTeams lusr conn tids deleteClients (tUnqualified lusr) -leaveTeams :: - forall p1 r. - ( p1 ~ CassandraPaging, - Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error DynError) r, - Member (Error FederationError) r, - Member (Error InternalError) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, - Member Now r, - Member (ListItems p1 ConvId) r, - Member (ListItems p1 (Remote ConvId)) r, - Member ProposalStore r, - Member P.TinyLog r, - Member Random r, - Member TeamFeatureStore r, - Member TeamStore r, - Member TeamCollaboratorsSubsystem r - ) => - Local UserId -> - Maybe ConnId -> - [TeamId] -> - Sem r () -leaveTeams lusr conn tids = do - let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 - leavingConversations <- fold <$> mapM (internalRemoveTeamCollaborator (tUnqualified lusr)) tids - forM_ tids $ \tid -> do - toNotify <- - handleImpossibleErrors $ - getFeatureForTeam @LimitedEventFanoutConfig tid - >>= ( \case - FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid - FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid - ) - . (.status) - uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - - allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) - goConvPages (Set.fromList $ leavingConversations.leave <> leavingConversations.close) nRange1000 allConvIds - - leaveLocalConversations leavingConversations.leave - mapM_ E.deleteConversation leavingConversations.close - where - goConvPages :: Set.Set ConvId -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () - goConvPages otherConvs range page = do - let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) - leaveLocalConversations $ filter (`Set.notMember` otherConvs) localConvs - traverse_ leaveRemoteConversations (rangedChunks remoteConvs) - when (mtpHasMore page) $ do - let nextState = mtpPagingState page - nextQuery = GetPaginatedConversationIds (Just nextState) range - newCids <- Query.conversationIdsPageFrom lusr nextQuery - goConvPages otherConvs range newCids - - -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this - -- point: the user is a team member because we fetched the list of teams - -- they are member of, and conversely the list of teams was fetched exactly - -- for this user so it cannot be that the team is not found. Therefore, this - -- helper just drops the errors. - handleImpossibleErrors :: - Sem - ( ErrorS 'NotATeamMember - ': ErrorS 'TeamNotFound - ': r - ) - a -> - Sem r a - handleImpossibleErrors action = - mapToDynamicError @'TeamNotFound (mapToDynamicError @'NotATeamMember action) - - leaveLocalConversations :: [ConvId] -> Sem r () - leaveLocalConversations ids = do - let qUser = tUntagged lusr - cc <- getConversations ids - now <- Now.get - pp <- for cc $ \c -> case Data.convType c of - SelfConv -> pure Nothing - One2OneConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing - ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing - RegularConv - | tUnqualified lusr `isMember` c.localMembers -> do - runError (removeUser (qualifyAs lusr c) RemoveUserIncludeMain (tUntagged lusr)) >>= \case - Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) - Right _ -> pure () - E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) - Just <$> notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c - | otherwise -> pure Nothing - - pushNotifications (catMaybes pp) - - notifyRemoteMembersAndPrepareLocalMembersLeft :: UTCTime -> Qualified UserId -> StoredConversation -> Sem r Push - notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c = do - let e = - Event - { evtConv = tUntagged (qualifyAs lusr c.id_), - evtSubConv = Nothing, - evtFrom = tUntagged lusr, - evtTime = now, - evtTeam = Nothing, - evtData = EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser]) - } - for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c - pure $ - def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = map localMemberToRecipient c.localMembers, - isCellsEvent = shouldPushToCells c.metadata e, - conn, - route = PushV2.RouteDirect - } - - -- FUTUREWORK: This could be optimized to reduce the number of RPCs - -- made. When a team is deleted the burst of RPCs created here could - -- lead to performance issues. We should cover this in a performance - -- test. - notifyRemoteMembers :: UTCTime -> Qualified UserId -> StoredConversation -> Remote [UserId] -> Sem r () - notifyRemoteMembers now qUser c remotes = do - let cid = c.id_ - convUpdate = - ConversationUpdate - { time = now, - origUserId = qUser, - convId = cid, - alreadyPresentUsers = tUnqualified remotes, - action = SomeConversationAction (sing @'ConversationLeaveTag) (), - extraConversationData = def - } - enqueueNotification Q.Persistent remotes $ do - makeConversationUpdateBundle convUpdate - >>= sendBundle - - leaveRemoteConversations :: Range 1 UserDeletedNotificationMaxConvs [Remote ConvId] -> Sem r () - leaveRemoteConversations cids = - for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do - let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) - let rpc = fedQueueClient @'OnUserDeletedConversationsTag userDelete - enqueueNotification Q.Persistent remoteConvs rpc - deleteLoop :: App () deleteLoop = do q <- view deleteQueue diff --git a/services/galley/src/Galley/API/Public/TeamMember.hs b/services/galley/src/Galley/API/Public/TeamMember.hs index c6b7d5cd05..549f3a750a 100644 --- a/services/galley/src/Galley/API/Public/TeamMember.hs +++ b/services/galley/src/Galley/API/Public/TeamMember.hs @@ -33,3 +33,4 @@ teamMemberAPI = <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember <@> mkNamedAPI @"update-team-member" updateTeamMember <@> mkNamedAPI @"get-team-members-csv" Export.getTeamMembersCSV + <@> mkNamedAPI @"remove-team-collaborator" removeTeamCollaborator diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index e51ab03a5c..99d609ba92 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -52,6 +52,8 @@ module Galley.API.Teams ensureNotTooLargeForLegalHold, ensureNotTooLargeToActivateLegalHold, internalDeleteBindingTeam, + removeTeamCollaborator, + uncheckedLeaveTeams, ) where @@ -76,14 +78,18 @@ import Data.Set qualified as Set import Data.Singletons import Data.Time.Clock (UTCTime) import Galley.API.Action +import Galley.API.Cells (shouldPushToCells) import Galley.API.Error as Galley import Galley.API.LegalHold.Team +import Galley.API.MLS.Removal (RemoveUserIncludeMain (..), removeUser) +import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue import Galley.API.Update qualified as API import Galley.API.Util import Galley.App import Galley.Effects +import Galley.Effects.BackendNotificationQueueAccess (enqueueNotification) import Galley.Effects.ExternalAccess qualified as E import Galley.Effects.LegalHoldStore qualified as Data import Galley.Effects.Queue qualified as E @@ -95,22 +101,34 @@ import Galley.Intra.Journal qualified as Journal import Galley.Options import Galley.Types.Teams import Imports hiding (forkIO) +import Network.AMQP qualified as Q import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P import System.Logger qualified as Log -import Wire.API.Conversation (ConversationRemoveMembers (..)) +import Wire.API.Conversation (ConvIdsPage, ConvType (..), ConversationRemoveMembers (..), pattern GetPaginatedConversationIds) +import Wire.API.Conversation.Action + ( SomeConversationAction (..), + ) import Wire.API.Conversation.Role (wireConvRoles) import Wire.API.Conversation.Role qualified as Public import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Event.Conversation (EventData (EdMembersLeave)) import Wire.API.Event.Conversation qualified as Conv import Wire.API.Event.LeaveReason import Wire.API.Event.Team +import Wire.API.Federation.API + ( fedQueueClient, + sendBundle, + ) +import Wire.API.Federation.API.Galley.Notifications (ConversationUpdate (..), GalleyNotificationTag (OnUserDeletedConversationsTag), UserDeletedConversationsNotification (..), UserDeletedNotificationMaxConvs) +import Wire.API.Federation.API.Util (makeConversationUpdateBundle) import Wire.API.Federation.Error +import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.Internal.Galley.TeamsIntra -import Wire.API.Routes.MultiTablePaging (MultiTablePage (MultiTablePage), MultiTablePagingState (mtpsState)) +import Wire.API.Routes.MultiTablePaging (MultiTablePage (..), MultiTablePagingState (mtpsState)) import Wire.API.Routes.Public.Galley.TeamMember import Wire.API.Team import Wire.API.Team qualified as Public @@ -134,6 +152,7 @@ import Wire.Sem.Now import Wire.Sem.Now qualified as Now import Wire.Sem.Paging.Cassandra import Wire.StoredConversation +import Wire.StoredConversation qualified as Data import Wire.TeamCollaboratorsSubsystem import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem @@ -1297,3 +1316,185 @@ checkAdminLimit :: (Member (ErrorS 'TooManyTeamAdmins) r) => Int -> Sem r () checkAdminLimit adminCount = when (adminCount > 2000) $ throwS @'TooManyTeamAdmins + +-- | Removing a team collaborator and clean their conversations +removeTeamCollaborator :: + forall p1 r. + ( p1 ~ CassandraPaging, + Member BackendNotificationQueueAccess r, + Member ConversationStore r, + Member (Error DynError) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS NotATeamMember) r, + Member ExternalAccess r, + Member NotificationSubsystem r, + Member (Input Env) r, + Member (Input Opts) r, + Member Now r, + Member (ListItems p1 ConvId) r, + Member (ListItems p1 (Remote ConvId)) r, + Member ProposalStore r, + Member P.TinyLog r, + Member Random r, + Member TeamFeatureStore r, + Member TeamStore r, + Member TeamCollaboratorsSubsystem r, + Member BrigAPIAccess r + ) => + Local UserId -> + TeamId -> + UserId -> + Sem r () +removeTeamCollaborator lusr tid rusr = do + P.debug $ + Log.field "targets" (toByteString rusr) + . Log.field "action" (Log.val "Teams.removeTeamCollaborator") + zusrMember <- E.getTeamMember tid (tUnqualified lusr) + void $ permissionCheck RemoveTeamMember zusrMember + uncheckedLeaveTeams (lusr $> rusr) Nothing [tid] + +uncheckedLeaveTeams :: + forall p1 r. + ( p1 ~ CassandraPaging, + Member BackendNotificationQueueAccess r, + Member ConversationStore r, + Member (Error DynError) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member ExternalAccess r, + Member NotificationSubsystem r, + Member (Input Env) r, + Member (Input Opts) r, + Member Now r, + Member (ListItems p1 ConvId) r, + Member (ListItems p1 (Remote ConvId)) r, + Member ProposalStore r, + Member P.TinyLog r, + Member Random r, + Member TeamFeatureStore r, + Member TeamStore r, + Member TeamCollaboratorsSubsystem r, + Member BrigAPIAccess r + ) => + Local UserId -> + Maybe ConnId -> + [TeamId] -> + Sem r () +uncheckedLeaveTeams lusr conn tids = do + let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + forM_ tids $ \tid -> do + toNotify <- + handleImpossibleErrors $ + getFeatureForTeam @LimitedEventFanoutConfig tid + >>= ( \case + FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid + FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid + ) + . (.status) + uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify + + allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) + contacts <- E.getContactList (tUnqualified lusr) + goConvPages contacts nRange1000 allConvIds + where + goConvPages :: [UserId] -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () + goConvPages contacts range page = do + let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) + leaveLocalConversations contacts localConvs + traverse_ leaveRemoteConversations (rangedChunks remoteConvs) + when (mtpHasMore page) $ do + let nextState = mtpPagingState page + nextQuery = GetPaginatedConversationIds (Just nextState) range + newCids <- Query.conversationIdsPageFrom lusr nextQuery + goConvPages contacts range newCids + + -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this + -- point: the user is a team member because we fetched the list of teams + -- they are member of, and conversely the list of teams was fetched exactly + -- for this user so it cannot be that the team is not found. Therefore, this + -- helper just drops the errors. + handleImpossibleErrors :: + Sem + ( ErrorS 'NotATeamMember + ': ErrorS 'TeamNotFound + ': r + ) + a -> + Sem r a + handleImpossibleErrors action = + mapToDynamicError @'TeamNotFound (mapToDynamicError @'NotATeamMember action) + + leaveLocalConversations :: [UserId] -> [ConvId] -> Sem r () + leaveLocalConversations contacts ids = do + let qUser = tUntagged lusr + cc <- E.getConversations ids + now <- Now.get + pp <- for cc $ \c -> case Data.convType c of + SelfConv -> pure Nothing + One2OneConv -> do + localMembers <- E.getLocalMembers c.id_ + if any (flip notElem (tUnqualified lusr : contacts) . (.id_)) localMembers + then E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing + else E.deleteConversation c.id_ $> Nothing + ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing + RegularConv + | tUnqualified lusr `isMember` c.localMembers -> do + runError (removeUser (qualifyAs lusr c) RemoveUserIncludeMain (tUntagged lusr)) >>= \case + Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) + Right _ -> pure () + E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) + Just <$> notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c + | otherwise -> pure Nothing + + pushNotifications (catMaybes pp) + + notifyRemoteMembersAndPrepareLocalMembersLeft :: UTCTime -> Qualified UserId -> StoredConversation -> Sem r Push + notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c = do + let e = + Conv.Event + { evtConv = tUntagged (qualifyAs lusr c.id_), + evtSubConv = Nothing, + evtFrom = tUntagged lusr, + evtTime = now, + evtTeam = Nothing, + evtData = EdMembersLeave EdReasonDeleted (U.QualifiedUserIdList [qUser]) + } + for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c + pure $ + def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = map localMemberToRecipient c.localMembers, + isCellsEvent = shouldPushToCells c.metadata e, + conn, + route = PushV2.RouteDirect + } + + -- FUTUREWORK: This could be optimized to reduce the number of RPCs + -- made. When a team is deleted the burst of RPCs created here could + -- lead to performance issues. We should cover this in a performance + -- test. + notifyRemoteMembers :: UTCTime -> Qualified UserId -> StoredConversation -> Remote [UserId] -> Sem r () + notifyRemoteMembers now qUser c remotes = do + let cid = c.id_ + convUpdate = + ConversationUpdate + { time = now, + origUserId = qUser, + convId = cid, + alreadyPresentUsers = tUnqualified remotes, + action = SomeConversationAction (sing @'ConversationLeaveTag) (), + extraConversationData = def + } + enqueueNotification Q.Persistent remotes $ do + makeConversationUpdateBundle convUpdate + >>= sendBundle + + leaveRemoteConversations :: Range 1 UserDeletedNotificationMaxConvs [Remote ConvId] -> Sem r () + leaveRemoteConversations cids = + for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do + let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) + let rpc = fedQueueClient @'OnUserDeletedConversationsTag userDelete + enqueueNotification Q.Persistent remoteConvs rpc diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index dda3fdf348..a071d02a5b 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -64,7 +64,6 @@ import Galley.Cassandra.Services import Galley.Cassandra.Team import Galley.Cassandra.TeamFeatures import Galley.Cassandra.TeamNotifications -import Galley.ConversationsSubsystem (interpretConversationsSubsystemCassandra) import Galley.Effects import Galley.Effects.FireAndForget import Galley.Env @@ -275,6 +274,8 @@ evalGalley e = . runInputConst e . runInputConst (e ^. hasqlPool) . runInputConst (e ^. cstate) + . mapError toResponse + . mapError toResponse . mapError rateLimitExceededToHttpError . mapError toResponse -- DynError . interpretTinyLog e @@ -311,12 +312,11 @@ evalGalley e = . interpretFederatorAccess . runRpcWithHttp (e ^. manager) (e ^. reqId) . runGundeckAPIAccess (e ^. options . gundeck) - . interpretBrigAccess (e ^. brig) - . interpretConversationsSubsystemCassandra . interpretTeamSubsystem . runNotificationSubsystemGundeck (notificationSubsystemConfig e) . interpretTeamCollaboratorsSubsystem . interpretSparAccess + . interpretBrigAccess (e ^. brig) . interpretExternalAccess where lh = view (options . settings . featureFlags . to npProject) e diff --git a/services/galley/src/Galley/ConversationsSubsystem.hs b/services/galley/src/Galley/ConversationsSubsystem.hs deleted file mode 100644 index b734ec3663..0000000000 --- a/services/galley/src/Galley/ConversationsSubsystem.hs +++ /dev/null @@ -1,70 +0,0 @@ -module Galley.ConversationsSubsystem - ( interpretConversationsSubsystemCassandra, - ) -where - -import Cassandra -import Cassandra.Exec -import Conduit -import Data.Id -import Galley.Cassandra.Store (embedClient) -import Galley.Cassandra.Util (logEffect) -import Imports -import Polysemy -import Polysemy.Input -import Polysemy.TinyLog (TinyLog) -import UnliftIO.Async (pooledForConcurrentlyN) -import Wire.API.Conversation (ConvType (..)) -import Wire.API.Team.Conversation (LeavingConversations, newLeavingConversations) -import Wire.BrigAPIAccess qualified as E -import Wire.ConversationStore.Cassandra (members) -import Wire.ConversationStore.Cassandra.Queries (selectConv, selectUserConvs) -import Wire.ConversationsSubsystem -import Wire.StoredConversation qualified - -interpretConversationsSubsystemCassandra :: - ( Member (Embed IO) r, - Member (Input ClientState) r, - Member E.BrigAPIAccess r, - Member TinyLog r - ) => - InterpreterFor ConversationsSubsystem r -interpretConversationsSubsystemCassandra = - interpret $ - \case - InternalLeavingConversationsFrom tid uid -> do - logEffect "ConversationsSubsystem.internalLeavingConversationsFrom" - contacts <- E.getContactList uid - embedClient $ leavingConversationsFromImpl tid uid contacts - -leavingConversationsFromImpl :: TeamId -> UserId -> [UserId] -> Client LeavingConversations -leavingConversationsFromImpl tid uid contacts = - fmap (uncurry newLeavingConversations) $ - runConduit $ - paginateWithStateC listConversationsIds - .| mapMC performFilter - .| foldC - where - listConversationsIds pagingState = - fmap runIdentity <$> paginateWithState selectUserConvs (paramsPagingState LocalQuorum (Identity uid) 32 pagingState) - performFilter :: [ConvId] -> Client ([ConvId], [ConvId]) - performFilter convIds = do - filteredConvIds <- - concat <$> pooledForConcurrentlyN 16 convIds performConversationsFilter - let filteredTeamConvIds = filter (\(_convId, team, _convType) -> team == Just tid) filteredConvIds - extractConv = map (\(convId, _team, _convType) -> convId) - (o2os, mlss) = - bimap extractConv extractConv $ - partition (\(_convId, _team, convType) -> convType == One2OneConv) filteredTeamConvIds - isNotConnectedToMember convId = do - localMembers <- members convId - pure $ any (flip notElem (uid : contacts) . (.id_)) localMembers - o2osUnconnected <- filterM isNotConnectedToMember o2os - pure (mlss, o2osUnconnected) - performConversationsFilter :: ConvId -> Client [(ConvId, Maybe TeamId, ConvType)] - performConversationsFilter convId = do - results <- retry x1 $ query selectConv $ params LocalQuorum (Identity convId) - pure $ - flip map results $ - \(convType, _mUserId, _mAccesses, _mRole, _mRoles, _mName, mTeam, _mDeleted, _mTimer, _mMode, _mProtocol, _mGroupId, _mEpoch, _mWriteEpoch, _mCiher, _mGroupConvType, _mChannelPerms, _mCellState, _mParentConvId) -> - (convId, mTeam, convType) diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 847f02e42b..57c132b6f5 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -88,10 +88,10 @@ import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog import Wire.API.Error +import Wire.API.Error.Galley import Wire.API.Team.Feature import Wire.BrigAPIAccess -import Wire.ConversationStore -import Wire.ConversationsSubsystem (ConversationsSubsystem) +import Wire.ConversationStore (ConversationStore) import Wire.GundeckAPIAccess import Wire.HashPassword import Wire.ListItems @@ -108,12 +108,11 @@ import Wire.TeamSubsystem (TeamSubsystem) -- All the possible high-level effects. type GalleyEffects1 = '[ ExternalAccess, + BrigAPIAccess, SparAccess, TeamCollaboratorsSubsystem, NotificationSubsystem, TeamSubsystem, - ConversationsSubsystem, - BrigAPIAccess, GundeckAPIAccess, Rpc, FederatorAccess, @@ -149,5 +148,7 @@ type GalleyEffects1 = Queue DeleteItem, TinyLog, Error DynError, - Error RateLimitExceeded + Error RateLimitExceeded, + ErrorS OperationDenied, + ErrorS 'NotATeamMember ] From 8921bbc935240cdd6c86097fb998ba7a08402eca Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 9 Sep 2025 16:45:36 +0200 Subject: [PATCH 34/50] fix: condition --- services/galley/src/Galley/API/Teams.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 99d609ba92..d2b34701ce 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -81,7 +81,9 @@ import Galley.API.Action import Galley.API.Cells (shouldPushToCells) import Galley.API.Error as Galley import Galley.API.LegalHold.Team -import Galley.API.MLS.Removal (RemoveUserIncludeMain (..), removeUser) +import Galley.API.MLS.Removal + ( RemoveUserIncludeMain (..), + ) import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue @@ -103,6 +105,7 @@ import Galley.Types.Teams import Imports hiding (forkIO) import Network.AMQP qualified as Q import Polysemy +import Galley.API.MLS.Removal(removeUser) import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P @@ -1398,6 +1401,7 @@ uncheckedLeaveTeams lusr conn tids = do allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) contacts <- E.getContactList (tUnqualified lusr) goConvPages contacts nRange1000 allConvIds + where goConvPages :: [UserId] -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () goConvPages contacts range page = do @@ -1435,9 +1439,10 @@ uncheckedLeaveTeams lusr conn tids = do SelfConv -> pure Nothing One2OneConv -> do localMembers <- E.getLocalMembers c.id_ - if any (flip notElem (tUnqualified lusr : contacts) . (.id_)) localMembers - then E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing - else E.deleteConversation c.id_ $> Nothing + when (any (flip notElem (tUnqualified lusr : contacts) . (.id_)) localMembers) $ + E.deleteConversation c.id_ + + pure Nothing ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing RegularConv | tUnqualified lusr `isMember` c.localMembers -> do From 87646c54a22d11e26751087c430da398c14f1f18 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 9 Sep 2025 19:28:13 +0200 Subject: [PATCH 35/50] fix: endpoint is on galley now --- integration/test/API/Brig.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 43205da9be..b7ef7bc465 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -1187,5 +1187,5 @@ refreshAppCookie u tid appId = do 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] + req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId] submit "DELETE" req From f9e0b314150db67052a5b92926b1f8741f9504af Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 10 Sep 2025 12:00:28 +0200 Subject: [PATCH 36/50] fix: add forgot collaborator deletion --- services/galley/src/Galley/API/Teams.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d2b34701ce..d83b3224cb 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1357,6 +1357,7 @@ removeTeamCollaborator lusr tid rusr = do zusrMember <- E.getTeamMember tid (tUnqualified lusr) void $ permissionCheck RemoveTeamMember zusrMember uncheckedLeaveTeams (lusr $> rusr) Nothing [tid] + internalRemoveTeamCollaborator rusr tid uncheckedLeaveTeams :: forall p1 r. From 3614fb68daeae0bf9dd5166554cea8f9044f44ae Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 10 Sep 2025 12:02:36 +0200 Subject: [PATCH 37/50] fix: add debug logs --- integration/test/Test/TeamCollaborators.hs | 1 + services/galley/src/Galley/API/Federation.hs | 2 ++ services/galley/src/Galley/API/Teams.hs | 3 ++- 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index a70e7548c9..661d80297f 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -178,6 +178,7 @@ testRemoveMemberInO2O = do getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" + putStrLn $ "============ target: " <> show convId Internal.getConversation convId >>= assertLabel 404 "no-conversation" getMLSOne2OneConversation charlie bob >>= assertSuccess diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 8f162bfdee..e99b22fff9 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -37,6 +37,7 @@ import Data.Set qualified as Set import Data.Singletons (SingI (..), demote, sing) import Data.Tagged import Data.Text.Lazy qualified as LT +import Debug.Trace (traceM) import Galley.API.Action import Galley.API.Error import Galley.API.MLS @@ -439,6 +440,7 @@ onUserDeleted origDomain udcn = do mconv <- E.getConversation c E.deleteMembers c (UserList [] [deletedUser]) for_ mconv $ \conv -> do + traceM $ "================== onUserDeleted: " <> show c when (isRemoteMember deletedUser (conv.remoteMembers)) $ case Data.convType conv of -- No need for a notification on One2One conv as the user is being diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d83b3224cb..b7c5edb36f 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -77,6 +77,7 @@ import Data.Range as Range import Data.Set qualified as Set import Data.Singletons import Data.Time.Clock (UTCTime) +import Debug.Trace (traceM) import Galley.API.Action import Galley.API.Cells (shouldPushToCells) import Galley.API.Error as Galley @@ -1402,10 +1403,10 @@ uncheckedLeaveTeams lusr conn tids = do allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) contacts <- E.getContactList (tUnqualified lusr) goConvPages contacts nRange1000 allConvIds - where goConvPages :: [UserId] -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () goConvPages contacts range page = do + traceM $ "================= goConvPages: " <> show (mtpResults page) let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) leaveLocalConversations contacts localConvs traverse_ leaveRemoteConversations (rangedChunks remoteConvs) From 97371d0c7d7d33ff4b67e820da258a6fd81174b7 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 10 Sep 2025 12:03:00 +0200 Subject: [PATCH 38/50] fix: ormolu --- services/galley/src/Galley/API/Teams.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index b7c5edb36f..1d31f4abba 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -82,9 +82,7 @@ import Galley.API.Action import Galley.API.Cells (shouldPushToCells) import Galley.API.Error as Galley import Galley.API.LegalHold.Team -import Galley.API.MLS.Removal - ( RemoveUserIncludeMain (..), - ) +import Galley.API.MLS.Removal (RemoveUserIncludeMain (..), removeUser) import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue @@ -106,7 +104,6 @@ import Galley.Types.Teams import Imports hiding (forkIO) import Network.AMQP qualified as Q import Polysemy -import Galley.API.MLS.Removal(removeUser) import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P From 152359e63453e47384d421260101efe96510089e Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 10 Sep 2025 16:27:34 +0200 Subject: [PATCH 39/50] fix: add debug logs --- services/galley/src/Galley/API/Query.hs | 23 +++++++++++++---------- services/galley/src/Galley/API/Teams.hs | 4 ++++ 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 0c699e8d6b..7902e604f9 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -65,6 +65,7 @@ import Data.Proxy import Data.Qualified import Data.Range import Data.Set qualified as Set +import Debug.Trace import Galley.API.Error import Galley.API.MLS import Galley.API.MLS.Enabled @@ -435,11 +436,12 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. -- remainingSize <= size and remainingSize >= 1, so it is safe to convert to Range remotePage <- remotesOnly Nothing (unsafeRange remainingSize) pure $ - remotePage - { Public.mtpResults = - Public.mtpResults (filterOut localPage) - <> Public.mtpResults remotePage - } + trace ("******************* localsAndRemotes: " <> show (Public.mtpResults (filterOut localPage))) $ + remotePage + { Public.mtpResults = + Public.mtpResults (filterOut localPage) + <> Public.mtpResults remotePage + } localsOnly :: Domain -> @@ -462,11 +464,12 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. pageToConvIdPage :: Public.LocalOrRemoteTable -> C.PageWithState (Qualified ConvId) -> Public.ConvIdsPage pageToConvIdPage table page@C.PageWithState {..} = - Public.MultiTablePage - { mtpResults = pwsResults, - mtpHasMore = C.pwsHasMore page, - mtpPagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) - } + trace ("******************* pageToConvIdPage: " <> show pwsResults) $ + Public.MultiTablePage + { mtpResults = pwsResults, + mtpHasMore = C.pwsHasMore page, + mtpPagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) + } -- MLS self-conversation of this user selfConvId = mlsSelfConvId (tUnqualified lusr) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 1d31f4abba..da8648e039 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1386,6 +1386,10 @@ uncheckedLeaveTeams :: Sem r () uncheckedLeaveTeams lusr conn tids = do let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + dbg0 <- E.listItems @CassandraPaging @ConvId (tUnqualified lusr) Nothing nRange1000 + traceM $ "****************** " <> show dbg0.pwsResults + dbg1 <- E.listItems @CassandraPaging @(Remote ConvId) (tUnqualified lusr) Nothing nRange1000 + traceM $ "****************** " <> show dbg1.pwsResults forM_ tids $ \tid -> do toNotify <- handleImpossibleErrors $ From c3cc26275f12aa926ee93a744433af84191a48da Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 10 Sep 2025 17:56:05 +0200 Subject: [PATCH 40/50] refactor: drop only conversations in teams --- services/galley/src/Galley/API/Federation.hs | 2 - services/galley/src/Galley/API/Internal.hs | 140 +++++++++++- services/galley/src/Galley/API/Query.hs | 23 +- services/galley/src/Galley/API/Teams.hs | 227 ++++--------------- 4 files changed, 180 insertions(+), 212 deletions(-) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index e99b22fff9..8f162bfdee 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -37,7 +37,6 @@ import Data.Set qualified as Set import Data.Singletons (SingI (..), demote, sing) import Data.Tagged import Data.Text.Lazy qualified as LT -import Debug.Trace (traceM) import Galley.API.Action import Galley.API.Error import Galley.API.MLS @@ -440,7 +439,6 @@ onUserDeleted origDomain udcn = do mconv <- E.getConversation c E.deleteMembers c (UserList [] [deletedUser]) for_ mconv $ \conv -> do - traceM $ "================== onUserDeleted: " <> show c when (isRemoteMember deletedUser (conv.remoteMembers)) $ case Data.convType conv of -- No need for a notification on One2One conv as the user is being diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index d66a0a94c6..b6ad084273 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -28,17 +28,22 @@ where import Control.Exception.Safe (catchAny) import Control.Lens hiding (Getter, Setter, (.=)) import Data.ByteString.UTF8 qualified as UTF8 +import Data.Default import Data.Id as Id +import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map import Data.Qualified import Data.Range import Data.Singletons +import Data.Time import Galley.API.Action +import Galley.API.Cells import Galley.API.Clients qualified as Clients import Galley.API.Create qualified as Create import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts +import Galley.API.MLS.Removal import Galley.API.One2One import Galley.API.Public.Servant import Galley.API.Query qualified as Query @@ -50,29 +55,40 @@ import Galley.API.Update qualified as Update import Galley.API.Util import Galley.App import Galley.Effects +import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.CustomBackendStore import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.ServiceStore import Galley.Effects.TeamStore +import Galley.Effects.TeamStore qualified as E import Galley.Monad import Galley.Options hiding (brig) import Galley.Queue qualified as Q import Imports hiding (head) +import Network.AMQP qualified as Q import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P import Servant import System.Logger.Class hiding (Path, name) +import System.Logger.Class qualified as Log import Wire.API.Conversation hiding (Member) +import Wire.API.Conversation.Action import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Event.Conversation +import Wire.API.Event.LeaveReason +import Wire.API.Federation.API +import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.API import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra +import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiTablePaging qualified as MTP import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) @@ -81,11 +97,14 @@ import Wire.ConversationStore import Wire.ConversationStore qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) +import Wire.Sem.Now qualified as Now import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra import Wire.StoredConversation +import Wire.StoredConversation qualified as Data import Wire.TeamCollaboratorsSubsystem import Wire.TeamSubsystem qualified as TeamSubsystem +import Wire.UserList internalAPI :: API InternalAPI GalleyEffects internalAPI = @@ -321,23 +340,124 @@ rmUser :: Member Random r, Member TeamFeatureStore r, Member TeamStore r, - Member TeamCollaboratorsSubsystem r, - Member BrigAPIAccess r + Member TeamCollaboratorsSubsystem r ) => Local UserId -> Maybe ConnId -> Sem r () rmUser lusr conn = do - let fetchTids acc page = - if null (pageItems page) - then pure acc - else do - page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound - fetchTids (pageItems page <> acc) page' + let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + tids <- listTeams (tUnqualified lusr) Nothing maxBound + leaveTeams tids + allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) + goConvPages nRange1000 allConvIds - tids <- fetchTids [] =<< listTeams (tUnqualified lusr) Nothing maxBound - uncheckedLeaveTeams lusr conn tids deleteClients (tUnqualified lusr) + where + goConvPages :: Range 1 1000 Int32 -> ConvIdsPage -> Sem r () + goConvPages range page = do + let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) + leaveLocalConversations localConvs + traverse_ leaveRemoteConversations (rangedChunks remoteConvs) + when (mtpHasMore page) $ do + let nextState = mtpPagingState page + nextQuery = GetPaginatedConversationIds (Just nextState) range + newCids <- Query.conversationIdsPageFrom lusr nextQuery + goConvPages range newCids + + leaveTeams page = for_ (pageItems page) $ \tid -> do + toNotify <- + handleImpossibleErrors $ + getFeatureForTeam @LimitedEventFanoutConfig tid + >>= ( \case + FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid + FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid + ) + . (.status) + uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify + page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound + leaveTeams page' + + -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this + -- point: the user is a team member because we fetched the list of teams + -- they are member of, and conversely the list of teams was fetched exactly + -- for this user so it cannot be that the team is not found. Therefore, this + -- helper just drops the errors. + handleImpossibleErrors :: + Sem + ( ErrorS 'NotATeamMember + ': ErrorS 'TeamNotFound + ': r + ) + a -> + Sem r a + handleImpossibleErrors action = + mapToDynamicError @'TeamNotFound (mapToDynamicError @'NotATeamMember action) + + leaveLocalConversations :: [ConvId] -> Sem r () + leaveLocalConversations ids = do + let qUser = tUntagged lusr + cc <- getConversations ids + now <- Now.get + pp <- for cc $ \c -> case Data.convType c of + SelfConv -> pure Nothing + One2OneConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing + ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing + RegularConv + | tUnqualified lusr `isMember` c.localMembers -> do + runError (removeUser (qualifyAs lusr c) RemoveUserIncludeMain (tUntagged lusr)) >>= \case + Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) + Right _ -> pure () + E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) + let e = + Event + { evtConv = tUntagged (qualifyAs lusr c.id_), + evtSubConv = Nothing, + evtFrom = tUntagged lusr, + evtTime = now, + evtTeam = Nothing, + evtData = EdMembersLeave EdReasonDeleted (QualifiedUserIdList [qUser]) + } + for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c + pure . Just $ + def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = map localMemberToRecipient c.localMembers, + isCellsEvent = shouldPushToCells c.metadata e, + conn, + route = PushV2.RouteDirect + } + | otherwise -> pure Nothing + + pushNotifications (catMaybes pp) + + -- FUTUREWORK: This could be optimized to reduce the number of RPCs + -- made. When a team is deleted the burst of RPCs created here could + -- lead to performance issues. We should cover this in a performance + -- test. + notifyRemoteMembers :: UTCTime -> Qualified UserId -> StoredConversation -> Remote [UserId] -> Sem r () + notifyRemoteMembers now qUser c remotes = do + let cid = c.id_ + convUpdate = + ConversationUpdate + { time = now, + origUserId = qUser, + convId = cid, + alreadyPresentUsers = tUnqualified remotes, + action = SomeConversationAction (sing @'ConversationLeaveTag) (), + extraConversationData = def + } + enqueueNotification Q.Persistent remotes $ do + makeConversationUpdateBundle convUpdate + >>= sendBundle + + leaveRemoteConversations :: Range 1 UserDeletedNotificationMaxConvs [Remote ConvId] -> Sem r () + leaveRemoteConversations cids = + for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do + let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) + let rpc = fedQueueClient @'OnUserDeletedConversationsTag userDelete + enqueueNotification Q.Persistent remoteConvs rpc deleteLoop :: App () deleteLoop = do diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 7902e604f9..0c699e8d6b 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -65,7 +65,6 @@ import Data.Proxy import Data.Qualified import Data.Range import Data.Set qualified as Set -import Debug.Trace import Galley.API.Error import Galley.API.MLS import Galley.API.MLS.Enabled @@ -436,12 +435,11 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. -- remainingSize <= size and remainingSize >= 1, so it is safe to convert to Range remotePage <- remotesOnly Nothing (unsafeRange remainingSize) pure $ - trace ("******************* localsAndRemotes: " <> show (Public.mtpResults (filterOut localPage))) $ - remotePage - { Public.mtpResults = - Public.mtpResults (filterOut localPage) - <> Public.mtpResults remotePage - } + remotePage + { Public.mtpResults = + Public.mtpResults (filterOut localPage) + <> Public.mtpResults remotePage + } localsOnly :: Domain -> @@ -464,12 +462,11 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. pageToConvIdPage :: Public.LocalOrRemoteTable -> C.PageWithState (Qualified ConvId) -> Public.ConvIdsPage pageToConvIdPage table page@C.PageWithState {..} = - trace ("******************* pageToConvIdPage: " <> show pwsResults) $ - Public.MultiTablePage - { mtpResults = pwsResults, - mtpHasMore = C.pwsHasMore page, - mtpPagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) - } + Public.MultiTablePage + { mtpResults = pwsResults, + mtpHasMore = C.pwsHasMore page, + mtpPagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) + } -- MLS self-conversation of this user selfConvId = mlsSelfConvId (tUnqualified lusr) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index da8648e039..e317116812 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -53,7 +53,6 @@ module Galley.API.Teams ensureNotTooLargeToActivateLegalHold, internalDeleteBindingTeam, removeTeamCollaborator, - uncheckedLeaveTeams, ) where @@ -77,20 +76,15 @@ import Data.Range as Range import Data.Set qualified as Set import Data.Singletons import Data.Time.Clock (UTCTime) -import Debug.Trace (traceM) import Galley.API.Action -import Galley.API.Cells (shouldPushToCells) import Galley.API.Error as Galley import Galley.API.LegalHold.Team -import Galley.API.MLS.Removal (RemoveUserIncludeMain (..), removeUser) -import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue import Galley.API.Update qualified as API import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess (enqueueNotification) import Galley.Effects.ExternalAccess qualified as E import Galley.Effects.LegalHoldStore qualified as Data import Galley.Effects.Queue qualified as E @@ -102,32 +96,21 @@ import Galley.Intra.Journal qualified as Journal import Galley.Options import Galley.Types.Teams import Imports hiding (forkIO) -import Network.AMQP qualified as Q import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P import System.Logger qualified as Log -import Wire.API.Conversation (ConvIdsPage, ConvType (..), ConversationRemoveMembers (..), pattern GetPaginatedConversationIds) -import Wire.API.Conversation.Action - ( SomeConversationAction (..), - ) +import Wire.API.Conversation (ConvType (..), ConversationRemoveMembers (..)) +import Wire.API.Conversation qualified import Wire.API.Conversation.Role (wireConvRoles) import Wire.API.Conversation.Role qualified as Public import Wire.API.Error import Wire.API.Error.Galley -import Wire.API.Event.Conversation (EventData (EdMembersLeave)) import Wire.API.Event.Conversation qualified as Conv import Wire.API.Event.LeaveReason import Wire.API.Event.Team -import Wire.API.Federation.API - ( fedQueueClient, - sendBundle, - ) -import Wire.API.Federation.API.Galley.Notifications (ConversationUpdate (..), GalleyNotificationTag (OnUserDeletedConversationsTag), UserDeletedConversationsNotification (..), UserDeletedNotificationMaxConvs) -import Wire.API.Federation.API.Util (makeConversationUpdateBundle) import Wire.API.Federation.Error -import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (MultiTablePage (..), MultiTablePagingState (mtpsState)) import Wire.API.Routes.Public.Galley.TeamMember @@ -153,7 +136,6 @@ import Wire.Sem.Now import Wire.Sem.Now qualified as Now import Wire.Sem.Paging.Cassandra import Wire.StoredConversation -import Wire.StoredConversation qualified as Data import Wire.TeamCollaboratorsSubsystem import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem @@ -951,27 +933,32 @@ removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove = do for_ cc $ \c -> E.getConversation c >>= \conv -> for_ conv $ \dc -> - when (remove `isMember` dc.localMembers) $ do - E.deleteMembers c (UserList [remove] []) - let (bots, allLocUsers) = localBotsAndUsers (dc.localMembers) - targets = - BotsAndMembers - (Set.fromList $ (.id_) <$> allLocUsers) - (Set.fromList $ (.id_) <$> dc.remoteMembers) - (Set.fromList bots) - void $ - notifyConversationAction - (sing @'ConversationRemoveMembersTag) - (tUntagged lusr) - True - zcon - (qualifyAs lusr dc) - targets - ( ConversationRemoveMembers - (pure . tUntagged . qualifyAs lusr $ remove) - EdReasonDeleted - ) - def + case () of + _ + | dc.metadata.cnvmType == One2OneConv -> + E.deleteConversation dc.id_ + | otherwise -> + when (remove `isMember` dc.localMembers) $ do + E.deleteMembers c (UserList [remove] []) + let (bots, allLocUsers) = localBotsAndUsers (dc.localMembers) + targets = + BotsAndMembers + (Set.fromList $ (.id_) <$> allLocUsers) + (Set.fromList $ (.id_) <$> dc.remoteMembers) + (Set.fromList bots) + void $ + notifyConversationAction + (sing @'ConversationRemoveMembersTag) + (tUntagged lusr) + True + zcon + (qualifyAs lusr dc) + targets + ( ConversationRemoveMembers + (pure . tUntagged . qualifyAs lusr $ remove) + EdReasonDeleted + ) + def getTeamConversations :: ( Member (ErrorS 'NotATeamMember) r, @@ -1320,29 +1307,21 @@ checkAdminLimit adminCount = -- | Removing a team collaborator and clean their conversations removeTeamCollaborator :: - forall p1 r. - ( p1 ~ CassandraPaging, - Member BackendNotificationQueueAccess r, + forall r. + ( Member BackendNotificationQueueAccess r, Member ConversationStore r, Member (Error DynError) r, Member (Error FederationError) r, - Member (Error InternalError) r, Member (ErrorS OperationDenied) r, Member (ErrorS NotATeamMember) r, Member ExternalAccess r, Member NotificationSubsystem r, - Member (Input Env) r, Member (Input Opts) r, Member Now r, - Member (ListItems p1 ConvId) r, - Member (ListItems p1 (Remote ConvId)) r, - Member ProposalStore r, Member P.TinyLog r, - Member Random r, Member TeamFeatureStore r, Member TeamStore r, - Member TeamCollaboratorsSubsystem r, - Member BrigAPIAccess r + Member TeamCollaboratorsSubsystem r ) => Local UserId -> TeamId -> @@ -1354,69 +1333,17 @@ removeTeamCollaborator lusr tid rusr = do . Log.field "action" (Log.val "Teams.removeTeamCollaborator") zusrMember <- E.getTeamMember tid (tUnqualified lusr) void $ permissionCheck RemoveTeamMember zusrMember - uncheckedLeaveTeams (lusr $> rusr) Nothing [tid] + toNotify <- + handleImpossibleErrors $ + getFeatureForTeam @LimitedEventFanoutConfig tid + >>= ( \case + FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid + FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid + ) + . (.status) + uncheckedDeleteTeamMember lusr Nothing tid (tUnqualified lusr) toNotify internalRemoveTeamCollaborator rusr tid - -uncheckedLeaveTeams :: - forall p1 r. - ( p1 ~ CassandraPaging, - Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error DynError) r, - Member (Error FederationError) r, - Member (Error InternalError) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, - Member Now r, - Member (ListItems p1 ConvId) r, - Member (ListItems p1 (Remote ConvId)) r, - Member ProposalStore r, - Member P.TinyLog r, - Member Random r, - Member TeamFeatureStore r, - Member TeamStore r, - Member TeamCollaboratorsSubsystem r, - Member BrigAPIAccess r - ) => - Local UserId -> - Maybe ConnId -> - [TeamId] -> - Sem r () -uncheckedLeaveTeams lusr conn tids = do - let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 - dbg0 <- E.listItems @CassandraPaging @ConvId (tUnqualified lusr) Nothing nRange1000 - traceM $ "****************** " <> show dbg0.pwsResults - dbg1 <- E.listItems @CassandraPaging @(Remote ConvId) (tUnqualified lusr) Nothing nRange1000 - traceM $ "****************** " <> show dbg1.pwsResults - forM_ tids $ \tid -> do - toNotify <- - handleImpossibleErrors $ - getFeatureForTeam @LimitedEventFanoutConfig tid - >>= ( \case - FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid - FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid - ) - . (.status) - uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify - - allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) - contacts <- E.getContactList (tUnqualified lusr) - goConvPages contacts nRange1000 allConvIds where - goConvPages :: [UserId] -> Range 1 1000 Int32 -> ConvIdsPage -> Sem r () - goConvPages contacts range page = do - traceM $ "================= goConvPages: " <> show (mtpResults page) - let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) - leaveLocalConversations contacts localConvs - traverse_ leaveRemoteConversations (rangedChunks remoteConvs) - when (mtpHasMore page) $ do - let nextState = mtpPagingState page - nextQuery = GetPaginatedConversationIds (Just nextState) range - newCids <- Query.conversationIdsPageFrom lusr nextQuery - goConvPages contacts range newCids - -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this -- point: the user is a team member because we fetched the list of teams -- they are member of, and conversely the list of teams was fetched exactly @@ -1432,77 +1359,3 @@ uncheckedLeaveTeams lusr conn tids = do Sem r a handleImpossibleErrors action = mapToDynamicError @'TeamNotFound (mapToDynamicError @'NotATeamMember action) - - leaveLocalConversations :: [UserId] -> [ConvId] -> Sem r () - leaveLocalConversations contacts ids = do - let qUser = tUntagged lusr - cc <- E.getConversations ids - now <- Now.get - pp <- for cc $ \c -> case Data.convType c of - SelfConv -> pure Nothing - One2OneConv -> do - localMembers <- E.getLocalMembers c.id_ - when (any (flip notElem (tUnqualified lusr : contacts) . (.id_)) localMembers) $ - E.deleteConversation c.id_ - - pure Nothing - ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing - RegularConv - | tUnqualified lusr `isMember` c.localMembers -> do - runError (removeUser (qualifyAs lusr c) RemoveUserIncludeMain (tUntagged lusr)) >>= \case - Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) - Right _ -> pure () - E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) - Just <$> notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c - | otherwise -> pure Nothing - - pushNotifications (catMaybes pp) - - notifyRemoteMembersAndPrepareLocalMembersLeft :: UTCTime -> Qualified UserId -> StoredConversation -> Sem r Push - notifyRemoteMembersAndPrepareLocalMembersLeft now qUser c = do - let e = - Conv.Event - { evtConv = tUntagged (qualifyAs lusr c.id_), - evtSubConv = Nothing, - evtFrom = tUntagged lusr, - evtTime = now, - evtTeam = Nothing, - evtData = EdMembersLeave EdReasonDeleted (U.QualifiedUserIdList [qUser]) - } - for_ (bucketRemote (fmap (.id_) c.remoteMembers)) $ notifyRemoteMembers now qUser c - pure $ - def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = map localMemberToRecipient c.localMembers, - isCellsEvent = shouldPushToCells c.metadata e, - conn, - route = PushV2.RouteDirect - } - - -- FUTUREWORK: This could be optimized to reduce the number of RPCs - -- made. When a team is deleted the burst of RPCs created here could - -- lead to performance issues. We should cover this in a performance - -- test. - notifyRemoteMembers :: UTCTime -> Qualified UserId -> StoredConversation -> Remote [UserId] -> Sem r () - notifyRemoteMembers now qUser c remotes = do - let cid = c.id_ - convUpdate = - ConversationUpdate - { time = now, - origUserId = qUser, - convId = cid, - alreadyPresentUsers = tUnqualified remotes, - action = SomeConversationAction (sing @'ConversationLeaveTag) (), - extraConversationData = def - } - enqueueNotification Q.Persistent remotes $ do - makeConversationUpdateBundle convUpdate - >>= sendBundle - - leaveRemoteConversations :: Range 1 UserDeletedNotificationMaxConvs [Remote ConvId] -> Sem r () - leaveRemoteConversations cids = - for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do - let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) - let rpc = fedQueueClient @'OnUserDeletedConversationsTag userDelete - enqueueNotification Q.Persistent remoteConvs rpc From 6be848590142d7827032ff3337d88c5ab0953f67 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 11 Sep 2025 01:27:06 +0200 Subject: [PATCH 41/50] fix: drop debug logs --- integration/test/Test/TeamCollaborators.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 661d80297f..a70e7548c9 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -178,7 +178,6 @@ testRemoveMemberInO2O = do getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected" postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" - putStrLn $ "============ target: " <> show convId Internal.getConversation convId >>= assertLabel 404 "no-conversation" getMLSOne2OneConversation charlie bob >>= assertSuccess From 523916344e1a81c282334565b0dae0a9525bc501 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 12 Sep 2025 15:12:59 +0200 Subject: [PATCH 42/50] fix: working --- integration/test/Test/TeamCollaborators.hs | 33 +++++++++++++++++++--- services/galley/src/Galley/API/Teams.hs | 2 +- 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index a70e7548c9..5657552452 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -157,8 +157,8 @@ testImplicitConnectionNoCollaborator = do -- Alice and Bob aren't connected at all. postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" -testRemoveMemberInO2O :: (HasCallStack) => App () -testRemoveMemberInO2O = do +testRemoveMemberInTeamsO2O :: (HasCallStack) => App () +testRemoveMemberInTeamsO2O = do (owner0, team0, [alice]) <- createTeam OwnDomain 2 (owner1, team1, [bob]) <- createTeam OwnDomain 2 @@ -197,6 +197,32 @@ testRemoveMemberInO2OConnected = do getMLSOne2OneConversation bob alice >>= assertSuccess +testRemoveMemberInO2O :: (HasCallStack) => App () +testRemoveMemberInO2O = 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 + + teamConvId <- + postOne2OneConversation bob alice team0 "chit-chat" `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "qualified_id" + Internal.getConversation teamConvId >>= assertSuccess + + connectTwoUsers alice bob + personalConvId <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201 + Internal.getConversation personalConvId >>= assertSuccess + + removeTeamCollaborator owner0 team0 bob >>= assertSuccess + + postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" + Internal.getConversation teamConvId >>= assertLabel 404 "no-conversation" + + getMLSOne2OneConversation bob alice >>= assertSuccess + Internal.getConversation personalConvId >>= assertSuccess + testRemoveMemberInTeamConversation :: (HasCallStack) => App () testRemoveMemberInTeamConversation = do (owner, team, [alice, bob]) <- createTeam OwnDomain 3 @@ -210,8 +236,7 @@ testRemoveMemberInTeamConversation = do withWebSockets [owner, alice] $ \[wsOwner, wsAlice] -> do removeTeamCollaborator owner team bob >>= assertSuccess - bobId <- bob %. "qualified_id" - bobUnqualifiedId <- bobId %. "id" + bobUnqualifiedId <- bob %. "qualified_id.id" let checkEvent :: (MakesValue a) => a -> App () checkEvent evt = do evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index e317116812..e7acc8f0c7 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1341,7 +1341,7 @@ removeTeamCollaborator lusr tid rusr = do FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid ) . (.status) - uncheckedDeleteTeamMember lusr Nothing tid (tUnqualified lusr) toNotify + uncheckedDeleteTeamMember lusr Nothing tid rusr toNotify internalRemoveTeamCollaborator rusr tid where -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this From c585a07b894c53c1a640e310b0e0a00e2cfae025 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 17 Sep 2025 10:44:59 +0200 Subject: [PATCH 43/50] refactor: Leif feedback --- integration/test/Test/TeamCollaborators.hs | 19 +++--- .../API/Routes/Public/Galley/TeamMember.hs | 2 +- services/galley/src/Galley/API/Teams.hs | 60 +++++++++++-------- 3 files changed, 45 insertions(+), 36 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 5657552452..3c6c107d3e 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -157,8 +157,8 @@ testImplicitConnectionNoCollaborator = do -- Alice and Bob aren't connected at all. postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member" -testRemoveMemberInTeamsO2O :: (HasCallStack) => App () -testRemoveMemberInTeamsO2O = do +testRemoveCollaboratorInTeamsO2O :: (HasCallStack) => App () +testRemoveCollaboratorInTeamsO2O = do (owner0, team0, [alice]) <- createTeam OwnDomain 2 (owner1, team1, [bob]) <- createTeam OwnDomain 2 @@ -181,8 +181,8 @@ testRemoveMemberInTeamsO2O = do Internal.getConversation convId >>= assertLabel 404 "no-conversation" getMLSOne2OneConversation charlie bob >>= assertSuccess -testRemoveMemberInO2OConnected :: (HasCallStack) => App () -testRemoveMemberInO2OConnected = do +testRemoveCollaboratorInO2OConnected :: (HasCallStack) => App () +testRemoveCollaboratorInO2OConnected = do (owner0, team0, [alice]) <- createTeam OwnDomain 2 -- At the time of writing, it wasn't clear if this should be a bot instead. @@ -197,8 +197,8 @@ testRemoveMemberInO2OConnected = do getMLSOne2OneConversation bob alice >>= assertSuccess -testRemoveMemberInO2O :: (HasCallStack) => App () -testRemoveMemberInO2O = do +testRemoveCollaboratorInO2O :: (HasCallStack) => App () +testRemoveCollaboratorInO2O = do (owner0, team0, [alice]) <- createTeam OwnDomain 2 -- At the time of writing, it wasn't clear if this should be a bot instead. @@ -223,8 +223,8 @@ testRemoveMemberInO2O = do getMLSOne2OneConversation bob alice >>= assertSuccess Internal.getConversation personalConvId >>= assertSuccess -testRemoveMemberInTeamConversation :: (HasCallStack) => App () -testRemoveMemberInTeamConversation = do +testRemoveCollaboratorInTeamConversation :: (HasCallStack) => App () +testRemoveCollaboratorInTeamConversation = do (owner, team, [alice, bob]) <- createTeam OwnDomain 3 conv <- @@ -233,7 +233,7 @@ testRemoveMemberInTeamConversation = do defProteus {team = Just team, qualifiedUsers = [alice, bob]} >>= getJSON 201 - withWebSockets [owner, alice] $ \[wsOwner, wsAlice] -> do + withWebSockets [owner, alice, bob] $ \[wsOwner, wsAlice, wsBob] -> do removeTeamCollaborator owner team bob >>= assertSuccess bobUnqualifiedId <- bob %. "qualified_id.id" @@ -244,6 +244,7 @@ testRemoveMemberInTeamConversation = do evt %. "transient" `shouldMatch` True awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkEvent + awaitMatch isTeamMemberLeaveNotif wsBob >>= checkEvent assertNoEvent 0 wsAlice getConversation alice conv `bindResponse` \resp -> do diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index da315661ed..c97b103f46 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -210,7 +210,7 @@ type TeamMemberAPI = :<|> Named "remove-team-collaborator" ( Summary "Remove a collaborator from the team." - :> From 'V11 + :> From 'V12 :> ZLocalUser :> "teams" :> Capture "tid" TeamId diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index e7acc8f0c7..2839b87add 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -933,32 +933,31 @@ removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove = do for_ cc $ \c -> E.getConversation c >>= \conv -> for_ conv $ \dc -> - case () of - _ - | dc.metadata.cnvmType == One2OneConv -> - E.deleteConversation dc.id_ - | otherwise -> - when (remove `isMember` dc.localMembers) $ do - E.deleteMembers c (UserList [remove] []) - let (bots, allLocUsers) = localBotsAndUsers (dc.localMembers) - targets = - BotsAndMembers - (Set.fromList $ (.id_) <$> allLocUsers) - (Set.fromList $ (.id_) <$> dc.remoteMembers) - (Set.fromList bots) - void $ - notifyConversationAction - (sing @'ConversationRemoveMembersTag) - (tUntagged lusr) - True - zcon - (qualifyAs lusr dc) - targets - ( ConversationRemoveMembers - (pure . tUntagged . qualifyAs lusr $ remove) - EdReasonDeleted - ) - def + case dc.metadata.cnvmType of + One2OneConv -> + E.deleteConversation dc.id_ + _ -> + when (remove `isMember` dc.localMembers) $ do + E.deleteMembers c (UserList [remove] []) + let (bots, allLocUsers) = localBotsAndUsers (dc.localMembers) + targets = + BotsAndMembers + (Set.fromList $ (.id_) <$> allLocUsers) + (Set.fromList $ (.id_) <$> dc.remoteMembers) + (Set.fromList bots) + void $ + notifyConversationAction + (sing @'ConversationRemoveMembersTag) + (tUntagged lusr) + True + zcon + (qualifyAs lusr dc) + targets + ( ConversationRemoveMembers + (pure . tUntagged . qualifyAs lusr $ remove) + EdReasonDeleted + ) + def getTeamConversations :: ( Member (ErrorS 'NotATeamMember) r, @@ -1343,6 +1342,15 @@ removeTeamCollaborator lusr tid rusr = do . (.status) uncheckedDeleteTeamMember lusr Nothing tid rusr toNotify internalRemoveTeamCollaborator rusr tid + now <- Now.get + let e = newEvent tid now (EdCollaboratorRemove rusr) + pushNotifications + [ def + { origin = Just $ tUnqualified lusr, + json = toJSONObject e, + recipients = [userRecipient $ tUnqualified lusr] + } + ] where -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this -- point: the user is a team member because we fetched the list of teams From 14c857a4dc345fae31b889e83b05cf07cb62b365 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Thu, 18 Sep 2025 11:35:30 +0200 Subject: [PATCH 44/50] fix: send collaborator removal event to all members --- integration/test/Notifications.hs | 3 +++ integration/test/Test/TeamCollaborators.hs | 18 ++++++++++++------ services/galley/src/Galley/API/Teams.hs | 16 +++++++++------- 3 files changed, 24 insertions(+), 13 deletions(-) diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 65812df202..e8750db569 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -195,6 +195,9 @@ isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave" isTeamCollaboratorAddedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isTeamCollaboratorAddedNotif = notifTypeIsEqual "team.collaborator-add" +isTeamCollaboratorRemovededNotif :: (HasCallStack, MakesValue a) => a -> App Bool +isTeamCollaboratorRemovededNotif = notifTypeIsEqual "team.collaborator-remove" + isUserActivateNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserActivateNotif = notifTypeIsEqual "user.activate" diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 3c6c107d3e..f3a5b89720 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -4,7 +4,7 @@ import API.Brig import API.Galley import qualified API.GalleyInternal as Internal import Data.Tuple.Extra -import Notifications (isTeamCollaboratorAddedNotif, isTeamMemberLeaveNotif) +import Notifications (isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovededNotif, isTeamMemberLeaveNotif) import SetupHelpers import Testlib.Prelude @@ -237,15 +237,21 @@ testRemoveCollaboratorInTeamConversation = do removeTeamCollaborator owner team bob >>= assertSuccess bobUnqualifiedId <- bob %. "qualified_id.id" - let checkEvent :: (MakesValue a) => a -> App () - checkEvent evt = do + let checkLeaveEvent :: (MakesValue a) => a -> App () + checkLeaveEvent evt = do evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId evt %. "payload.0.team" `shouldMatch` team evt %. "transient" `shouldMatch` True + checkRemoveEvent :: (MakesValue a) => a -> App () + checkRemoveEvent evt = do + evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId + evt %. "payload.0.team" `shouldMatch` team + evt %. "transient" `shouldMatch` False - awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkEvent - awaitMatch isTeamMemberLeaveNotif wsBob >>= checkEvent - assertNoEvent 0 wsAlice + awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkLeaveEvent + awaitMatch isTeamMemberLeaveNotif wsBob >>= checkLeaveEvent + awaitMatch isTeamCollaboratorRemovededNotif wsOwner >>= checkRemoveEvent + awaitMatch isTeamCollaboratorRemovededNotif wsAlice >>= checkRemoveEvent getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 2839b87add..7ec91ba3bb 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -111,6 +111,7 @@ import Wire.API.Event.Conversation qualified as Conv import Wire.API.Event.LeaveReason import Wire.API.Event.Team import Wire.API.Federation.Error +import Wire.API.Push.V2 (RecipientClients (RecipientClientsAll)) import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (MultiTablePage (..), MultiTablePagingState (mtpsState)) import Wire.API.Routes.Public.Galley.TeamMember @@ -933,11 +934,11 @@ removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove = do for_ cc $ \c -> E.getConversation c >>= \conv -> for_ conv $ \dc -> - case dc.metadata.cnvmType of - One2OneConv -> - E.deleteConversation dc.id_ - _ -> - when (remove `isMember` dc.localMembers) $ do + when (remove `isMember` dc.localMembers) $ + case dc.metadata.cnvmType of + One2OneConv -> + E.deleteConversation dc.id_ + _ -> do E.deleteMembers c (UserList [remove] []) let (bots, allLocUsers) = localBotsAndUsers (dc.localMembers) targets = @@ -1331,7 +1332,7 @@ removeTeamCollaborator lusr tid rusr = do Log.field "targets" (toByteString rusr) . Log.field "action" (Log.val "Teams.removeTeamCollaborator") zusrMember <- E.getTeamMember tid (tUnqualified lusr) - void $ permissionCheck RemoveTeamMember zusrMember + void $ permissionCheck RemoveTeamCollaborator zusrMember toNotify <- handleImpossibleErrors $ getFeatureForTeam @LimitedEventFanoutConfig tid @@ -1344,11 +1345,12 @@ removeTeamCollaborator lusr tid rusr = do internalRemoveTeamCollaborator rusr tid now <- Now.get let e = newEvent tid now (EdCollaboratorRemove rusr) + members <- E.getTeamMembers tid pushNotifications [ def { origin = Just $ tUnqualified lusr, json = toJSONObject e, - recipients = [userRecipient $ tUnqualified lusr] + recipients = members <&> \m -> Recipient (m ^. userId) RecipientClientsAll } ] where From 8368ee68126119e2a03dd4e1676ed4ed137927cc Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 19 Sep 2025 17:47:01 +0200 Subject: [PATCH 45/50] refactor: code review --- integration/test/Notifications.hs | 4 ++-- integration/test/Test/TeamCollaborators.hs | 6 ++--- libs/wire-api/src/Wire/API/Event/Team.hs | 4 ++-- .../API/Routes/Public/Galley/TeamMember.hs | 2 ++ services/galley/src/Galley/API/Teams.hs | 22 ++----------------- 5 files changed, 11 insertions(+), 27 deletions(-) diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index e8750db569..3f0b697245 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -195,8 +195,8 @@ isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave" isTeamCollaboratorAddedNotif :: (HasCallStack, MakesValue a) => a -> App Bool isTeamCollaboratorAddedNotif = notifTypeIsEqual "team.collaborator-add" -isTeamCollaboratorRemovededNotif :: (HasCallStack, MakesValue a) => a -> App Bool -isTeamCollaboratorRemovededNotif = notifTypeIsEqual "team.collaborator-remove" +isTeamCollaboratorRemovedNotif :: (HasCallStack, MakesValue a) => a -> App Bool +isTeamCollaboratorRemovedNotif = notifTypeIsEqual "team.collaborator-remove" isUserActivateNotif :: (HasCallStack, MakesValue a) => a -> App Bool isUserActivateNotif = notifTypeIsEqual "user.activate" diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index f3a5b89720..f9b9c5094f 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -4,7 +4,7 @@ import API.Brig import API.Galley import qualified API.GalleyInternal as Internal import Data.Tuple.Extra -import Notifications (isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovededNotif, isTeamMemberLeaveNotif) +import Notifications (isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovedNotif, isTeamMemberLeaveNotif) import SetupHelpers import Testlib.Prelude @@ -250,8 +250,8 @@ testRemoveCollaboratorInTeamConversation = do awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkLeaveEvent awaitMatch isTeamMemberLeaveNotif wsBob >>= checkLeaveEvent - awaitMatch isTeamCollaboratorRemovededNotif wsOwner >>= checkRemoveEvent - awaitMatch isTeamCollaboratorRemovededNotif wsAlice >>= checkRemoveEvent + awaitMatch isTeamCollaboratorRemovedNotif wsOwner >>= checkRemoveEvent + awaitMatch isTeamCollaboratorRemovedNotif wsAlice >>= checkRemoveEvent getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index 5cfcde53c7..70a52ea822 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -220,11 +220,11 @@ parseEventData MemberLeave Nothing = fail "missing event data for type 'team.mem parseEventData MemberLeave (Just j) = do let f o = EdMemberLeave <$> o .: "user" withObject "member leave data" f j -parseEventData ConvCreate Nothing = fail "missing event data for type 'team.conversation-create" +parseEventData ConvCreate Nothing = fail "missing event data for type 'team.conversation-create'" parseEventData ConvCreate (Just j) = do let f o = EdConvCreate <$> o .: "conv" withObject "conversation create data" f j -parseEventData ConvDelete Nothing = fail "missing event data for type 'team.conversation-delete" +parseEventData ConvDelete Nothing = fail "missing event data for type 'team.conversation-delete'" parseEventData ConvDelete (Just j) = do let f o = EdConvDelete <$> o .: "conv" withObject "conversation delete data" f j diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index c97b103f46..7e465f1757 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -210,6 +210,8 @@ type TeamMemberAPI = :<|> Named "remove-team-collaborator" ( Summary "Remove a collaborator from the team." + :> CanThrow 'OperationDenied + :> CanThrow 'NotATeamMember :> From 'V12 :> ZLocalUser :> "teams" diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 7ec91ba3bb..4b0506d99f 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1310,7 +1310,6 @@ removeTeamCollaborator :: forall r. ( Member BackendNotificationQueueAccess r, Member ConversationStore r, - Member (Error DynError) r, Member (Error FederationError) r, Member (ErrorS OperationDenied) r, Member (ErrorS NotATeamMember) r, @@ -1334,7 +1333,6 @@ removeTeamCollaborator lusr tid rusr = do zusrMember <- E.getTeamMember tid (tUnqualified lusr) void $ permissionCheck RemoveTeamCollaborator zusrMember toNotify <- - handleImpossibleErrors $ getFeatureForTeam @LimitedEventFanoutConfig tid >>= ( \case FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid @@ -1345,27 +1343,11 @@ removeTeamCollaborator lusr tid rusr = do internalRemoveTeamCollaborator rusr tid now <- Now.get let e = newEvent tid now (EdCollaboratorRemove rusr) - members <- E.getTeamMembers tid + admins <- E.getTeamAdmins tid pushNotifications [ def { origin = Just $ tUnqualified lusr, json = toJSONObject e, - recipients = members <&> \m -> Recipient (m ^. userId) RecipientClientsAll + recipients = userRecipient rusr : map (`Recipient` RecipientClientsAll) admins } ] - where - -- The @'NotATeamMember@ and @'TeamNotFound@ errors cannot happen at this - -- point: the user is a team member because we fetched the list of teams - -- they are member of, and conversely the list of teams was fetched exactly - -- for this user so it cannot be that the team is not found. Therefore, this - -- helper just drops the errors. - handleImpossibleErrors :: - Sem - ( ErrorS 'NotATeamMember - ': ErrorS 'TeamNotFound - ': r - ) - a -> - Sem r a - handleImpossibleErrors action = - mapToDynamicError @'TeamNotFound (mapToDynamicError @'NotATeamMember action) From 2c4b431ee3a150f2f7d835a2402550fcf88a95dc Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 19 Sep 2025 18:05:27 +0200 Subject: [PATCH 46/50] fix: ormolu --- services/galley/src/Galley/API/Teams.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 4b0506d99f..652c6e1b3b 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1333,12 +1333,12 @@ removeTeamCollaborator lusr tid rusr = do zusrMember <- E.getTeamMember tid (tUnqualified lusr) void $ permissionCheck RemoveTeamCollaborator zusrMember toNotify <- - getFeatureForTeam @LimitedEventFanoutConfig tid - >>= ( \case - FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid - FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid - ) - . (.status) + getFeatureForTeam @LimitedEventFanoutConfig tid + >>= ( \case + FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid + FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid + ) + . (.status) uncheckedDeleteTeamMember lusr Nothing tid rusr toNotify internalRemoveTeamCollaborator rusr tid now <- Now.get From c711d6838665ebb0c69df87771b0dc41798c5d6f Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Fri, 19 Sep 2025 18:33:58 +0200 Subject: [PATCH 47/50] fix: drop canthrow --- libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index 7e465f1757..2477ee2ac1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -210,7 +210,6 @@ type TeamMemberAPI = :<|> Named "remove-team-collaborator" ( Summary "Remove a collaborator from the team." - :> CanThrow 'OperationDenied :> CanThrow 'NotATeamMember :> From 'V12 :> ZLocalUser From a7214754d1ccc7f1708c2c4aac104b86f60dcbc5 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 23 Sep 2025 18:20:33 +0200 Subject: [PATCH 48/50] fix: tests --- integration/test/Test/TeamCollaborators.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index f9b9c5094f..58a83bb54e 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -4,7 +4,7 @@ import API.Brig import API.Galley import qualified API.GalleyInternal as Internal import Data.Tuple.Extra -import Notifications (isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovedNotif, isTeamMemberLeaveNotif) +import Notifications (isConvLeaveNotif, isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovedNotif, isTeamMemberLeaveNotif) import SetupHelpers import Testlib.Prelude @@ -236,22 +236,26 @@ testRemoveCollaboratorInTeamConversation = do withWebSockets [owner, alice, bob] $ \[wsOwner, wsAlice, wsBob] -> do removeTeamCollaborator owner team bob >>= assertSuccess - bobUnqualifiedId <- bob %. "qualified_id.id" - let checkLeaveEvent :: (MakesValue a) => a -> App () + bobId <- bob %. "qualified_id" + bobUnqualifiedId <- bobId %. "id" + let checkLeaveEvent :: (MakesValue a, HasCallStack) => a -> App () checkLeaveEvent evt = do evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId evt %. "payload.0.team" `shouldMatch` team - evt %. "transient" `shouldMatch` True - checkRemoveEvent :: (MakesValue a) => a -> App () + checkRemoveEvent :: (MakesValue a, HasCallStack) => a -> App () checkRemoveEvent evt = do evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId evt %. "payload.0.team" `shouldMatch` team - evt %. "transient" `shouldMatch` False + checkConvLeaveEvent :: (MakesValue a, HasCallStack) => a -> App () + checkConvLeaveEvent evt = do + evt %. "payload.0.data.qualified_user_ids" `shouldMatch` [bobId] + evt %. "payload.0.team" `shouldMatch` team awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkLeaveEvent + awaitMatch isTeamMemberLeaveNotif wsAlice >>= checkRemoveEvent awaitMatch isTeamMemberLeaveNotif wsBob >>= checkLeaveEvent awaitMatch isTeamCollaboratorRemovedNotif wsOwner >>= checkRemoveEvent - awaitMatch isTeamCollaboratorRemovedNotif wsAlice >>= checkRemoveEvent + awaitMatch isConvLeaveNotif wsAlice >>= checkConvLeaveEvent getConversation alice conv `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 From d8b1e27aedfab524238d6f6291334b6ed081cafb Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Tue, 23 Sep 2025 18:38:25 +0200 Subject: [PATCH 49/50] fix: ormolu --- integration/test/Test/TeamCollaborators.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/TeamCollaborators.hs b/integration/test/Test/TeamCollaborators.hs index 58a83bb54e..9e8050d177 100644 --- a/integration/test/Test/TeamCollaborators.hs +++ b/integration/test/Test/TeamCollaborators.hs @@ -238,7 +238,7 @@ testRemoveCollaboratorInTeamConversation = do bobId <- bob %. "qualified_id" bobUnqualifiedId <- bobId %. "id" - let checkLeaveEvent :: (MakesValue a, HasCallStack) => a -> App () + let checkLeaveEvent :: (MakesValue a, HasCallStack) => a -> App () checkLeaveEvent evt = do evt %. "payload.0.data.user" `shouldMatch` bobUnqualifiedId evt %. "payload.0.team" `shouldMatch` team From 9986c2f7c27ecb9fd147898cb245b608b79f83d4 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 24 Sep 2025 10:28:57 +0200 Subject: [PATCH 50/50] Update libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs Co-authored-by: Leif Battermann --- libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index 2477ee2ac1..f3aee85819 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -210,6 +210,7 @@ type TeamMemberAPI = :<|> Named "remove-team-collaborator" ( Summary "Remove a collaborator from the team." + :> CanThrow OperationDenied :> CanThrow 'NotATeamMember :> From 'V12 :> ZLocalUser