Application message in commit bundles

changelog.d/2-features/mls-bundle-extra-messages

@@ -0,0 +1 @@
+Allow commit bundles to contain one application message. The message must be for the epoch *after* the commit, and it gets sent after the commit has been accepted.

integration/integration.cabal

@@ -176,6 +176,7 @@ library
     Test.MessageTimer
     Test.MLS
     Test.MLS.Clients
+    Test.MLS.History
     Test.MLS.KeyPackage
     Test.MLS.Keys
     Test.MLS.Message

integration/test/MLS/Util.hs

@@ -74,7 +74,8 @@ data MessagePackage = MessagePackage
     convId :: ConvId,
     message :: ByteString,
     welcome :: Maybe ByteString,
-    groupInfo :: Maybe ByteString
+    groupInfo :: Maybe ByteString,
+    appMessage :: Maybe ByteString
   }
 
 toRandomFile :: ByteString -> App FilePath
@@ -445,7 +446,8 @@ createAddCommitWithKeyPackages cid convId clientsAndKeyPackages = do
         convId = convId,
         message = commit,
         welcome = Just welcome,
-        groupInfo = Just gi
+        groupInfo = Just gi,
+        appMessage = Nothing
       }
 
 createRemoveCommit :: (HasCallStack) => ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
@@ -502,7 +504,8 @@ createRemoveCommit cid convId targets = do
         convId = convId,
         message = commit,
         welcome = Just welcome,
-        groupInfo = Just gi
+        groupInfo = Just gi,
+        appMessage = Nothing
       }
 
 createAddProposals :: (HasCallStack) => ConvId -> ClientIdentity -> [Value] -> App [MessagePackage]
@@ -528,7 +531,8 @@ createReInitProposal convId cid = do
         convId = convId,
         message = prop,
         welcome = Nothing,
-        groupInfo = Nothing
+        groupInfo = Nothing,
+        appMessage = Nothing
       }
 
 createAddProposalWithKeyPackage ::
@@ -551,7 +555,8 @@ createAddProposalWithKeyPackage convId cid (_, kp) = do
         convId = convId,
         message = prop,
         welcome = Nothing,
-        groupInfo = Nothing
+        groupInfo = Nothing,
+        appMessage = Nothing
       }
 
 createPendingProposalCommit :: (HasCallStack) => ConvId -> ClientIdentity -> App MessagePackage
@@ -585,7 +590,8 @@ createPendingProposalCommit convId cid = do
         convId = convId,
         message = commit,
         welcome = welcome,
-        groupInfo = Just pgs
+        groupInfo = Just pgs,
+        appMessage = Nothing
       }
 
 createExternalCommit ::
@@ -630,7 +636,8 @@ createExternalCommit convId cid mgi = do
         convId = convId,
         message = commit,
         welcome = Nothing,
-        groupInfo = Just newPgs
+        groupInfo = Just newPgs,
+        appMessage = Nothing
       }
 
 data MLSNotificationTag = MLSNotificationMessageTag | MLSNotificationWelcomeTag
@@ -721,7 +728,7 @@ consumeMessageNoExternal cs cid mp = consumeMessageWithPredicate isNewMLSMessage
         else pure False
 
 mlsCliConsume :: (HasCallStack) => ConvId -> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString
-mlsCliConsume convId cs cid msgData =
+mlsCliConsume convId cs cid msgData = do
   mlscli
     (Just convId)
     cs
@@ -834,7 +841,11 @@ readWelcome fp = runMaybeT $ do
   liftIO $ BS.readFile fp
 
 mkBundle :: MessagePackage -> ByteString
-mkBundle mp = mp.message <> foldMap mkGroupInfoMessage mp.groupInfo <> fold mp.welcome
+mkBundle mp =
+  mp.message
+    <> foldMap mkGroupInfoMessage mp.groupInfo
+    <> fold mp.welcome
+    <> fold mp.appMessage
 
 mkGroupInfoMessage :: ByteString -> ByteString
 mkGroupInfoMessage gi = BS.pack [0x00, 0x01, 0x00, 0x04] <> gi
@@ -913,7 +924,8 @@ createApplicationMessage convId cid messageContent = do
         convId = convId,
         message = message,
         welcome = Nothing,
-        groupInfo = Nothing
+        groupInfo = Nothing,
+        appMessage = Nothing
       }
 
 leaveConv ::

