WIP

libs/wire-api/src/Wire/API/Conversation/Protocol.hs

@@ -85,9 +85,9 @@ mlsDataSchema =
 instance ToSchema ConversationMLSData where
   schema = object "ConversationMLSData" mlsDataSchema
 
+-- TODO: Fix API compatibility
 data ActiveMLSConversationData = ActiveMLSConversationData
-  { -- | The current epoch number of the corresponding MLS group. Note that
-    -- this could be 0, for example while the first commit is being processed.
+  { -- | The current epoch number of the corresponding MLS group.
     epoch :: Epoch,
     -- | The time stamp of the epoch.
     epochTimestamp :: UTCTime,

services/galley/src/Galley/API/MLS/Commit/Core.hs

@@ -31,6 +31,7 @@ import Data.Qualified
 import Data.Time
 import Galley.API.Error
 import Galley.API.MLS.Conversation
+import Galley.API.MLS.IncomingMessage
 import Galley.API.MLS.Proposal
 import Galley.API.MLS.Types
 import Galley.Effects
@@ -59,6 +60,7 @@ import Wire.API.Federation.Version
 import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Commit
 import Wire.API.MLS.Credential
+import Wire.API.MLS.Serialisation
 import Wire.API.MLS.SubConversation
 import Wire.API.User.Client
 import Wire.NotificationSubsystem
@@ -98,20 +100,24 @@ getCommitData ::
   ) =>
   ClientIdentity ->
   Local ConvOrSubConv ->
-  ActiveMLSConversationData ->
-  Commit ->
+  Epoch ->
+  CipherSuiteTag ->
+  IncomingBundle ->
   Sem r ProposalAction
-getCommitData senderIdentity lConvOrSub activeData commit = do
+getCommitData senderIdentity lConvOrSub epoch ciphersuite bundle = do
   let convOrSub = tUnqualified lConvOrSub
       groupId = cnvmlsGroupId convOrSub.mlsMeta
 
   evalState convOrSub.indexMap $ do
     creatorAction <-
-      if activeData.epoch == Epoch 0
+      if epoch == Epoch 0
         then addProposedClient senderIdentity
         else mempty
-    proposals <- traverse (derefOrCheckProposal activeData groupId) commit.proposals
-    action <- applyProposals activeData groupId proposals
+    proposals <-
+      traverse
+        (derefOrCheckProposal epoch ciphersuite groupId)
+        bundle.commit.value.proposals
+    action <- applyProposals ciphersuite groupId proposals
     pure (creatorAction <> action)
 
 incrementEpoch ::

services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs

@@ -42,6 +42,7 @@ import Wire.API.Conversation.Protocol
 import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Federation.Error
+import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Commit
 import Wire.API.MLS.Credential
 import Wire.API.MLS.LeafNode
@@ -70,8 +71,11 @@ getExternalCommitData ::
   Sem r ExternalCommitAction
 getExternalCommitData senderIdentity lConvOrSub epoch commit = do
   let convOrSub = tUnqualified lConvOrSub
-      curEpoch = cnvmlsEpoch convOrSub.mlsMeta
       groupId = cnvmlsGroupId convOrSub.mlsMeta
+  activeData <-
+    note (mlsProtocolError "The first commit in a group cannot be external") $
+      cnvmlsActiveData convOrSub.mlsMeta
+  let curEpoch = activeData.epoch
   when (epoch /= curEpoch) $ throwS @'MLSStaleMessage
   when (epoch == Epoch 0) $
     throw $
@@ -95,7 +99,7 @@ getExternalCommitData senderIdentity lConvOrSub epoch commit = do
 
   evalState convOrSub.indexMap $ do
     -- process optional removal
-    propAction <- applyProposals convOrSub.mlsMeta groupId proposals
+    propAction <- applyProposals activeData.ciphersuite groupId proposals
     removedIndex <- case cmAssocs (paRemove propAction) of
       [(cid, idx)]
         | cid /= senderIdentity ->
@@ -130,11 +134,12 @@ processExternalCommit ::
   ) =>
   ClientIdentity ->
   Local ConvOrSubConv ->
+  CipherSuiteTag ->
   Epoch ->
   ExternalCommitAction ->
   Maybe UpdatePath ->
   Sem r ()
-processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do
+processExternalCommit senderIdentity lConvOrSub ciphersuite epoch action updatePath = do
   let convOrSub = tUnqualified lConvOrSub
 
   -- only members can join a subconversation
