[FS-919] Support Basic Processing of External Commits

changelog.d/2-features/mls-external-commits

@@ -0,0 +1 @@
+Introduce support for external commits in MLS

libs/wire-api/src/Wire/API/MLS/Message.hs

@@ -266,7 +266,7 @@ instance SerialiseMLS (Sender 'MLSPlainText) where
   serialiseMLS (PreconfiguredSender x) = do
     serialiseMLS PreconfiguredSenderTag
     put x
-  serialiseMLS NewMemberSender = serialiseMLS NewMemberSender
+  serialiseMLS NewMemberSender = serialiseMLS NewMemberSenderTag
 
 data family MessagePayload (tag :: WireFormatTag) :: *
 

nix/pkgs/mls-test-cli/default.nix

@@ -15,11 +15,11 @@ rustPlatform.buildRustPackage rec {
   src = fetchFromGitHub {
     owner = "wireapp";
     repo = "mls-test-cli";
-    sha256 = "sha256-xYL9KNcirCARb1Rp41einOpq0ut5adlqMIAEiwYXkzg=";
-    rev = "d46624fb49c900facc8853fa86e3ecf51fd0dcdb";
+    sha256 = "sha256-/XQ/9oQTPkRqgMzDGRm+Oh9jgkdeDM1vRJ6/wEf2+bY=";
+    rev = "c6f80be2839ac1ed2894e96044541d1c3cf6ecdf";
   };
   doCheck = false;
-  cargoSha256 = "sha256-FGFyS/tLlD+3JQX7vkKq4nW+WQI1FFnpugzfFBi/eQE=";
+  cargoSha256 = "sha256-AlZrxa7f5JwxxrzFBgeFSaYU6QttsUpfLYfq1HzsdbE=";
   cargoDepsHook = ''
     mkdir -p mls-test-cli-${version}-vendor.tar.gz/ring/.git
   '';

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

@@ -119,14 +119,14 @@ postMLSMessageFromLocalUserV1 ::
          ErrorS 'ConvAccessDenied,
          ErrorS 'ConvMemberNotFound,
          ErrorS 'ConvNotFound,
+         ErrorS 'MissingLegalholdConsent,
+         ErrorS 'MLSClientSenderUserMismatch,
          ErrorS 'MLSCommitMissingReferences,
+         ErrorS 'MLSGroupConversationMismatch,
          ErrorS 'MLSProposalNotFound,
          ErrorS 'MLSSelfRemovalNotAllowed,
          ErrorS 'MLSStaleMessage,
          ErrorS 'MLSUnsupportedMessage,
-         ErrorS 'MLSClientSenderUserMismatch,
-         ErrorS 'MLSGroupConversationMismatch,
-         ErrorS 'MissingLegalholdConsent,
          Input (Local ()),
          ProposalStore,
          Resource,
@@ -152,14 +152,14 @@ postMLSMessageFromLocalUser ::
          ErrorS 'ConvAccessDenied,
          ErrorS 'ConvMemberNotFound,
          ErrorS 'ConvNotFound,
+         ErrorS 'MissingLegalholdConsent,
+         ErrorS 'MLSClientSenderUserMismatch,
          ErrorS 'MLSCommitMissingReferences,
+         ErrorS 'MLSGroupConversationMismatch,
          ErrorS 'MLSProposalNotFound,
          ErrorS 'MLSSelfRemovalNotAllowed,
          ErrorS 'MLSStaleMessage,
          ErrorS 'MLSUnsupportedMessage,
-         ErrorS 'MLSClientSenderUserMismatch,
-         ErrorS 'MLSGroupConversationMismatch,
-         ErrorS 'MissingLegalholdConsent,
          Input (Local ()),
          ProposalStore,
          Resource,
@@ -248,10 +248,9 @@ postMLSCommitBundleToLocalConv ::
          Error InternalError,
          Error MLSProtocolError,
          Input (Local ()),
-         Input UTCTime,
          Input Opts,
+         Input UTCTime,
          ProposalStore,
-         BrigAccess,
          Resource,
          TinyLog
        ]
@@ -355,18 +354,18 @@ postMLSMessage ::
          ErrorS 'ConvAccessDenied,
          ErrorS 'ConvMemberNotFound,
          ErrorS 'ConvNotFound,
+         ErrorS 'MissingLegalholdConsent,
          ErrorS 'MLSClientSenderUserMismatch,
          ErrorS 'MLSCommitMissingReferences,
          ErrorS 'MLSGroupConversationMismatch,
          ErrorS 'MLSProposalNotFound,
          ErrorS 'MLSSelfRemovalNotAllowed,
          ErrorS 'MLSStaleMessage,
          ErrorS 'MLSUnsupportedMessage,
-         ErrorS 'MissingLegalholdConsent,
-         Resource,
-         TinyLog,
+         Input (Local ()),
          ProposalStore,
-         Input (Local ())
+         Resource,
+         TinyLog
        ]
       r
   ) =>