integration/test/Test/MLS/History.hs

@@ -0,0 +1,57 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Test.MLS.History where
+
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.Text.Encoding as T
+import MLS.Util
+import Notifications
+import SetupHelpers
+import Testlib.Prelude
+
+testExtraAppMessage :: App ()
+testExtraAppMessage = do
+  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain)
+  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
+  traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
+  convId <- createNewGroup def alice1
+
+  -- normal commit
+  void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle
+
+  -- make a commit with an extra application message
+  mp <- createAddCommit alice1 convId [charlie]
+  appPackage <- createApplicationMessage convId alice1 "hello"
+  let mp' = mp {appMessage = Just appPackage.message}
+
+  withWebSockets [bob1, charlie1] $ \wss -> do
+    void $ sendAndConsumeCommitBundle mp'
+
+    let isAppMessage :: Value -> App Bool
+        isAppMessage n =
+          isNewMLSMessageNotif n
+            &&~ isNotifConvId mp.convId n
+            &&~ ( do
+                    msg <- n %. "payload.0.data" & asByteString >>= showMessage def alice1
+                    ty <- msg %. "type" & asString
+                    pure $ ty == "private_message"
+                )
+
+    for_ wss $ \ws -> do
+      n <- awaitMatch isAppMessage ws
+      nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode appPackage.message)

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

@@ -29,14 +29,16 @@ import Wire.API.MLS.Welcome
 data CommitBundle = CommitBundle
   { commitMsg :: RawMLS Message,
     welcome :: Maybe (RawMLS Welcome),
-    groupInfo :: RawMLS GroupInfo
+    groupInfo :: RawMLS GroupInfo,
+    appMessage :: Maybe (RawMLS Message)
   }
   deriving stock (Eq, Show, Generic)
 
 data CommitBundleF f = CommitBundleF
   { commitMsg :: f (RawMLS Message),
     welcome :: f (RawMLS Welcome),
-    groupInfo :: f (RawMLS GroupInfo)
+    groupInfo :: f (RawMLS GroupInfo),
+    appMessage :: f (RawMLS Message)
   }
 
 deriving instance Show (CommitBundleF [])
@@ -47,16 +49,18 @@ instance (Alternative f) => Semigroup (CommitBundleF f) where
       (cb1.commitMsg <|> cb2.commitMsg)
       (cb1.welcome <|> cb2.welcome)
       (cb1.groupInfo <|> cb2.groupInfo)
+      (cb1.appMessage <|> cb2.appMessage)
 
 instance (Alternative f) => Monoid (CommitBundleF f) where
-  mempty = CommitBundleF empty empty empty
+  mempty = CommitBundleF empty empty empty empty
 
 checkCommitBundleF :: CommitBundleF [] -> Either Text CommitBundle
 checkCommitBundleF cb =
   CommitBundle
     <$> check "commit" cb.commitMsg
     <*> checkOpt "welcome" cb.welcome
     <*> check "group info" cb.groupInfo
+    <*> checkOpt "application message" cb.appMessage
   where
     check :: Text -> [a] -> Either Text a
     check _ [x] = pure x
@@ -71,10 +75,11 @@ checkCommitBundleF cb =
 findMessageInStream :: (Alternative f) => RawMLS Message -> Either Text (CommitBundleF f)
 findMessageInStream msg = case msg.value.content of
   MessagePublic mp -> case mp.content.value.content of
-    FramedContentCommit _ -> pure (CommitBundleF (pure msg) empty empty)
-    _ -> Left "unexpected public message"
-  MessageWelcome w -> pure (CommitBundleF empty (pure w) empty)
-  MessageGroupInfo gi -> pure (CommitBundleF empty empty (pure gi))
+    FramedContentCommit _ -> pure (CommitBundleF (pure msg) empty empty empty)
+    _ -> Left "unexpected proposal"
+  MessageWelcome w -> pure (CommitBundleF empty (pure w) empty empty)
+  MessageGroupInfo gi -> pure (CommitBundleF empty empty (pure gi) empty)
+  MessagePrivate _ -> pure (CommitBundleF empty empty empty (pure msg))
   _ -> Left "unexpected message type"
 
 findMessagesInStream :: (Alternative f) => [RawMLS Message] -> Either Text (CommitBundleF f)