@@ -148,10 +153,9 @@ processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do
       <$> note
         (mlsProtocolError "External commits need an update path")
         updatePath
-  let cs = cnvmlsCipherSuite (tUnqualified lConvOrSub).mlsMeta
   let groupId = cnvmlsGroupId convOrSub.mlsMeta
   let extra = LeafNodeTBSExtraCommit groupId action.add
-  case validateLeafNode cs (Just senderIdentity) extra leafNode.value of
+  case validateLeafNode ciphersuite (Just senderIdentity) extra leafNode.value of
     Left errMsg ->
       throw $
         mlsProtocolError ("Tried to add invalid LeafNode: " <> errMsg)

services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs

@@ -54,6 +54,7 @@ import Wire.API.Conversation.Role
 import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Event.LeaveReason
+import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Commit
 import Wire.API.MLS.Credential
 import Wire.API.MLS.Proposal qualified as Proposal
@@ -76,15 +77,15 @@ processInternalCommit ::
   ClientIdentity ->
   Maybe ConnId ->
   Local ConvOrSubConv ->
+  CipherSuiteTag ->
   Epoch ->
   ProposalAction ->
   Commit ->
   Sem r [LocalConversationUpdate]
-processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
+processInternalCommit senderIdentity con lConvOrSub ciphersuite epoch action commit = do
   let convOrSub = tUnqualified lConvOrSub
       qusr = cidQualifiedUser senderIdentity
       cm = convOrSub.members
-      suite = cnvmlsCipherSuite convOrSub.mlsMeta
       newUserClients = Map.assocs (paAdd action)
 
   -- check all pending proposals are referenced in the commit
@@ -154,7 +155,7 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
                     -- final set of clients in the conversation
                     let clients = Map.keysSet (newclients <> Map.findWithDefault mempty qtarget cm)
                     -- get list of mls clients from Brig (local or remote)
-                    getClientInfo lConvOrSub qtarget suite >>= \case
+                    getClientInfo lConvOrSub qtarget ciphersuite >>= \case
                       Left _e -> pure (Just qtarget)
                       Right clientInfo -> do
                         let allClients = Set.map ciId clientInfo
@@ -192,7 +193,6 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
                   createSubConversation
                     cnv
                     sub
-                    convOrSub.mlsMeta.cnvmlsCipherSuite
                     convOrSub.mlsMeta.cnvmlsGroupId
               pure []
             Conv _

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

@@ -204,44 +204,40 @@ postMLSCommitBundleToLocalConv ::
   Local ConvOrSubConvId ->
   Sem r [LocalConversationUpdate]
 postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do
-  lConvOrSub <- do
-    lConvOrSub <- fetchConvOrSub qusr bundle.groupId ctype lConvOrSubId
-    let convOrSub = tUnqualified lConvOrSub
-    giCipherSuite <-
-      note (mlsProtocolError "Unsupported ciphersuite") $
-        cipherSuiteTag bundle.groupInfo.value.groupContext.cipherSuite
-    case convOrSub.mlsMeta.cnvmlsActiveData of
-      -- if this is the first commit of the conversation, update ciphersuite
-      Nothing -> do
-        case convOrSub.id of
-          Conv cid -> setConversationCipherSuite cid giCipherSuite
-          SubConv cid sub -> setSubConversationCipherSuite cid sub giCipherSuite
-    let convCipherSuite = convOrSub.mlsMeta.cnvmlsCipherSuite
-    if (giCipherSuite == convCipherSuite)
-      then pure lConvOrSub
-      else do
-        unless (convOrSub.mlsMeta.cnvmlsEpoch == Epoch 0) $
-          throw $
-            mlsProtocolError "GroupInfo ciphersuite does not match conversation"
-        -- save to cassandra
-        case convOrSub.id of
-          Conv cid -> setConversationCipherSuite cid giCipherSuite
-          SubConv cid sub ->
-            setSubConversationCipherSuite cid sub giCipherSuite
-        pure $ fmap (convOrSubConvSetCipherSuite giCipherSuite) lConvOrSub
+  lConvOrSub <- fetchConvOrSub qusr bundle.groupId ctype lConvOrSubId
+  let convOrSub = tUnqualified lConvOrSub
+
+  ciphersuite <-
+    note (mlsProtocolError "Unsupported ciphersuite") $
+      cipherSuiteTag bundle.groupInfo.value.groupContext.cipherSuite
+
+  case convOrSub.mlsMeta.cnvmlsActiveData of
+    -- if this is the first commit of the conversation, update ciphersuite
+    Nothing -> do
+      case convOrSub.id of
+        Conv cid -> setConversationCipherSuite cid ciphersuite
+        SubConv cid sub -> setSubConversationCipherSuite cid sub ciphersuite
+    -- otherwise, make sure the ciphersuite matches
+    Just activeData -> do
+      unless (ciphersuite == activeData.ciphersuite) $
+        throw $
+          mlsProtocolError "GroupInfo ciphersuite does not match conversation"
+      unless (bundle.epoch == activeData.epoch) $ throwS @'MLSStaleMessage
 
   senderIdentity <- getSenderIdentity qusr c bundle.sender lConvOrSub
 
   (events, newClients) <- case bundle.sender of
     SenderMember _index -> do
       -- extract added/removed clients from bundle