@@ -418,16 +417,17 @@ postMLSMessageToLocalConv ::
       '[ Error FederationError,
          Error InternalError,
          ErrorS 'ConvNotFound,
-         ErrorS 'MLSUnsupportedMessage,
-         ErrorS 'MLSStaleMessage,
-         ErrorS 'MLSProposalNotFound,
          ErrorS 'MissingLegalholdConsent,
+         ErrorS 'MLSClientSenderUserMismatch,
          ErrorS 'MLSCommitMissingReferences,
+         ErrorS 'MLSProposalNotFound,
          ErrorS 'MLSSelfRemovalNotAllowed,
-         Resource,
-         TinyLog,
+         ErrorS 'MLSStaleMessage,
+         ErrorS 'MLSUnsupportedMessage,
+         Input (Local ()),
          ProposalStore,
-         Input (Local ())
+         Resource,
+         TinyLog
        ]
       r
   ) =>
@@ -526,24 +526,31 @@ type HasProposalEffects r =
 
 data ProposalAction = ProposalAction
   { paAdd :: ClientMap,
-    paRemove :: ClientMap
+    paRemove :: ClientMap,
+    -- The backend does not process external init proposals, but still it needs
+    -- to know if a commit has one when processing external commits
+    paExternalInit :: Any
   }
 
 instance Semigroup ProposalAction where
-  ProposalAction add1 rem1 <> ProposalAction add2 rem2 =
+  ProposalAction add1 rem1 init1 <> ProposalAction add2 rem2 init2 =
     ProposalAction
       (Map.unionWith mappend add1 add2)
       (Map.unionWith mappend rem1 rem2)
+      (init1 <> init2)
 
 instance Monoid ProposalAction where
-  mempty = ProposalAction mempty mempty
+  mempty = ProposalAction mempty mempty mempty
 
 paAddClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction
 paAddClient quc = mempty {paAdd = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))}
 
 paRemoveClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction
 paRemoveClient quc = mempty {paRemove = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))}
 