@@ -91,6 +96,7 @@ instance SerialiseMLS CommitBundle where
     serialiseMLS cb.commitMsg
     traverse_ (serialiseMLS . mkMessage . MessageWelcome) cb.welcome
     serialiseMLS $ mkMessage (MessageGroupInfo cb.groupInfo)
+    traverse_ serialiseMLS cb.appMessage
 
 instance S.ToSchema CommitBundle where
   declareNamedSchema _ = pure (mlsSwagger "CommitBundle")

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

@@ -76,7 +76,8 @@ data Message = Message
   { protocolVersion :: ProtocolVersion,
     content :: MessageContent
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform Message
 
 mkMessage :: MessageContent -> Message
 mkMessage = Message defaultProtocolVersion
@@ -102,7 +103,8 @@ data MessageContent
   | MessageWelcome (RawMLS Welcome)
   | MessageGroupInfo (RawMLS GroupInfo)
   | MessageKeyPackage (RawMLS KeyPackage)
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform MessageContent
 
 instance HasField "wireFormat" MessageContent WireFormatTag where
   getField (MessagePrivate _) = WireFormatPrivateTag
@@ -148,7 +150,8 @@ data PublicMessage = PublicMessage
     -- https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.2-4
     membershipTag :: Maybe ByteString
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform PublicMessage
 
 instance ParseMLS PublicMessage where
   parseMLS = do
@@ -179,7 +182,8 @@ data PrivateMessage = PrivateMessage
     encryptedSenderData :: ByteString,
     ciphertext :: ByteString
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform PrivateMessage)
 
 instance ParseMLS PrivateMessage where
   parseMLS =
@@ -191,6 +195,15 @@ instance ParseMLS PrivateMessage where
       <*> parseMLSBytes @VarInt
       <*> parseMLSBytes @VarInt
 
+instance SerialiseMLS PrivateMessage where
+  serialiseMLS msg = do
+    serialiseMLS msg.groupId
+    serialiseMLS msg.epoch
+    serialiseMLS msg.tag
+    serialiseMLSBytes @VarInt msg.authenticatedData
+    serialiseMLSBytes @VarInt msg.encryptedSenderData
+    serialiseMLSBytes @VarInt msg.ciphertext
+
 -- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
 data SenderTag
   = SenderMemberTag
@@ -242,7 +255,8 @@ data FramedContent = FramedContent
     authenticatedData :: ByteString,
     content :: FramedContentData
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform FramedContent
 
 instance ParseMLS FramedContent where
   parseMLS =
@@ -265,7 +279,8 @@ data FramedContentDataTag
   = FramedContentApplicationDataTag
   | FramedContentProposalTag
   | FramedContentCommitTag
-  deriving (Enum, Bounded, Eq, Ord, Show)
+  deriving (Enum, Bounded, Eq, Ord, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform FramedContentDataTag)
 
 instance ParseMLS FramedContentDataTag where
   parseMLS = parseMLSEnum @Word8 "ContentType"
@@ -278,7 +293,8 @@ data FramedContentData
   = FramedContentApplicationData ByteString
   | FramedContentProposal (RawMLS Proposal)
   | FramedContentCommit (RawMLS Commit)
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform FramedContentData
 
 framedContentDataTag :: FramedContentData -> FramedContentDataTag
 framedContentDataTag (FramedContentApplicationData _) = FramedContentApplicationDataTag
@@ -326,7 +342,8 @@ data FramedContentAuthData = FramedContentAuthData
     -- Present iff it is part of a commit.
     confirmationTag :: Maybe ByteString
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform FramedContentAuthData
 
 parseFramedContentAuthData :: FramedContentDataTag -> Get FramedContentAuthData
 parseFramedContentAuthData t = do

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs

@@ -179,8 +179,11 @@ instance Arbitrary TestCommitBundle where
       commitMsg <-
         mkRawMLS . unMessageGenerator @(FramedContentGenerator Sender CommitPayload)
           <$> arbitrary
-      welcome <- arbitrary
-      CommitBundle commitMsg welcome <$> arbitrary
+      appMsg <- arbitrary
+      CommitBundle commitMsg
+        <$> arbitrary
+        <*> arbitrary
+        <*> pure (mkRawMLS . mkMessage . MessagePrivate <$> appMsg)
 
 newtype CommitPayload = CommitPayload {unCommitPayload :: RawMLS Commit}
   deriving newtype (Arbitrary)