-      action <- getCommitData senderIdentity lConvOrSub bundle.epoch bundle.commit.value
+      action <- getCommitData senderIdentity lConvOrSub bundle.epoch ciphersuite bundle
+
       -- process additions and removals
       events <-
         processInternalCommit
           senderIdentity
           conn
           lConvOrSub
+          ciphersuite
           bundle.epoch
           action
           bundle.commit.value
@@ -256,6 +252,7 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do
       processExternalCommit
         senderIdentity
         lConvOrSub
+        ciphersuite
         bundle.epoch
         action
         bundle.commit.value.path
@@ -410,11 +407,15 @@ postMLSMessageToLocalConv qusr c con msg ctype convOrSubId = do
         throwS @'MLSUnsupportedMessage
 
       -- reject application messages older than 2 epochs
+      -- FUTUREWORK: consider rejecting this message if the conversation epoch is 0
       let epochInt :: Epoch -> Integer
           epochInt = fromIntegral . epochNumber
-      when
-        (epochInt msg.epoch < epochInt convOrSub.mlsMeta.cnvmlsEpoch - 2)
-        $ throwS @'MLSStaleMessage
+      case convOrSub.mlsMeta.cnvmlsActiveData of
+        Nothing -> throw $ mlsProtocolError "Application messages at epoch 0 are not supported"
+        Just activeData ->
+          when
+            (epochInt msg.epoch < epochInt activeData.epoch - 2)
+            $ throwS @'MLSStaleMessage
 
   propagateMessage qusr (Just c) lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members
   pure []
@@ -494,7 +495,7 @@ fetchConvOrSub qusr groupId ctype convOrSubId = for convOrSubId $ \case
     c <- getMLSConv qusr Nothing ctype lconv
     msubconv <- getSubConversation convId sconvId
     subconv <- case msubconv of
-      Nothing -> pure $ newSubConversationFromParent lconv sconvId (mcMLSData c)
+      Nothing -> pure $ newSubConversationFromParent lconv sconvId
       Just subconv -> do
         when (groupId /= subconv.scMLSData.cnvmlsGroupId) $
           throw (mlsProtocolError "The message group ID does not match the subconversation")

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

@@ -36,7 +36,6 @@ import Wire.API.Conversation hiding (Member)
 import Wire.API.Conversation.Protocol
 import Wire.API.Conversation.Role
 import Wire.API.Federation.API.Galley
-import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Group.Serialisation
 import Wire.API.MLS.SubConversation
 import Wire.API.User
@@ -92,9 +91,7 @@ localMLSOne2OneConversationMetadata convId =
       mlsData =
         ConversationMLSData
           { cnvmlsGroupId = groupId,
-            cnvmlsEpoch = Epoch 0,
-            cnvmlsEpochTimestamp = Nothing,
-            cnvmlsCipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+            cnvmlsActiveData = Nothing
           }
    in (metadata, mlsData)
 

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

@@ -60,6 +60,7 @@ import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Federation.Error
 import Wire.API.MLS.AuthenticatedContent
+import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
 import Wire.API.MLS.LeafNode
@@ -146,35 +147,36 @@ derefOrCheckProposal ::
     Member (State IndexMap) r,
     Member (ErrorS 'MLSProposalNotFound) r
   ) =>
-  ActiveMLSConversationData ->
+  Epoch ->
+  CipherSuiteTag ->
   GroupId ->
   ProposalOrRef ->
   Sem r Proposal
-derefOrCheckProposal activeData groupId (Ref ref) = do
-  p <- getProposal groupId activeData.epoch ref >>= noteS @'MLSProposalNotFound
+derefOrCheckProposal epoch _ciphersuite groupId (Ref ref) = do
+  p <- getProposal groupId epoch ref >>= noteS @'MLSProposalNotFound
   pure p.value
