Fix extra remove proposal bug

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

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

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

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] [])

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' ::