+paExternalInitPresent :: ProposalAction
+paExternalInitPresent = mempty {paExternalInit = Any True}
+
 getCommitData ::
   ( HasProposalEffects r,
     Member (ErrorS 'ConvNotFound) r,
@@ -578,6 +585,7 @@ processCommit ::
     Member (Error FederationError) r,
     Member (Error InternalError) r,
     Member (ErrorS 'ConvNotFound) r,
+    Member (ErrorS 'MLSClientSenderUserMismatch) r,
     Member (ErrorS 'MLSCommitMissingReferences) r,
     Member (ErrorS 'MLSProposalNotFound) r,
     Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
@@ -602,10 +610,12 @@ processCommit qusr senderClient con lconv cm epoch sender commit = do
   processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender Nothing commit
 
 processCommitWithAction ::
+  forall r.
   ( HasProposalEffects r,
     Member (Error FederationError) r,
     Member (Error InternalError) r,
     Member (ErrorS 'ConvNotFound) r,
+    Member (ErrorS 'MLSClientSenderUserMismatch) r,
     Member (ErrorS 'MLSCommitMissingReferences) r,
     Member (ErrorS 'MLSProposalNotFound) r,
     Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
@@ -634,7 +644,7 @@ processCommitWithAction qusr senderClient con lconv cm epoch groupId action send
   let ttlSeconds :: Int = 600 -- 10 minutes
   withCommitLock groupId epoch (fromIntegral ttlSeconds) $ do
     checkEpoch epoch (tUnqualified lconv)
-    postponedKeyPackageRefUpdate <-
+    (postponedKeyPackageRefUpdate, actionWithUpdate) <-
       if epoch == Epoch 0
         then do
           -- this is a newly created conversation, and it should contain exactly one
@@ -660,25 +670,70 @@ processCommitWithAction qusr senderClient con lconv cm epoch groupId action send
               throw (InternalErrorWithDescription "Unexpected creator client set")
             -- the sender of the first commit must be a member
             _ -> throw (mlsProtocolError "Unexpected sender")
-          pure $ pure () -- no key package ref update necessary
+          pure $ (pure (), action) -- no key package ref update necessary
         else case (sender, upLeaf <$> cPath commit) of
           (MemberSender senderRef, Just updatedKeyPackage) -> do
             updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref")
             -- postpone key package ref update until other checks/processing passed
             case senderClient of
-              Just cli -> pure $ updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef
-              Nothing -> pure $ pure ()
-          (_, Nothing) -> pure $ pure () -- ignore commits without update path
+              Just cli -> pure (updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef, action)
+              Nothing -> pure (pure (), action)
+          (_, Nothing) -> pure (pure (), action) -- ignore commits without update path
+          (NewMemberSender, Just newKeyPackage) -> do
+            -- this is an external commit
+            when (paExternalInit action == mempty)
+              . throw
+              . mlsProtocolError
+              $ "The external commit is missing an external init proposal"
+            unless (paAdd action == mempty)
+              . throw
+              . mlsProtocolError
+              $ "The external commit must not have add proposals"
+
+            cid <- case kpIdentity (rmValue newKeyPackage) of
+              Left e -> throw (mlsProtocolError $ "Failed to parse the client identity: " <> e)
+              Right v -> pure v
+            newRef <-
+              kpRef' newKeyPackage
+                & note (mlsProtocolError "An invalid key package in the update path")
+
+            -- check if there is a key package ref in the remove proposal
+            remRef <-
+              if Map.null (paRemove action)
+                then pure Nothing
+                else do
+                  (remCid, r) <- derefUser (paRemove action) qusr
+                  unless (cidQualifiedUser cid == cidQualifiedUser remCid)
+                    . throw
+                    . mlsProtocolError
+                    $ "The external commit attempts to remove a client from a user other than themselves"
+                  pure (Just r)
+
+            -- first perform checks and map the key package if valid
+            addKeyPackageRef
+              newRef
+              (cidQualifiedUser cid)
+              (ciClient cid)
+              (Data.convId <$> qUntagged lconv)
+            -- now it is safe to update the mapping without further checks
+            updateKeyPackageMapping lconv qusr (ciClient cid) remRef newRef
+
+            pure (pure (), action {paRemove = mempty})
           _ -> throw (mlsProtocolError "Unexpected sender")
 
-    -- check all pending proposals are referenced in the commit
-    allPendingProposals <- getAllPendingProposals groupId epoch
-    let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) (cProposals commit)
-    unless (all (`Set.member` referencedProposals) allPendingProposals) $
-      throwS @'MLSCommitMissingReferences
+    -- FUTUREWORK: Resubmit backend-provided proposals when processing an
+    -- external commit.
+    --
+    -- check all pending proposals are referenced in the commit. Skip the check
+    -- if this is an external commit.
+    when (sender /= NewMemberSender) $ do
+      allPendingProposals <- getAllPendingProposals groupId epoch
+      let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) (cProposals commit)
+      unless (all (`Set.member` referencedProposals) allPendingProposals) $
+        throwS @'MLSCommitMissingReferences
 
     -- process and execute proposals
-    updates <- executeProposalAction qusr con lconv cm action
+    updates <- executeProposalAction qusr con lconv cm actionWithUpdate
 
     -- update key package ref if necessary
     postponedKeyPackageRefUpdate
@@ -691,6 +746,25 @@ processCommitWithAction qusr senderClient con lconv cm epoch groupId action send
         . gipGroupState
 
     pure updates
+  where
+    throwRemProposal =
+      throw . mlsProtocolError $
+        "The external commit must have at most one remove proposal"
+    derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef)
+    derefUser (Map.toList -> l) user = case l of
+      [(u, s)] -> do
+        unless (user == u) $
+          throwS @'MLSClientSenderUserMismatch
+        ref <- snd <$> ensureSingleton s
+        ci <- derefKeyPackage ref
+        unless (cidQualifiedUser ci == user) $
+          throwS @'MLSClientSenderUserMismatch
+        pure (ci, ref)
+      _ -> throwRemProposal
+    ensureSingleton :: Set a -> Sem r a
+    ensureSingleton (Set.toList -> l) = case l of
+      [e] -> pure e
+      _ -> throwRemProposal
 
 -- | Note: Use this only for KeyPackage that are already validated
 updateKeyPackageMapping ::
@@ -784,6 +858,10 @@ applyProposal convId (AddProposal kp) = do
 applyProposal _conv (RemoveProposal ref) = do
   qclient <- cidQualifiedClient <$> derefKeyPackage ref
   pure (paRemoveClient ((,ref) <$$> qclient))
+applyProposal _conv (ExternalInitProposal _) =
+  -- only record the fact there was an external init proposal, but do not
+  -- process it in any way.
+  pure paExternalInitPresent
 applyProposal _conv _ = pure mempty
 
 checkProposalCipherSuite ::

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

@@ -106,11 +106,17 @@ tests s =
           test s "add remote user to a conversation" testAddRemoteUser,
           test s "return error when commit is locked" testCommitLock,
           test s "add user to a conversation with proposal + commit" testAddUserBareProposalCommit,
-          test s "post commit that references a unknown proposal" testUnknownProposalRefCommit,
+          test s "post commit that references an unknown proposal" testUnknownProposalRefCommit,
           test s "post commit that is not referencing all proposals" testCommitNotReferencingAllProposals,
           test s "admin removes user from a conversation" testAdminRemovesUserFromConv,
           test s "admin removes user from a conversation but doesn't list all clients" testRemoveClientsIncomplete
         ],
+      testGroup
+        "External commit"
+        [ test s "non-member attempts to join a conversation" testExternalCommitNotMember,
+          test s "join a conversation with the same client" testExternalCommitSameClient,
+          test s "join a conversation with a new client" testExternalCommitNewClient
+        ],
       testGroup
         "Application Message"
         [ testGroup
@@ -948,6 +954,64 @@ testLocalToRemoteNonMember = do
             const (Just "no-conversation-member")
               === fmap Wai.label . responseJsonError
 
+testExternalCommitNotMember :: TestM ()
+testExternalCommitNotMember = do
+  [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)
+
+  runMLSTest $ do
+    [alice1, alice2, bob1] <- traverse createMLSClient [alice, alice, bob]
+    traverse_ uploadNewKeyPackage [bob1, alice2]
+    (_, qcnv) <- setupMLSGroup alice1
+
+    -- so that we have the public group state
+    void $ createAddCommit alice1 [alice] >>= sendAndConsumeCommitBundle
+
+    pgs <-
+      LBS.toStrict . fromJust . responseBody
+        <$> getGroupInfo (ciUser alice1) qcnv
+    mp <- createExternalCommit bob1 (Just pgs) qcnv
+    bundle <- createBundle mp
+    postCommitBundle (ciUser (mpSender mp)) bundle
+      !!! const 404 === statusCode
+
+testExternalCommitSameClient :: TestM ()
+testExternalCommitSameClient = do
+  [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)
+
+  runMLSTest $ do
+    [alice1, bob1] <- traverse createMLSClient [alice, bob]
+    void $ uploadNewKeyPackage bob1
+    (_, qcnv) <- setupMLSGroup alice1
+    void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+
+    let rejoiner = alice1
+    ecEvents <- createExternalCommit rejoiner Nothing qcnv >>= sendAndConsumeCommitBundle
+    liftIO $
+      assertBool "No events after external commit expected" (null ecEvents)
+
+    message <- createApplicationMessage bob1 "hello"
+    void $ sendAndConsumeMessage message
+
+testExternalCommitNewClient :: TestM ()
+testExternalCommitNewClient = do
+  [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)
+
+  runMLSTest $ do
+    [alice1, bob1] <- traverse createMLSClient [alice, bob]
+    void $ uploadNewKeyPackage bob1
+    (_, qcnv) <- setupMLSGroup alice1
+    void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+
+    nc <- createMLSClient bob
+    ecEvents <- createExternalCommit nc Nothing qcnv >>= sendAndConsumeCommitBundle
+    liftIO $
+      assertBool "No events after external commit expected" (null ecEvents)
+
+    message <- createApplicationMessage nc "hello"
+    void $ sendAndConsumeMessage message
+
+-- the list of members should be [alice1, bob1]
+
 testAppMessage :: TestM ()
 testAppMessage = do
   users@(alice : _) <- createAndConnectUsers (replicate 4 Nothing)