WIP: Add instances for roundtrip tests of MLS types

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

@@ -44,3 +44,11 @@ instance ParseMLS Capabilities where
       <*> parseMLSVector @VarInt parseMLS
       <*> parseMLSVector @VarInt parseMLS
       <*> parseMLSVector @VarInt parseMLS
+
+instance SerialiseMLS Capabilities where
+  serialiseMLS caps = do
+    serialiseMLSVector @VarInt serialiseMLS caps.versions
+    serialiseMLSVector @VarInt serialiseMLS caps.ciphersuites
+    serialiseMLSVector @VarInt serialiseMLS caps.extensions
+    serialiseMLSVector @VarInt serialiseMLS caps.proposals
+    serialiseMLSVector @VarInt serialiseMLS caps.credentials

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

@@ -27,32 +27,50 @@ data Commit = Commit
   { cProposals :: [ProposalOrRef],
     cPath :: Maybe UpdatePath
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform Commit)
 
 instance ParseMLS Commit where
   parseMLS =
     Commit
-      <$> traceMLS "proposals" (parseMLSVector @VarInt parseMLS)
-      <*> traceMLS "update path" (parseMLSOptional parseMLS)
+      <$> parseMLSVector @VarInt parseMLS
+      <*> parseMLSOptional parseMLS
+
+instance SerialiseMLS Commit where
+  serialiseMLS c = do
+    serialiseMLSVector @VarInt serialiseMLS c.cProposals
+    serialiseMLSOptional serialiseMLS c.cPath
 
 data UpdatePath = UpdatePath
   { upLeaf :: RawMLS LeafNode,
     upNodes :: [UpdatePathNode]
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform UpdatePath)
 
 instance ParseMLS UpdatePath where
   parseMLS = UpdatePath <$> parseMLS <*> parseMLSVector @VarInt parseMLS
 
+instance SerialiseMLS UpdatePath where
+  serialiseMLS up = do
+    serialiseMLS up.upLeaf
+    serialiseMLSVector @VarInt serialiseMLS up.upNodes
+
 data UpdatePathNode = UpdatePathNode
   { upnPublicKey :: ByteString,
     upnSecret :: [HPKECiphertext]
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform UpdatePathNode)
 
 instance ParseMLS UpdatePathNode where
   parseMLS = UpdatePathNode <$> parseMLSBytes @VarInt <*> parseMLSVector @VarInt parseMLS
 
+instance SerialiseMLS UpdatePathNode where
+  serialiseMLS upn = do
+    serialiseMLSBytes @VarInt upn.upnPublicKey
+    serialiseMLSVector @VarInt serialiseMLS upn.upnSecret
+
 data HPKECiphertext = HPKECiphertext
   { hcOutput :: ByteString,
     hcCiphertext :: ByteString

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

@@ -31,7 +31,7 @@ data CommitBundle = CommitBundle
     cbWelcome :: Maybe (RawMLS Welcome),
     cbGroupInfo :: RawMLS GroupInfo
   }
