diff --git a/changelog.d/3-bug-fixes/extra-remove-proposals b/changelog.d/3-bug-fixes/extra-remove-proposals new file mode 100644 index 00000000000..4aba01e42f2 --- /dev/null +++ b/changelog.d/3-bug-fixes/extra-remove-proposals @@ -0,0 +1 @@ +Extra remove proposals were being sent when a user was removed from a conversation diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index d8d5c530cdf..a2194ea8e1e 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -425,14 +425,14 @@ performAction tag origUser lconv action = do let victims = [origUser] lconv' <- traverse (convDeleteMembers (toUserList lconv victims)) lconv -- send remove proposals in the MLS case - traverse_ (removeUser lconv') victims + traverse_ (removeUser lconv' RemoveUserIncludeMain) victims pure (mempty, action) SConversationRemoveMembersTag -> do let presentVictims = filter (isConvMemberL lconv) (toList action) when (null presentVictims) noChanges traverse_ (convDeleteMembers (toUserList lconv presentVictims)) lconv -- send remove proposals in the MLS case - traverse_ (removeUser lconv) presentVictims + traverse_ (removeUser lconv RemoveUserExcludeMain) presentVictims pure (mempty, action) -- FUTUREWORK: should we return the filtered action here? SConversationMemberUpdateTag -> do void $ ensureOtherMember lconv (cmuTarget action) conv diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 3a22a033b23..23a7280bdfe 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -414,7 +414,7 @@ onUserDeleted origDomain udcn = do Public.SelfConv -> pure () Public.RegularConv -> do let botsAndMembers = convBotsAndMembers conv - removeUser (qualifyAs lc conv) (tUntagged deletedUser) + removeUser (qualifyAs lc conv) RemoveUserIncludeMain (tUntagged deletedUser) outcome <- runError @FederationError $ notifyConversationAction diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b33bab98ac5..97d62a76c61 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -376,7 +376,7 @@ rmUser lusr conn = do ConnectConv -> E.deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing RegularConv | tUnqualified lusr `isMember` Data.convLocalMembers c -> do - runError (removeUser (qualifyAs lusr c) (tUntagged lusr)) >>= \case + 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 (Data.convId c) (UserList [tUnqualified lusr] []) diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 3a796a75c22..deb21228e55 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -19,6 +19,7 @@ module Galley.API.MLS.Removal ( createAndSendRemoveProposals, removeExtraneousClients, removeClient, + RemoveUserIncludeMain (..), removeUser, ) where @@ -133,6 +134,31 @@ removeClientsWithClientMapRecursively lMlsConv getClients qusr = do planClientRemoval gid (fmap fst clients) createAndSendRemoveProposals mainConv (fmap snd clients) qusr cm + removeClientsFromSubConvs lMlsConv getClients qusr + +removeClientsFromSubConvs :: + ( Member (Input UTCTime) r, + Member TinyLog r, + Member BackendNotificationQueueAccess r, + Member ExternalAccess r, + Member GundeckAccess r, + Member MemberStore r, + Member ProposalStore r, + Member SubConversationStore r, + Member (Input Env) r, + Functor f, + Foldable f + ) => + Local MLSConversation -> + -- | A function returning the "list" of clients to be removed from either the + -- main conversation or each of its subconversations. + (ConvOrSubConv -> f (ClientIdentity, LeafIndex)) -> + -- | Originating user. The resulting proposals will appear to be sent by this user. + Qualified UserId -> + Sem r () +removeClientsFromSubConvs lMlsConv getClients qusr = do + let cm = mcMembers (tUnqualified lMlsConv) + -- remove this client from all subconversations subs <- listSubConversations' (mcId (tUnqualified lMlsConv)) for_ subs $ \sub -> do @@ -170,6 +196,18 @@ removeClient lc qusr c = do let getClients = fmap (cid,) . cmLookupIndex cid . (.members) removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getClients qusr +-- | A flag to determine whether 'removeUser' should operate on the parent +-- conversation as well as all the subconversations. +data RemoveUserIncludeMain + = -- | Remove user clients from all subconversations, including the parent. + RemoveUserIncludeMain + | -- | Remove user clients from all subconversations, but not the parent. + -- + -- This can be used when the clients are already in the process of being + -- removed from the main conversation, for example as a result of a commit + -- containing a remove proposal. + RemoveUserExcludeMain + -- | Send remove proposals for all clients of the user to the local conversation. removeUser :: ( Member BackendNotificationQueueAccess r, @@ -183,9 +221,10 @@ removeUser :: Member TinyLog r ) => Local Data.Conversation -> + RemoveUserIncludeMain -> Qualified UserId -> Sem r () -removeUser lc qusr = do +removeUser lc includeMain qusr = do mMlsConv <- mkMLSConversation (tUnqualified lc) for_ mMlsConv $ \mlsConv -> do let getClients :: ConvOrSubConv -> [(ClientIdentity, LeafIndex)] @@ -194,7 +233,14 @@ removeUser lc qusr = do . Map.assocs . Map.findWithDefault mempty qusr . (.members) - removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getClients qusr + case includeMain of + RemoveUserIncludeMain -> + removeClientsWithClientMapRecursively + (qualifyAs lc mlsConv) + getClients + qusr + RemoveUserExcludeMain -> + removeClientsFromSubConvs (qualifyAs lc mlsConv) getClients qusr -- | Convert cassandra subconv maps into SubConversations listSubConversations' ::