[FS-1488] Fix self-conversation creator key package mapping

changelog.d/3-bug-fixes/mls-self-conv-creator-ref

@@ -0,0 +1 @@
+Map the MLS self-conversation creator's key package reference in Brig

services/brig/src/Brig/Data/MLS/KeyPackage.hs

@@ -186,7 +186,7 @@ keyPackageRefSetConvId ref convId = do
     q = "UPDATE mls_key_package_refs SET conv_domain = ?, conv = ? WHERE ref = ? IF EXISTS"
 
 addKeyPackageRef :: MonadClient m => KeyPackageRef -> NewKeyPackageRef -> m ()
-addKeyPackageRef ref nkpr = do
+addKeyPackageRef ref nkpr =
   retry x5 $
     write
       q
@@ -207,7 +207,9 @@ updateKeyPackageRef :: MonadClient m => KeyPackageRef -> KeyPackageRef -> m ()
 updateKeyPackageRef prevRef newRef =
   void . runMaybeT $ do
     backup <- backupKeyPackageMeta prevRef
-    lift $ restoreKeyPackageMeta newRef backup >> deleteKeyPackage prevRef
+    lift $ do
+      restoreKeyPackageMeta newRef backup
+      deleteKeyPackage prevRef
 
 --------------------------------------------------------------------------------
 -- Utilities

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

@@ -85,6 +85,9 @@ addClientH (usr ::: clt) = do
   E.createClient usr clt
   pure empty
 
+-- | Remove a client from conversations it is part of according to the
+-- conversation protocol (Proteus or MLS). In addition, remove the client from
+-- the "clients" table in Galley.
 rmClientH ::
   forall p1 r.
   ( p1 ~ CassandraPaging,

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

@@ -811,7 +811,7 @@ 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
-  removeClientsWithClientMap lConvOrSub' kpRefs qusr
+  createAndSendRemoveProposals lConvOrSub' kpRefs qusr
   where
     derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef)
     derefUser cm user = case Map.assocs cm of
@@ -923,10 +923,7 @@ processInternalCommit qusr senderClient con lConvOrSub epoch action senderRef co
             (True, SelfConv, [], Conv _) -> do
               creatorClient <- noteS @'MLSMissingSenderClient senderClient
               let creatorRef = fromMaybe senderRef updatePathRef
-              addMLSClients
-                (cnvmlsGroupId mlsMeta)
-                qusr
-                (Set.singleton (creatorClient, creatorRef))
+              updateKeyPackageMapping lConvOrSub qusr creatorClient Nothing creatorRef
             (True, SelfConv, _, _) ->
               -- this is a newly created (sub)conversation, and it should
               -- contain exactly one client (the creator)
@@ -949,13 +946,7 @@ processInternalCommit qusr senderClient con lConvOrSub epoch action senderRef co
               unless (isClientMember (mkClientIdentity qusr creatorClient) (mcMembers parentConv)) $
                 throwS @'MLSSubConvClientNotInParent
               let creatorRef = fromMaybe senderRef updatePathRef
-              addKeyPackageRef creatorRef qusr creatorClient $
-                tUntagged (convOfConvOrSub . idForConvOrSub <$> lConvOrSub)
-              addMLSClients
-                (cnvmlsGroupId mlsMeta)
-                qusr
-                (Set.singleton (creatorClient, creatorRef))
-            -- uninitialised conversations should contain exactly one client
+              updateKeyPackageMapping lConvOrSub qusr creatorClient Nothing creatorRef
             (_, _, _, _) ->
               throw (InternalErrorWithDescription "Unexpected creator client set")
           pure $ pure () -- no key package ref update necessary

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

@@ -16,7 +16,7 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Galley.API.MLS.Removal
-  ( removeClientsWithClientMap,
+  ( createAndSendRemoveProposals,
     removeClient,
     removeUser,
   )
@@ -51,7 +51,7 @@ import Wire.API.MLS.Serialisation
 import Wire.API.MLS.SubConversation
 
 -- | Send remove proposals for a set of clients to clients in the ClientMap.
-removeClientsWithClientMap ::
+createAndSendRemoveProposals ::
   ( Members
       '[ Input UTCTime,
          TinyLog,
@@ -69,7 +69,7 @@ removeClientsWithClientMap ::
   t KeyPackageRef ->
   Qualified UserId ->
   Sem r ()
-removeClientsWithClientMap lConvOrSubConv cs qusr = do
+createAndSendRemoveProposals lConvOrSubConv cs qusr = do
   let meta = mlsMetaConvOrSub (tUnqualified lConvOrSubConv)
   mKeyPair <- getMLSRemovalKey
   case mKeyPair of
@@ -113,7 +113,7 @@ 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))
-    removeClientsWithClientMap (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr
+    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr
 
 -- | Send remove proposals for all clients of the user to the local conversation.
 removeUser ::
@@ -139,4 +139,4 @@ 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))
-    removeClientsWithClientMap (qualifyAs lc (Conv mlsConv)) kprefs qusr
+    createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) kprefs qusr

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

@@ -162,6 +162,7 @@ tests s =
       testGroup
         "Backend-side External Remove Proposals"
         [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser,
+          test s "local conversation, recreate client" testBackendRemoveProposalRecreateClient,
           test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser,
           test s "local conversation, creator leaving" testBackendRemoveProposalLocalConvLocalLeaverCreator,
           test s "local conversation, local committer leaving" testBackendRemoveProposalLocalConvLocalLeaverCommitter,
@@ -1580,6 +1581,40 @@ propUnsupported = do
     -- support AppAck proposals
     postMessage alice1 msgData !!! const 201 === statusCode
 
+testBackendRemoveProposalRecreateClient :: TestM ()
+testBackendRemoveProposalRecreateClient = do
+  alice <- randomQualifiedUser
+  runMLSTest $ do
+    alice1 <- createMLSClient alice
+    (_, qcnv) <- setupMLSSelfGroup alice1
+
+    let cnv = Conv <$> qcnv
+
+    void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle
+
+    (_, ref) <- assertOne =<< getClientsFromGroupState alice1 alice
+
+    liftTest $
+      deleteClient (qUnqualified alice) (ciClient alice1) (Just defPassword)
+        !!! const 200 === statusCode
+    State.modify $ \mls ->
+      mls
+        { mlsMembers = Set.difference (mlsMembers mls) (Set.singleton alice1)
+        }
+
+    alice2 <- createMLSClient alice
+    proposal <- mlsBracket [alice2] $ \[wsA] -> do
+      void $
+        createExternalCommit alice2 Nothing cnv
+          >>= sendAndConsumeCommitBundle
+      WS.assertMatch (5 # WS.Second) wsA $
+        wsAssertBackendRemoveProposal alice qcnv ref
+
+    consumeMessage1 alice2 proposal
+    void $ createPendingProposalCommit alice2 >>= sendAndConsumeCommitBundle
+
+    void $ createApplicationMessage alice2 "hello" >>= sendAndConsumeMessage
+
 testBackendRemoveProposalLocalConvLocalUser :: TestM ()
 testBackendRemoveProposalLocalConvLocalUser = do
   [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)
@@ -2049,6 +2084,9 @@ testRemoteUserPostsCommitBundle = do
 
         pure ()
 
+-- FUTUREWORK: New clients should be adding themselves via external commits, and
+-- they shouldn't be added by another client. Change the test so external
+-- commits are used.
 testSelfConversation :: TestM ()
 testSelfConversation = do
   alice <- randomQualifiedUser