MLS Message types

changelog.d/5-internal/mls-messages

@@ -0,0 +1 @@
+Add MLS message types and corresponding deserialisers

libs/wire-api/package.yaml

@@ -114,6 +114,7 @@ tests:
     - cassava
     - currency-codes
     - directory
+    - either
     - hex
     - iso3166-country-codes
     - iso639

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

@@ -0,0 +1,55 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
+--
+-- 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 Wire.API.MLS.Commit where
+
+import Imports
+import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Proposal
+import Wire.API.MLS.Serialisation
+
+data Commit = Commit
+  { cProposals :: [ProposalOrRef],
+    cPath :: Maybe UpdatePath
+  }
+
+instance ParseMLS Commit where
+  parseMLS = Commit <$> parseMLSVector @Word32 parseMLS <*> parseMLSOptional parseMLS
+
+data UpdatePath = UpdatePath
+  { upLeaf :: KeyPackage,
+    upNodes :: [UpdatePathNode]
+  }
+
+instance ParseMLS UpdatePath where
+  parseMLS = UpdatePath <$> parseMLS <*> parseMLSVector @Word32 parseMLS
+
+data UpdatePathNode = UpdatePathNode
+  { upnPublicKey :: ByteString,
+    upnSecret :: [HPKECiphertext]
+  }
+
+instance ParseMLS UpdatePathNode where
+  parseMLS = UpdatePathNode <$> parseMLSBytes @Word16 <*> parseMLSVector @Word32 parseMLS
+
+data HPKECiphertext = HPKECiphertext
+  { hcOutput :: ByteString,
+    hcCiphertext :: ByteString
+  }
+
+instance ParseMLS HPKECiphertext where
+  parseMLS = HPKECiphertext <$> parseMLSBytes @Word16 <*> parseMLSBytes @Word16

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

@@ -43,21 +43,20 @@ data Credential = BasicCredential
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via GenericUniform Credential
 
-data CredentialTag = ReservedCredentialTag | BasicCredentialTag
-  deriving stock (Enum, Bounded, Show)
-  deriving (ParseMLS) via (EnumMLS Word16 CredentialTag)
+data CredentialTag = BasicCredentialTag
+  deriving stock (Enum, Bounded, Eq, Show)
+
+instance ParseMLS CredentialTag where
+  parseMLS = parseMLSEnum @Word16 "credential type"
 
 instance ParseMLS Credential where
-  parseMLS = do
-    tag <- parseMLS
-    case tag of
+  parseMLS =
+    parseMLS >>= \case
       BasicCredentialTag ->
         BasicCredential
           <$> parseMLSBytes @Word16
           <*> parseMLS
           <*> parseMLSBytes @Word16
-      ReservedCredentialTag ->
-        fail "Unexpected credential type"
 
 credentialTag :: Credential -> CredentialTag
 credentialTag (BasicCredential _ _ _) = BasicCredentialTag

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

@@ -0,0 +1,30 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
+--
+-- 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 Wire.API.MLS.Group where
+
+import Imports
+import Wire.API.MLS.Serialisation
+
+newtype GroupId = GroupId {unGroupId :: ByteString}
+  deriving (Eq, Show)
+
+instance IsString GroupId where
+  fromString = GroupId . fromString
+
+instance ParseMLS GroupId where
+  parseMLS = GroupId <$> parseMLSBytes @Word8

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

@@ -40,7 +40,6 @@ module Wire.API.MLS.KeyPackage
     decodeExtension,
     parseExtension,
     ExtensionTag (..),
-    ReservedExtensionTagSym0,
     CapabilitiesExtensionTagSym0,
     LifetimeExtensionTagSym0,
     SExtensionTag (..),
@@ -56,7 +55,6 @@ module Wire.API.MLS.KeyPackage
 where
 
 import Control.Applicative
-import Control.Error.Util
 import Control.Lens hiding (set, (.=))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Binary