-  deriving (Eq, Show)
+  deriving stock (Eq, Show, Generic)
 
 data CommitBundleF f = CommitBundleF
   { cbCommitMsg :: f (RawMLS Message),

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

@@ -59,13 +59,21 @@ data CredentialTag where
 instance ParseMLS CredentialTag where
   parseMLS = parseMLSEnum @Word16 "credential type"
 
+instance SerialiseMLS CredentialTag where
+  serialiseMLS = serialiseMLSEnum @Word16
+
 instance ParseMLS Credential where
   parseMLS =
     parseMLS >>= \case
       BasicCredentialTag ->
         BasicCredential
           <$> parseMLSBytes @VarInt
 
+instance SerialiseMLS Credential where
+  serialiseMLS (BasicCredential i) = do
+    serialiseMLS BasicCredentialTag
+    serialiseMLSBytes @VarInt i
+
 credentialTag :: Credential -> CredentialTag
 credentialTag BasicCredential {} = BasicCredentialTag
 

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

@@ -58,6 +58,16 @@ instance ParseMLS GroupContext where
       <*> parseMLSBytes @VarInt
       <*> parseMLSVector @VarInt parseMLS
 
+instance SerialiseMLS GroupContext where
+  serialiseMLS gc = do
+    serialiseMLS gc.protocolVersion
+    serialiseMLS gc.cipherSuite
+    serialiseMLS gc.groupId
+    serialiseMLS gc.epoch
+    serialiseMLSBytes @VarInt gc.treeHash
+    serialiseMLSBytes @VarInt gc.confirmedTranscriptHash
+    serialiseMLSVector @VarInt serialiseMLS gc.extensions
+
 data GroupInfoTBS = GroupInfoTBS
   { groupContext :: GroupContext,
     extensions :: [Extension],
@@ -75,6 +85,13 @@ instance ParseMLS GroupInfoTBS where
       <*> parseMLSBytes @VarInt
       <*> parseMLS
 
+instance SerialiseMLS GroupInfoTBS where
+  serialiseMLS tbs = do
+    serialiseMLS tbs.groupContext
+    serialiseMLSVector @VarInt serialiseMLS tbs.extensions
+    serialiseMLSBytes @VarInt tbs.confirmationTag
+    serialiseMLS tbs.signer
+
 data GroupInfo = GroupInfo
   { tbs :: GroupInfoTBS,
     signature_ :: ByteString
@@ -88,6 +105,11 @@ instance ParseMLS GroupInfo where
       <$> parseMLS
       <*> parseMLSBytes @VarInt
 
+instance SerialiseMLS GroupInfo where
+  serialiseMLS gi = do
+    serialiseMLS gi.tbs
+    serialiseMLSBytes @VarInt gi.signature_
+
 instance HasField "groupContext" GroupInfo GroupContext where
   getField = (.tbs.groupContext)
 

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

@@ -28,3 +28,6 @@ newtype HPKEPublicKey = HPKEPublicKey {unHPKEPublicKey :: ByteString}
 
 instance ParseMLS HPKEPublicKey where
   parseMLS = HPKEPublicKey <$> parseMLSBytes @VarInt
+
+instance SerialiseMLS HPKEPublicKey where
+  serialiseMLS = serialiseMLSBytes @VarInt . unHPKEPublicKey

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

@@ -180,11 +180,20 @@ instance ParseMLS KeyPackageTBS where
       <*> parseMLS
       <*> parseMLSVector @VarInt parseMLS
 
+instance SerialiseMLS KeyPackageTBS where
+  serialiseMLS tbs = do
+    serialiseMLS tbs.protocolVersion
+    serialiseMLS tbs.cipherSuite
+    serialiseMLS tbs.initKey
+    serialiseMLS tbs.leafNode
+    serialiseMLSVector @VarInt serialiseMLS tbs.extensions
+
 data KeyPackage = KeyPackage
   { tbs :: RawMLS KeyPackageTBS,
     signature_ :: ByteString
   }
-  deriving stock (Eq, Show)
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform KeyPackage)
 
 instance S.ToSchema KeyPackage where
   declareNamedSchema _ = pure (mlsSwagger "KeyPackage")
@@ -221,6 +230,11 @@ instance ParseMLS KeyPackage where
       <$> parseRawMLS parseMLS
       <*> parseMLSBytes @VarInt
 
+instance SerialiseMLS KeyPackage where
+  serialiseMLS kp = do
+    serialiseMLS kp.tbs
+    serialiseMLSBytes @VarInt kp.signature_
+
 --------------------------------------------------------------------------------
 
 data KeyPackageUpdate = KeyPackageUpdate

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

@@ -18,6 +18,7 @@
 module Wire.API.MLS.LeafNode
   ( LeafIndex,
     LeafNode (..),
+    LeafNodeTBS (..),
     LeafNodeSource (..),
     LeafNodeSourceTag (..),
     leafNodeSourceTag,
@@ -59,6 +60,15 @@ instance ParseMLS LeafNodeTBS where
       <*> parseMLS
       <*> parseMLSVector @VarInt parseMLS
 
+instance SerialiseMLS LeafNodeTBS where
+  serialiseMLS tbs = do
+    serialiseMLS tbs.encryptionKey
+    serialiseMLSBytes @VarInt tbs.signatureKey
+    serialiseMLS tbs.credential
+    serialiseMLS tbs.capabilities
+    serialiseMLS tbs.source
+    serialiseMLSVector @VarInt serialiseMLS tbs.extensions
+
 -- | This type can only verify the signature when the LeafNodeSource is
 -- LeafNodeSourceKeyPackage
 data LeafNode = LeafNode
@@ -74,6 +84,11 @@ instance ParseMLS LeafNode where
       <$> parseMLS
       <*> parseMLSBytes @VarInt
 
+instance SerialiseMLS LeafNode where
+  serialiseMLS ln = do
+    serialiseMLS ln.tbs
+    serialiseMLSBytes @VarInt ln.signature_
+
 instance S.ToSchema LeafNode where
   declareNamedSchema _ = pure (mlsSwagger "LeafNode")
 
@@ -109,15 +124,28 @@ instance ParseMLS LeafNodeSource where
       LeafNodeSourceUpdateTag -> pure LeafNodeSourceUpdate
       LeafNodeSourceCommitTag -> LeafNodeSourceCommit <$> parseMLSBytes @VarInt
 
+instance SerialiseMLS LeafNodeSource where
+  serialiseMLS (LeafNodeSourceKeyPackage lt) = do
+    serialiseMLS LeafNodeSourceKeyPackageTag
+    serialiseMLS lt
+  serialiseMLS LeafNodeSourceUpdate =
+    serialiseMLS LeafNodeSourceUpdateTag
+  serialiseMLS (LeafNodeSourceCommit bs) = do
+    serialiseMLS LeafNodeSourceCommitTag
+    serialiseMLSBytes @VarInt bs
+
 data LeafNodeSourceTag
   = LeafNodeSourceKeyPackageTag
   | LeafNodeSourceUpdateTag
   | LeafNodeSourceCommitTag
   deriving (Show, Eq, Ord, Enum, Bounded)
 
-instance Bounded LeafNodeSourceTag => ParseMLS LeafNodeSourceTag where
+instance ParseMLS LeafNodeSourceTag where
   parseMLS = parseMLSEnum @Word8 "leaf node source"
 
+instance SerialiseMLS LeafNodeSourceTag where
+  serialiseMLS = serialiseMLSEnum @Word8
+
 instance HasField "name" LeafNodeSourceTag Text where
   getField LeafNodeSourceKeyPackageTag = "key_package"
   getField LeafNodeSourceUpdateTag = "update"

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

@@ -26,7 +26,7 @@ import Wire.Arbitrary
 
 -- | Seconds since the UNIX epoch.
 newtype Timestamp = Timestamp {timestampSeconds :: Word64}
-  deriving newtype (Eq, Show, Arbitrary, ParseMLS)
+  deriving newtype (Eq, Show, Arbitrary, ParseMLS, SerialiseMLS)
 
 tsPOSIX :: Timestamp -> POSIXTime
 tsPOSIX = fromIntegral . timestampSeconds
@@ -40,3 +40,8 @@ data Lifetime = Lifetime
 
 instance ParseMLS Lifetime where
   parseMLS = Lifetime <$> parseMLS <*> parseMLS
+
+instance SerialiseMLS Lifetime where
+  serialiseMLS lt = do
+    serialiseMLS lt.ltNotBefore
+    serialiseMLS lt.ltNotAfter

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

@@ -62,6 +62,7 @@ import Wire.API.MLS.Proposal
 import Wire.API.MLS.ProtocolVersion
 import Wire.API.MLS.Serialisation
 import Wire.API.MLS.Welcome
+import Wire.Arbitrary
 
 data WireFormatTag
   = WireFormatPublicTag
@@ -208,6 +209,7 @@ data Sender
   | SenderNewMemberProposal
   | SenderNewMemberCommit
   deriving (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform Sender)
 
 instance ParseMLS Sender where
   parseMLS =