Implement removal of clients from subconvs

services/galley/src/Galley/API/Action.hs

@@ -300,7 +300,7 @@ performAction tag origUser lconv action = do
     SConversationRemoveMembersTag -> do
       let presentVictims = filter (isConvMemberL lconv) (toList action)
       when (null presentVictims) noChanges
-      E.deleteMembers (tUnqualified lcnv) (toUserList lconv presentVictims)
+      traverse_ (convDeleteMembers (toUserList lconv presentVictims)) lconv
       pure (mempty, action) -- FUTUREWORK: should we return the filtered action here?
     SConversationMemberUpdateTag -> do
       void $ ensureOtherMember lconv (cmuTarget action) conv

services/galley/src/Galley/API/MLS/Removal.hs

@@ -34,8 +34,8 @@ import Galley.API.MLS.Types
 import qualified Galley.Data.Conversation.Types as Data
 import Galley.Effects
 import Galley.Effects.ProposalStore
+import Galley.Effects.SubConversationStore
 import Galley.Env
-import Galley.Types.UserList
 import Imports
 import Polysemy
 import Polysemy.Error
@@ -62,20 +62,20 @@ removeClientsWithClientMap ::
          Input Env
        ]
       r,
-    Traversable t
+    Foldable t
   ) =>
   Local ConvOrSubConv ->
   t KeyPackageRef ->
   Qualified UserId ->
   Sem r ()
-removeClientsWithClientMap lConvOrSubConv cs qusr = do
+removeClientsWithClientMap lConvOrSubConv kprefs qusr = do
   let meta = mlsMetaConvOrSub (tUnqualified lConvOrSubConv)
   mKeyPair <- getMLSRemovalKey
   case mKeyPair of
     Nothing -> do
       warn $ Log.msg ("No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Not able to remove client from MLS conversation." :: Text)
     Just (secKey, pubKey) -> do
-      for_ cs $ \kpref -> do
+      for_ kprefs $ \kpref -> do
         let proposal = mkRemoveProposal kpref
             msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal)
             msgEncoded = encodeMLS' msg
@@ -110,10 +110,19 @@ removeClient ::
 removeClient lc qusr cid = do
   mMlsConv <- mkMLSConversation (tUnqualified lc)
   for_ mMlsConv $ \mlsConv -> do
-    -- TODO: also remove the client from subconversations of lc
-    let cidAndKPs = maybeToList (cmLookupRef (mkClientIdentity qusr cid) (mcMembers mlsConv))
+    let cidAndKPs = cmLookupRef (mkClientIdentity qusr cid) (mcMembers mlsConv)
     removeClientsWithClientMap (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr
 
+    -- remove this client from all subconversations
+    subs <- listSubConversations (mcId mlsConv)
+    for_ subs $ \sub -> do
+      let kpmap = Map.findWithDefault mempty qusr (scMembers sub)
+      for_ (Map.lookup cid kpmap) $ \kp ->
+        removeClientsWithClientMap
+          (qualifyAs lc (SubConv mlsConv sub))
+          (Identity kp)
+          qusr
+
 -- | Send remove proposals for all clients of the user to the local conversation.
 removeUser ::
   ( Members
@@ -136,18 +145,23 @@ removeUser ::
 removeUser lc qusr = do
   mMlsConv <- mkMLSConversation (tUnqualified lc)
   for_ mMlsConv $ \mlsConv -> do
-    -- FUTUREWORK: also remove the client from from subconversations of lc
-    let kprefs = toList (Map.findWithDefault mempty qusr (mcMembers mlsConv))
+    let kprefs = Map.findWithDefault mempty qusr (mcMembers mlsConv)
     removeClientsWithClientMap (qualifyAs lc (Conv mlsConv)) kprefs qusr
 
-_subConvDeleteMembers ::
+    -- remove all clients of this user from all subconversations
+    subs <- listSubConversations (mcId mlsConv)
+    for_ subs $ \sub ->
+      for_ (Map.lookup qusr (scMembers sub)) $ \kprefs' ->
+        removeClientsWithClientMap
+          (qualifyAs lc (SubConv mlsConv sub))
+          kprefs'
+          qusr
+
+listSubConversations ::
   Member SubConversationStore r =>
-  UserList UserId ->
   ConvId ->
-  SubConvId ->
-  Sem r ()
-_subConvDeleteMembers _ _ _ = pure ()
-
--- -- remove clients from any subconversation
--- listSubConversations (Data.convId conv)
---   >>= traverse_ (subConvDeleteMembers ul (Data.convId conv))
+  Sem r [SubConversation]
+listSubConversations cid =
+  fmap catMaybes $
+    listSubConversationIds cid
+      >>= traverse (getSubConversation cid)

services/galley/src/Galley/Cassandra/SubConversation.hs

@@ -75,8 +75,8 @@ setEpochForSubConversation :: ConvId -> SubConvId -> Epoch -> Client ()
 setEpochForSubConversation cid sconv epoch =
   retry x5 (write Cql.insertEpochForSubConversation (params LocalQuorum (epoch, cid, sconv)))
 
-listSubConversations :: ConvId -> Client [SubConvId]
-listSubConversations cid =
+listSubConversationIds :: ConvId -> Client [SubConvId]
+listSubConversationIds cid =
   fmap runIdentity
     <$> retry
       x1
@@ -96,4 +96,4 @@ interpretSubConversationStoreToCassandra = interpret $ \case
   GetSubConversationPublicGroupState convId subConvId -> embedClient (selectSubConvPublicGroupState convId subConvId)
   SetGroupIdForSubConversation gId cid sconv -> embedClient $ setGroupIdForSubConversation gId cid sconv
   SetSubConversationEpoch cid sconv epoch -> embedClient $ setEpochForSubConversation cid sconv epoch
-  ListSubConversations cid -> embedClient $ listSubConversations cid
+  ListSubConversationIds cid -> embedClient $ listSubConversationIds cid

services/galley/src/Galley/Effects/SubConversationStore.hs

@@ -37,6 +37,6 @@ data SubConversationStore m a where
   GetSubConversationPublicGroupState :: ConvId -> SubConvId -> SubConversationStore m (Maybe OpaquePublicGroupState)
   SetGroupIdForSubConversation :: GroupId -> Qualified ConvId -> SubConvId -> SubConversationStore m ()
   SetSubConversationEpoch :: ConvId -> SubConvId -> Epoch -> SubConversationStore m ()
-  ListSubConversations :: ConvId -> SubConversationStore m [SubConvId]
+  ListSubConversationIds :: ConvId -> SubConversationStore m [SubConvId]
 
 makeSem ''SubConversationStore