@@ -156,20 +154,17 @@ instance ParseMLS Extension where
   parseMLS = Extension <$> parseMLS <*> parseMLSBytes @Word32
 
 data ExtensionTag
-  = ReservedExtensionTag
-  | CapabilitiesExtensionTag
+  = CapabilitiesExtensionTag
   | LifetimeExtensionTag
   deriving (Bounded, Enum)
 
 $(genSingletons [''ExtensionTag])
 
 type family ExtensionType (t :: ExtensionTag) :: * where
-  ExtensionType 'ReservedExtensionTag = ()
   ExtensionType 'CapabilitiesExtensionTag = Capabilities
   ExtensionType 'LifetimeExtensionTag = Lifetime
 
 parseExtension :: Sing t -> Get (ExtensionType t)
-parseExtension SReservedExtensionTag = pure ()
 parseExtension SCapabilitiesExtensionTag = parseMLS
 parseExtension SLifetimeExtensionTag = parseMLS
 
@@ -182,16 +177,16 @@ instance Eq SomeExtension where
   _ == _ = False
 
 instance Show SomeExtension where
-  show (SomeExtension SReservedExtensionTag _) = show ()
   show (SomeExtension SCapabilitiesExtensionTag caps) = show caps
   show (SomeExtension SLifetimeExtensionTag lt) = show lt
 
-decodeExtension :: Extension -> Maybe SomeExtension
+decodeExtension :: Extension -> Either Text (Maybe SomeExtension)
 decodeExtension e = do
-  t <- safeToEnum (fromIntegral (extType e))
-  hush $
-    withSomeSing t $ \st ->
-      decodeMLSWith' (SomeExtension st <$> parseExtension st) (extData e)
+  case toMLSEnum' (extType e) of
+    Left MLSEnumUnkonwn -> pure Nothing
+    Left MLSEnumInvalid -> Left "Invalid extension type"
+    Right t -> withSomeSing t $ \st ->
+      Just <$> decodeMLSWith' (SomeExtension st <$> parseExtension st) (extData e)
 
 data Capabilities = Capabilities
   { capVersions :: [ProtocolVersion],
@@ -234,7 +229,7 @@ data KeyPackageTBS = KeyPackageTBS
     kpCredential :: Credential,
     kpExtensions :: [Extension]
   }
-  deriving stock (Show, Generic)
+  deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via GenericUniform KeyPackageTBS
 
 instance ParseMLS KeyPackageTBS where
@@ -250,10 +245,13 @@ data KeyPackage = KeyPackage
   { kpTBS :: KeyPackageTBS,
     kpSignature :: ByteString
   }
-  deriving (Show)
+  deriving stock (Eq, Show)
 
 newtype KeyPackageRef = KeyPackageRef {unKeyPackageRef :: ByteString}
-  deriving stock (Show)
+  deriving stock (Eq, Show)
+
+instance ParseMLS KeyPackageRef where
+  parseMLS = KeyPackageRef <$> getByteString 16
 
 kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef
 kpRef cs =

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