-derefOrCheckProposal activeData _ (Inline p) = do
+derefOrCheckProposal _epoch ciphersuite _ (Inline p) = do
   im <- get
-  checkProposal activeData im p
+  checkProposal ciphersuite im p
   pure p
 
 checkProposal ::
   ( Member (Error MLSProtocolError) r,
     Member (ErrorS 'MLSInvalidLeafNodeIndex) r
   ) =>
-  ActiveMLSConversationData ->
+  CipherSuiteTag ->
   IndexMap ->
   Proposal ->
   Sem r ()
-checkProposal activeData im p = case p of
+checkProposal ciphersuite im p = case p of
   AddProposal kp -> do
     (cs, _lifetime) <-
       either
         (\msg -> throw (mlsProtocolError ("Invalid key package in Add proposal: " <> msg)))
         pure
         $ validateKeyPackage Nothing kp.value
     -- we are not checking lifetime constraints here
-    unless (activeData.ciphersuite == cs) $
+    unless (ciphersuite == cs) $
       throw (mlsProtocolError "Key package ciphersuite does not match conversation")
   RemoveProposal idx -> do
     void $ noteS @'MLSInvalidLeafNodeIndex $ imLookup im idx
@@ -193,13 +195,13 @@ applyProposals ::
     Member (ErrorS 'MLSUnsupportedProposal) r,
     Member (ErrorS 'MLSInvalidLeafNodeIndex) r
   ) =>
-  ActiveMLSConversationData ->
+  CipherSuiteTag ->
   GroupId ->
   [Proposal] ->
   Sem r ProposalAction
-applyProposals activeData groupId =
+applyProposals ciphersuite groupId =
   -- proposals are sorted before processing
-  foldMap (applyProposal activeData groupId)
+  foldMap (applyProposal ciphersuite groupId)
     . sortOn proposalProcessingStage
 
 applyProposal ::
@@ -208,22 +210,22 @@ applyProposal ::
     Member (ErrorS 'MLSUnsupportedProposal) r,
     Member (ErrorS 'MLSInvalidLeafNodeIndex) r
   ) =>
-  ActiveMLSConversationData ->
+  CipherSuiteTag ->
   GroupId ->
   Proposal ->
   Sem r ProposalAction
-applyProposal activeData _groupId (AddProposal kp) = do
+applyProposal ciphersuite _groupId (AddProposal kp) = do
   (cs, _lifetime) <-
     either
       (\msg -> throw (mlsProtocolError ("Invalid key package in Add proposal: " <> msg)))
       pure
       $ validateKeyPackage Nothing kp.value
-  unless (activeData.ciphersuite == cs) $
+  unless (ciphersuite == cs) $
     throw (mlsProtocolError "Key package ciphersuite does not match conversation")
   -- we are not checking lifetime constraints here
   cid <- getKeyPackageIdentity kp.value
   addProposedClient cid
-applyProposal _activeData _groupId (RemoveProposal idx) = do
+applyProposal _ciphersuite _groupId (RemoveProposal idx) = do
   im <- get
   (cid, im') <- noteS @'MLSInvalidLeafNodeIndex $ imRemoveClient im idx
   put im'
@@ -244,15 +246,17 @@ processProposal ::
   Sem r ()
 processProposal qusr lConvOrSub groupId epoch pub prop = do
   let mlsMeta = (tUnqualified lConvOrSub).mlsMeta
-  -- Check if the epoch number matches that of a conversation
-  unless (epoch == cnvmlsEpoch mlsMeta) $ throwS @'MLSStaleMessage
   -- Check if the group ID matches that of a conversation
   unless (groupId == cnvmlsGroupId mlsMeta) $ throwS @'ConvNotFound
+
   case cnvmlsActiveData mlsMeta of
-    Nothing -> throw (mlsProtocolError "Bare proposals at epoch 0 are not supported")
+    Nothing -> throw $ mlsProtocolError "Bare proposals at epoch 0 are not supported"
     Just activeData -> do
+      -- Check if the epoch number matches that of a conversation
+      unless (epoch == activeData.epoch) $ throwS @'MLSStaleMessage
+
       -- FUTUREWORK: validate the member's conversation role
-      checkProposal activeData (tUnqualified lConvOrSub).indexMap prop.value
+      checkProposal activeData.ciphersuite (tUnqualified lConvOrSub).indexMap prop.value
       when (isExternal pub.sender) $ checkExternalProposalUser qusr prop.value
       let propRef =
             authContentRef