[FS-1534] A subconversation leaver gets a remove proposal

changelog.d/2-features/subconv-leave

@@ -1 +1 @@
-Implement endpoint for leaving a subconversation
+Implement endpoint for leaving a subconversation (#2969, #3080)

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

@@ -357,7 +357,8 @@ postMLSCommitBundleToLocalConv qusr mc conn bundle lConvOrSubId = do
     ApplicationMessage _ -> throwS @'MLSUnsupportedMessage
     ProposalMessage _ -> throwS @'MLSUnsupportedMessage
 
-  propagateMessage qusr lConvOrSub conn (rmRaw (cbCommitMsg bundle))
+  let cm = membersConvOrSub (tUnqualified lConvOrSub)
+  propagateMessage qusr lConvOrSub conn (rmRaw (cbCommitMsg bundle)) cm
 
   for_ (cbWelcome bundle) $
     postMLSWelcome lConvOrSub conn
@@ -574,7 +575,8 @@ postMLSMessageToLocalConv qusr senderClient con smsg convOrSubId = case rmValue
         Right ApplicationMessageTag -> pure mempty
         Left _ -> throwS @'MLSUnsupportedMessage
 
-    propagateMessage qusr lConvOrSub con (rmRaw smsg)
+    let cm = membersConvOrSub (tUnqualified lConvOrSub)
+    propagateMessage qusr lConvOrSub con (rmRaw smsg) cm
 
     pure events
 
@@ -833,7 +835,8 @@ processExternalCommit qusr mSenderClient lConvOrSub epoch action updatePath = wi
   -- fetch backend remove proposals of the previous epoch
   kpRefs <- getPendingBackendRemoveProposals (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub') epoch
   -- requeue backend remove proposals for the current epoch
-  createAndSendRemoveProposals lConvOrSub' kpRefs qusr
+  let cm = membersConvOrSub (tUnqualified lConvOrSub')
+  createAndSendRemoveProposals lConvOrSub' kpRefs qusr cm
   where
     derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef)
     derefUser cm user = case Map.assocs cm of

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

@@ -59,11 +59,17 @@ propagateMessage ::
   Local ConvOrSubConv ->
   Maybe ConnId ->
   ByteString ->
+  -- | The client map that has all the recipients of the message. This is an
+  -- argument, and not constructed within the function, because of a special
+  -- case of subconversations where everyone but the subconversation leaver
+  -- client should get the remove proposal message; in this case the recipients
+  -- are a strict subset of all the clients represented by the in-memory
+  -- conversation/subconversation client maps.
+  ClientMap ->
   Sem r ()
-propagateMessage qusr lConvOrSub con raw = do
+propagateMessage qusr lConvOrSub con raw cm = do
   now <- input @UTCTime
-  let cm = membersConvOrSub (tUnqualified lConvOrSub)
-      mlsConv = convOfConvOrSub <$> lConvOrSub
+  let mlsConv = convOfConvOrSub <$> lConvOrSub
       lmems = mcLocalMembers . tUnqualified $ mlsConv
       botMap = Map.fromList $ do
         m <- lmems
@@ -80,7 +86,7 @@ propagateMessage qusr lConvOrSub con raw = do
       mkPush :: UserId -> ClientId -> MessagePush 'NormalMessage
       mkPush u c = newMessagePush mlsConv botMap con mm (u, c) e
   runMessagePush mlsConv (Just qcnv) $
-    foldMap (uncurry mkPush) (lmems >>= localMemberMLSClients mlsConv cm)
+    foldMap (uncurry mkPush) (lmems >>= localMemberMLSClients mlsConv)
 
   -- send to remotes
   traverse_ handleError
@@ -92,20 +98,20 @@ propagateMessage qusr lConvOrSub con raw = do
             rmmSender = qusr,
             rmmMetadata = mm,
             rmmConversation = qUnqualified qcnv,
-            rmmRecipients = rs >>= remoteMemberMLSClients cm,
+            rmmRecipients = rs >>= remoteMemberMLSClients,
             rmmMessage = Base64ByteString raw
           }
   where
-    localMemberMLSClients :: Local x -> ClientMap -> LocalMember -> [(UserId, ClientId)]
-    localMemberMLSClients loc cm lm =
+    localMemberMLSClients :: Local x -> LocalMember -> [(UserId, ClientId)]
+    localMemberMLSClients loc lm =
       let localUserQId = tUntagged (qualifyAs loc localUserId)
           localUserId = lmId lm
        in map
             (\(c, _) -> (localUserId, c))
             (Map.assocs (Map.findWithDefault mempty localUserQId cm))
 
-    remoteMemberMLSClients :: ClientMap -> RemoteMember -> [(UserId, ClientId)]
-    remoteMemberMLSClients cm rm =
+    remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)]
+    remoteMemberMLSClients rm =
       let remoteUserQId = tUntagged (rmId rm)
           remoteUserId = qUnqualified remoteUserQId
        in map

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