@@ -0,0 +1,154 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
+--
+-- 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 Wire.API.MLS.Message
+  ( Message (..),
+    WireFormatTag (..),
+    SWireFormatTag (..),
+    SomeMessage (..),
+    ContentType (..),
+    MessagePayload (..),
+    MessagePayloadTBS (..),
+    Sender (..),
+    MLSPlainTextSym0,
+    MLSCipherTextSym0,
+  )
+where
+
+import Data.Binary
+import Data.Singletons.TH
+import Imports
+import Wire.API.MLS.Commit
+import Wire.API.MLS.Group
+import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Proposal
+import Wire.API.MLS.Serialisation
+
+data WireFormatTag = MLSPlainText | MLSCipherText
+  deriving (Bounded, Enum, Eq, Show)
+
+$(genSingletons [''WireFormatTag])
+
+instance ParseMLS WireFormatTag where
+  parseMLS = parseMLSEnum @Word8 "wire format"
+
+data Message (tag :: WireFormatTag) = Message
+  { msgGroupId :: GroupId,
+    msgEpoch :: Word64,
+    msgAuthData :: ByteString,
+    msgSender :: Sender tag,
+    msgPayload :: MessagePayload tag
+  }
+
+instance ParseMLS (Message 'MLSPlainText) where
+  parseMLS = do
+    g <- parseMLS
+    e <- parseMLS
+    s <- parseMLS
+    d <- parseMLSBytes @Word32
+    p <- parseMLS
+    pure (Message g e d s p)
+
+instance ParseMLS (Message 'MLSCipherText) where
+  parseMLS = do
+    g <- parseMLS
+    e <- parseMLS
+    ct <- parseMLS
+    d <- parseMLSBytes @Word32
+    s <- parseMLS
+    p <- parseMLSBytes @Word32
+    pure $ Message g e d s (CipherText ct p)
+
+data SomeMessage where
+  SomeMessage :: Sing tag -> Message tag -> SomeMessage
+
+instance ParseMLS SomeMessage where
+  parseMLS =
+    parseMLS >>= \case
+      MLSPlainText -> SomeMessage SMLSPlainText <$> parseMLS
+      MLSCipherText -> SomeMessage SMLSCipherText <$> parseMLS
+
+data family Sender (tag :: WireFormatTag) :: *
+
+data instance Sender 'MLSCipherText = EncryptedSender {esData :: ByteString}
+
+instance ParseMLS (Sender 'MLSCipherText) where
+  parseMLS = EncryptedSender <$> parseMLSBytes @Word8
+
+data SenderTag = MemberSenderTag | PreconfiguredSenderTag | NewMemberSenderTag
+  deriving (Bounded, Enum, Show, Eq)
+
+instance ParseMLS SenderTag where
+  parseMLS = parseMLSEnum @Word8 "sender type"
+
+data instance Sender 'MLSPlainText
+  = MemberSender KeyPackageRef
+  | PreconfiguredSender ByteString
+  | NewMemberSender
+
+instance ParseMLS (Sender 'MLSPlainText) where
+  parseMLS =
+    parseMLS >>= \case
+      MemberSenderTag -> MemberSender <$> parseMLS
+      PreconfiguredSenderTag -> PreconfiguredSender <$> parseMLSBytes @Word8
+      NewMemberSenderTag -> pure NewMemberSender
+
+data family MessagePayload (tag :: WireFormatTag) :: *
+
+data instance MessagePayload 'MLSCipherText = CipherText
+  { msgContentType :: Word8,
+    msgCipherText :: ByteString
+  }
+
+data instance MessagePayload 'MLSPlainText = MessagePayload
+  { msgTBS :: MessagePayloadTBS,
+    msgSignature :: ByteString,
+    msgConfirmation :: Maybe ByteString,
+    msgMembership :: Maybe ByteString
+  }
+
+instance ParseMLS (MessagePayload 'MLSPlainText) where
+  parseMLS =
+    MessagePayload
+      <$> parseMLS
+        <*> parseMLSBytes @Word16
+        <*> parseMLSOptional (parseMLSBytes @Word8)
+        <*> parseMLSOptional (parseMLSBytes @Word8)
+
+data MessagePayloadTBS
+  = ApplicationMessage ByteString
+  | ProposalMessage Proposal
+  | CommitMessage Commit
+
+data ContentType
+  = ApplicationMessageTag
+  | ProposalMessageTag
+  | CommitMessageTag
+  deriving (Bounded, Enum, Eq, Show)
+
+instance ParseMLS ContentType where
+  parseMLS = parseMLSEnum @Word8 "content type"
+
+instance ParseMLS MessagePayloadTBS where
+  parseMLS =
+    parseMLS >>= \case
+      ApplicationMessageTag -> ApplicationMessage <$> parseMLSBytes @Word32
+      ProposalMessageTag -> ProposalMessage <$> parseMLS
+      CommitMessageTag -> CommitMessage <$> parseMLS