@@ -68,8 +68,15 @@ createAndSendRemoveProposals ::
   Local ConvOrSubConv ->
   t KeyPackageRef ->
   Qualified UserId ->
+  -- | The client map that has all the recipients of the message. This is an
+  -- argument, and not constructed within the function, because of a special
+  -- case of subconversations where everyone but the subconversation leaver
+  -- client should get the remove proposal message; in this case the recipients
+  -- are a strict subset of all the clients represented by the in-memory
+  -- conversation/subconversation client maps.
+  ClientMap ->
   Sem r ()
-createAndSendRemoveProposals lConvOrSubConv cs qusr = do
+createAndSendRemoveProposals lConvOrSubConv cs qusr cm = do
   let meta = mlsMetaConvOrSub (tUnqualified lConvOrSubConv)
   mKeyPair <- getMLSRemovalKey
   case mKeyPair of
@@ -86,7 +93,7 @@ createAndSendRemoveProposals lConvOrSubConv cs qusr = do
           (proposalRef (cnvmlsCipherSuite meta) proposal)
           ProposalOriginBackend
           proposal
-        propagateMessage qusr lConvOrSubConv Nothing msgEncoded
+        propagateMessage qusr lConvOrSubConv Nothing msgEncoded cm
 
 -- | Send remove proposals for a single client of a user to the local conversation.
 removeClient ::
@@ -113,7 +120,8 @@ removeClient lc qusr cid = do
   for_ mMlsConv $ \mlsConv -> do
     -- FUTUREWORK: also remove the client from from subconversations of lc
     let cidAndKPs = maybeToList (cmLookupRef (mkClientIdentity qusr cid) (mcMembers mlsConv))
-    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr
+        cm = mcMembers mlsConv
+    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr cm
 
 -- | Send remove proposals for all clients of the user to the local conversation.
 removeUser ::
@@ -139,4 +147,5 @@ removeUser lc qusr = do
   for_ mMlsConv $ \mlsConv -> do
     -- FUTUREWORK: also remove the client from from subconversations of lc
     let kprefs = toList (Map.findWithDefault mempty qusr (mcMembers mlsConv))
-    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) kprefs qusr
+        cm = mcMembers mlsConv
+    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) kprefs qusr cm

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

@@ -412,10 +412,13 @@ leaveLocalSubConversation cid lcnv sub = do
   kp <-
     note (mlsProtocolError "Client is not a member of the subconversation") $
       cmLookupRef cid (scMembers subConv)
+  -- remove the leaver from the member list
+  let cm = cmRemoveClient cid (scMembers subConv)
   createAndSendRemoveProposals
     (qualifyAs lcnv (SubConv mlsConv subConv))
     (Identity kp)
     (cidQualifiedUser cid)
+    cm
 
 leaveRemoteSubConversation ::
   ( Members

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

@@ -44,6 +44,13 @@ cmLookupRef cid cm = do
   clients <- Map.lookup (cidQualifiedUser cid) cm
   Map.lookup (ciClient cid) clients
 
+cmRemoveClient :: ClientIdentity -> ClientMap -> ClientMap
+cmRemoveClient cid cm = case Map.lookup (cidQualifiedUser cid) cm of
+  Nothing -> cm
+  Just clients ->
+    let clients' = Map.delete (ciClient cid) clients
+     in Map.insert (cidQualifiedUser cid) clients' cm
+
 isClientMember :: ClientIdentity -> ClientMap -> Bool
 isClientMember ci = isJust . cmLookupRef ci
 

services/galley/test/integration/API/MLS.hs

@@ -2791,6 +2791,7 @@ testLeaveSubConv = do
     (qsub, _) <- withTempMockFederator'
       ( receiveCommitMock [charlie1]
           <|> welcomeMock
+          <|> ("on-mls-message-sent" ~> RemoteMLSMessageOk)
       )
       $ do
         void $ createAddCommit alice1 [bob, charlie] >>= sendAndConsumeCommit
@@ -2805,7 +2806,7 @@ testLeaveSubConv = do
     [bob1KP] <-
       map snd . filter (\(cid, _) -> cid == bob1)
         <$> getClientsFromGroupState alice1 bob
-    mlsBracket [alice1, bob2] $ \wss -> do
+    mlsBracket [bob1, alice1, bob2] $ \(wsBob1 : wss) -> do
       (_, reqs) <- withTempMockFederator' messageSentMock $ leaveCurrentConv bob1 qsub
       req <-
         assertOne
@@ -2821,6 +2822,8 @@ testLeaveSubConv = do
         WS.assertMatchN (5 # WS.Second) wss $
           wsAssertBackendRemoveProposal bob qcnv bob1KP
       traverse_ (uncurry consumeMessage1) (zip [alice1, bob2] msgs)
+      -- assert the leaver gets no proposal or event
+      void . liftIO $ WS.assertNoEvent (5 # WS.Second) [wsBob1]
 
     -- alice commits the pending proposal
     void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle