-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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 Wire.API.MLS.Message
  ( -- * MLS Message types
    WireFormatTag (..),
    Message (..),
    mkMessage,
    MessageContent (..),
    PublicMessage (..),
    PrivateMessage (..),
    FramedContent (..),
    FramedContentData (..),
    FramedContentDataTag (..),
    FramedContentTBS (..),
    FramedContentAuthData (..),
    Sender (..),

    -- * Servant types
    MLSMessageSendingStatus (..),
  )
where

import Control.Lens ((?~))
import Data.Aeson qualified as A
import Data.Binary
import Data.Json.Util
import Data.OpenApi qualified as S
import Data.Schema hiding (HasField)
import GHC.Records
import Imports
import Test.QuickCheck hiding (label)
import Wire.API.Event.Conversation
import Wire.API.MLS.Commit
import Wire.API.MLS.Epoch
import Wire.API.MLS.Group
import Wire.API.MLS.GroupInfo
import Wire.API.MLS.KeyPackage
import Wire.API.MLS.LeafNode
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
  | WireFormatPrivateTag
  | WireFormatWelcomeTag
  | WireFormatGroupInfoTag
  | WireFormatKeyPackageTag
  deriving (Int -> WireFormatTag
WireFormatTag -> Int
WireFormatTag -> [WireFormatTag]
WireFormatTag -> WireFormatTag
WireFormatTag -> WireFormatTag -> [WireFormatTag]
WireFormatTag -> WireFormatTag -> WireFormatTag -> [WireFormatTag]
(WireFormatTag -> WireFormatTag)
-> (WireFormatTag -> WireFormatTag)
-> (Int -> WireFormatTag)
-> (WireFormatTag -> Int)
-> (WireFormatTag -> [WireFormatTag])
-> (WireFormatTag -> WireFormatTag -> [WireFormatTag])
-> (WireFormatTag -> WireFormatTag -> [WireFormatTag])
-> (WireFormatTag
    -> WireFormatTag -> WireFormatTag -> [WireFormatTag])
-> Enum WireFormatTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WireFormatTag -> WireFormatTag
succ :: WireFormatTag -> WireFormatTag
$cpred :: WireFormatTag -> WireFormatTag
pred :: WireFormatTag -> WireFormatTag
$ctoEnum :: Int -> WireFormatTag
toEnum :: Int -> WireFormatTag
$cfromEnum :: WireFormatTag -> Int
fromEnum :: WireFormatTag -> Int
$cenumFrom :: WireFormatTag -> [WireFormatTag]
enumFrom :: WireFormatTag -> [WireFormatTag]
$cenumFromThen :: WireFormatTag -> WireFormatTag -> [WireFormatTag]
enumFromThen :: WireFormatTag -> WireFormatTag -> [WireFormatTag]
$cenumFromTo :: WireFormatTag -> WireFormatTag -> [WireFormatTag]
enumFromTo :: WireFormatTag -> WireFormatTag -> [WireFormatTag]
$cenumFromThenTo :: WireFormatTag -> WireFormatTag -> WireFormatTag -> [WireFormatTag]
enumFromThenTo :: WireFormatTag -> WireFormatTag -> WireFormatTag -> [WireFormatTag]
Enum, WireFormatTag
WireFormatTag -> WireFormatTag -> Bounded WireFormatTag
forall a. a -> a -> Bounded a
$cminBound :: WireFormatTag
minBound :: WireFormatTag
$cmaxBound :: WireFormatTag
maxBound :: WireFormatTag
Bounded, WireFormatTag -> WireFormatTag -> Bool
(WireFormatTag -> WireFormatTag -> Bool)
-> (WireFormatTag -> WireFormatTag -> Bool) -> Eq WireFormatTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireFormatTag -> WireFormatTag -> Bool
== :: WireFormatTag -> WireFormatTag -> Bool
$c/= :: WireFormatTag -> WireFormatTag -> Bool
/= :: WireFormatTag -> WireFormatTag -> Bool
Eq, Int -> WireFormatTag -> ShowS
[WireFormatTag] -> ShowS
WireFormatTag -> [Char]
(Int -> WireFormatTag -> ShowS)
-> (WireFormatTag -> [Char])
-> ([WireFormatTag] -> ShowS)
-> Show WireFormatTag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireFormatTag -> ShowS
showsPrec :: Int -> WireFormatTag -> ShowS
$cshow :: WireFormatTag -> [Char]
show :: WireFormatTag -> [Char]
$cshowList :: [WireFormatTag] -> ShowS
showList :: [WireFormatTag] -> ShowS
Show)

instance ParseMLS WireFormatTag where
  parseMLS :: Get WireFormatTag
parseMLS = forall w a.
(Bounded a, Enum a, Integral w, Binary w) =>
[Char] -> Get a
parseMLSEnum @Word16 [Char]
"wire format"

instance SerialiseMLS WireFormatTag where
  serialiseMLS :: WireFormatTag -> Put
serialiseMLS = forall w a. (Enum a, Integral w, Binary w) => a -> Put
serialiseMLSEnum @Word16

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data Message = Message
  { Message -> ProtocolVersion
protocolVersion :: ProtocolVersion,
    Message -> MessageContent
content :: MessageContent
  }
  deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> [Char]
(Int -> Message -> ShowS)
-> (Message -> [Char]) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> [Char]
show :: Message -> [Char]
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

mkMessage :: MessageContent -> Message
mkMessage :: MessageContent -> Message
mkMessage = ProtocolVersion -> MessageContent -> Message
Message ProtocolVersion
defaultProtocolVersion

instance ParseMLS Message where
  parseMLS :: Get Message
parseMLS =
    ProtocolVersion -> MessageContent -> Message
Message
      (ProtocolVersion -> MessageContent -> Message)
-> Get ProtocolVersion -> Get (MessageContent -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProtocolVersion
forall a. ParseMLS a => Get a
parseMLS
      Get (MessageContent -> Message)
-> Get MessageContent -> Get Message
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get MessageContent
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS Message where
  serialiseMLS :: Message -> Put
serialiseMLS Message
msg = do
    ProtocolVersion -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS Message
msg.protocolVersion
    MessageContent -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS Message
msg.content

instance HasField "wireFormat" Message WireFormatTag where
  getField :: Message -> WireFormatTag
getField = (.content.wireFormat)

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data MessageContent
  = MessagePrivate (RawMLS PrivateMessage)
  | MessagePublic PublicMessage
  | MessageWelcome (RawMLS Welcome)
  | MessageGroupInfo (RawMLS GroupInfo)
  | MessageKeyPackage (RawMLS KeyPackage)
  deriving (MessageContent -> MessageContent -> Bool
(MessageContent -> MessageContent -> Bool)
-> (MessageContent -> MessageContent -> Bool) -> Eq MessageContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageContent -> MessageContent -> Bool
== :: MessageContent -> MessageContent -> Bool
$c/= :: MessageContent -> MessageContent -> Bool
/= :: MessageContent -> MessageContent -> Bool
Eq, Int -> MessageContent -> ShowS
[MessageContent] -> ShowS
MessageContent -> [Char]
(Int -> MessageContent -> ShowS)
-> (MessageContent -> [Char])
-> ([MessageContent] -> ShowS)
-> Show MessageContent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageContent -> ShowS
showsPrec :: Int -> MessageContent -> ShowS
$cshow :: MessageContent -> [Char]
show :: MessageContent -> [Char]
$cshowList :: [MessageContent] -> ShowS
showList :: [MessageContent] -> ShowS
Show)

instance HasField "wireFormat" MessageContent WireFormatTag where
  getField :: MessageContent -> WireFormatTag
getField (MessagePrivate RawMLS PrivateMessage
_) = WireFormatTag
WireFormatPrivateTag
  getField (MessagePublic PublicMessage
_) = WireFormatTag
WireFormatPublicTag
  getField (MessageWelcome RawMLS Welcome
_) = WireFormatTag
WireFormatWelcomeTag
  getField (MessageGroupInfo RawMLS GroupInfo
_) = WireFormatTag
WireFormatGroupInfoTag
  getField (MessageKeyPackage RawMLS KeyPackage
_) = WireFormatTag
WireFormatKeyPackageTag

instance ParseMLS MessageContent where
  parseMLS :: Get MessageContent
parseMLS =
    Get WireFormatTag
forall a. ParseMLS a => Get a
parseMLS Get WireFormatTag
-> (WireFormatTag -> Get MessageContent) -> Get MessageContent
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      WireFormatTag
WireFormatPrivateTag -> RawMLS PrivateMessage -> MessageContent
MessagePrivate (RawMLS PrivateMessage -> MessageContent)
-> Get (RawMLS PrivateMessage) -> Get MessageContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS PrivateMessage)
forall a. ParseMLS a => Get a
parseMLS
      WireFormatTag
WireFormatPublicTag -> PublicMessage -> MessageContent
MessagePublic (PublicMessage -> MessageContent)
-> Get PublicMessage -> Get MessageContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PublicMessage
forall a. ParseMLS a => Get a
parseMLS
      WireFormatTag
WireFormatWelcomeTag -> RawMLS Welcome -> MessageContent
MessageWelcome (RawMLS Welcome -> MessageContent)
-> Get (RawMLS Welcome) -> Get MessageContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS Welcome)
forall a. ParseMLS a => Get a
parseMLS
      WireFormatTag
WireFormatGroupInfoTag -> RawMLS GroupInfo -> MessageContent
MessageGroupInfo (RawMLS GroupInfo -> MessageContent)
-> Get (RawMLS GroupInfo) -> Get MessageContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS GroupInfo)
forall a. ParseMLS a => Get a
parseMLS
      WireFormatTag
WireFormatKeyPackageTag -> RawMLS KeyPackage -> MessageContent
MessageKeyPackage (RawMLS KeyPackage -> MessageContent)
-> Get (RawMLS KeyPackage) -> Get MessageContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS KeyPackage)
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS MessageContent where
  serialiseMLS :: MessageContent -> Put
serialiseMLS (MessagePrivate RawMLS PrivateMessage
msg) = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS WireFormatTag
WireFormatPrivateTag
    RawMLS PrivateMessage -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS PrivateMessage
msg
  serialiseMLS (MessagePublic PublicMessage
msg) = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS WireFormatTag
WireFormatPublicTag
    PublicMessage -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS PublicMessage
msg
  serialiseMLS (MessageWelcome RawMLS Welcome
welcome) = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS WireFormatTag
WireFormatWelcomeTag
    RawMLS Welcome -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS Welcome
welcome
  serialiseMLS (MessageGroupInfo RawMLS GroupInfo
gi) = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS WireFormatTag
WireFormatGroupInfoTag
    RawMLS GroupInfo -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS GroupInfo
gi
  serialiseMLS (MessageKeyPackage RawMLS KeyPackage
kp) = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS WireFormatTag
WireFormatKeyPackageTag
    RawMLS KeyPackage -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS KeyPackage
kp

instance S.ToSchema Message where
  declareNamedSchema :: Proxy Message -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Message
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NamedSchema
mlsSwagger Text
"MLSMessage")

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.2-2
data PublicMessage = PublicMessage
  { PublicMessage -> RawMLS FramedContent
content :: RawMLS FramedContent,
    PublicMessage -> RawMLS FramedContentAuthData
authData :: RawMLS FramedContentAuthData,
    -- Present iff content.value.sender is of type Member.
    -- https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.2-4
    PublicMessage -> Maybe ByteString
membershipTag :: Maybe ByteString
  }
  deriving (PublicMessage -> PublicMessage -> Bool
(PublicMessage -> PublicMessage -> Bool)
-> (PublicMessage -> PublicMessage -> Bool) -> Eq PublicMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicMessage -> PublicMessage -> Bool
== :: PublicMessage -> PublicMessage -> Bool
$c/= :: PublicMessage -> PublicMessage -> Bool
/= :: PublicMessage -> PublicMessage -> Bool
Eq, Int -> PublicMessage -> ShowS
[PublicMessage] -> ShowS
PublicMessage -> [Char]
(Int -> PublicMessage -> ShowS)
-> (PublicMessage -> [Char])
-> ([PublicMessage] -> ShowS)
-> Show PublicMessage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicMessage -> ShowS
showsPrec :: Int -> PublicMessage -> ShowS
$cshow :: PublicMessage -> [Char]
show :: PublicMessage -> [Char]
$cshowList :: [PublicMessage] -> ShowS
showList :: [PublicMessage] -> ShowS
Show)

instance ParseMLS PublicMessage where
  parseMLS :: Get PublicMessage
parseMLS = do
    RawMLS FramedContent
content <- Get (RawMLS FramedContent)
forall a. ParseMLS a => Get a
parseMLS
    RawMLS FramedContentAuthData
authData <- Get FramedContentAuthData -> Get (RawMLS FramedContentAuthData)
forall a. Get a -> Get (RawMLS a)
parseRawMLS (FramedContentDataTag -> Get FramedContentAuthData
parseFramedContentAuthData (FramedContentData -> FramedContentDataTag
framedContentDataTag (RawMLS FramedContent
content.value.content)))
    Maybe ByteString
membershipTag <- case RawMLS FramedContent
content.value.sender of
      SenderMember LeafIndex
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Get ByteString -> Get (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Sender
_ -> Maybe ByteString -> Get (Maybe ByteString)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
    PublicMessage -> Get PublicMessage
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PublicMessage
        { $sel:content:PublicMessage :: RawMLS FramedContent
content = RawMLS FramedContent
content,
          $sel:authData:PublicMessage :: RawMLS FramedContentAuthData
authData = RawMLS FramedContentAuthData
authData,
          $sel:membershipTag:PublicMessage :: Maybe ByteString
membershipTag = Maybe ByteString
membershipTag
        }

instance SerialiseMLS PublicMessage where
  serialiseMLS :: PublicMessage -> Put
serialiseMLS PublicMessage
msg = do
    RawMLS FramedContent -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS PublicMessage
msg.content
    RawMLS FramedContentAuthData -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS PublicMessage
msg.authData
    (ByteString -> Put) -> Maybe ByteString -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt) PublicMessage
msg.membershipTag

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.3.1-2
data PrivateMessage = PrivateMessage
  { PrivateMessage -> GroupId
groupId :: GroupId,
    PrivateMessage -> Epoch
epoch :: Epoch,
    PrivateMessage -> FramedContentDataTag
tag :: FramedContentDataTag,
    PrivateMessage -> ByteString
authenticatedData :: ByteString,
    PrivateMessage -> ByteString
encryptedSenderData :: ByteString,
    PrivateMessage -> ByteString
ciphertext :: ByteString
  }
  deriving (PrivateMessage -> PrivateMessage -> Bool
(PrivateMessage -> PrivateMessage -> Bool)
-> (PrivateMessage -> PrivateMessage -> Bool) -> Eq PrivateMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrivateMessage -> PrivateMessage -> Bool
== :: PrivateMessage -> PrivateMessage -> Bool
$c/= :: PrivateMessage -> PrivateMessage -> Bool
/= :: PrivateMessage -> PrivateMessage -> Bool
Eq, Int -> PrivateMessage -> ShowS
[PrivateMessage] -> ShowS
PrivateMessage -> [Char]
(Int -> PrivateMessage -> ShowS)
-> (PrivateMessage -> [Char])
-> ([PrivateMessage] -> ShowS)
-> Show PrivateMessage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrivateMessage -> ShowS
showsPrec :: Int -> PrivateMessage -> ShowS
$cshow :: PrivateMessage -> [Char]
show :: PrivateMessage -> [Char]
$cshowList :: [PrivateMessage] -> ShowS
showList :: [PrivateMessage] -> ShowS
Show)

instance ParseMLS PrivateMessage where
  parseMLS :: Get PrivateMessage
parseMLS =
    GroupId
-> Epoch
-> FramedContentDataTag
-> ByteString
-> ByteString
-> ByteString
-> PrivateMessage
PrivateMessage
      (GroupId
 -> Epoch
 -> FramedContentDataTag
 -> ByteString
 -> ByteString
 -> ByteString
 -> PrivateMessage)
-> Get GroupId
-> Get
     (Epoch
      -> FramedContentDataTag
      -> ByteString
      -> ByteString
      -> ByteString
      -> PrivateMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GroupId
forall a. ParseMLS a => Get a
parseMLS
      Get
  (Epoch
   -> FramedContentDataTag
   -> ByteString
   -> ByteString
   -> ByteString
   -> PrivateMessage)
-> Get Epoch
-> Get
     (FramedContentDataTag
      -> ByteString -> ByteString -> ByteString -> PrivateMessage)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Epoch
forall a. ParseMLS a => Get a
parseMLS
      Get
  (FramedContentDataTag
   -> ByteString -> ByteString -> ByteString -> PrivateMessage)
-> Get FramedContentDataTag
-> Get (ByteString -> ByteString -> ByteString -> PrivateMessage)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FramedContentDataTag
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> ByteString -> ByteString -> PrivateMessage)
-> Get ByteString
-> Get (ByteString -> ByteString -> PrivateMessage)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get (ByteString -> ByteString -> PrivateMessage)
-> Get ByteString -> Get (ByteString -> PrivateMessage)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get (ByteString -> PrivateMessage)
-> Get ByteString -> Get PrivateMessage
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data SenderTag
  = SenderMemberTag
  | SenderExternalTag
  | SenderNewMemberProposalTag
  | SenderNewMemberCommitTag
  deriving (SenderTag
SenderTag -> SenderTag -> Bounded SenderTag
forall a. a -> a -> Bounded a
$cminBound :: SenderTag
minBound :: SenderTag
$cmaxBound :: SenderTag
maxBound :: SenderTag
Bounded, Int -> SenderTag
SenderTag -> Int
SenderTag -> [SenderTag]
SenderTag -> SenderTag
SenderTag -> SenderTag -> [SenderTag]
SenderTag -> SenderTag -> SenderTag -> [SenderTag]
(SenderTag -> SenderTag)
-> (SenderTag -> SenderTag)
-> (Int -> SenderTag)
-> (SenderTag -> Int)
-> (SenderTag -> [SenderTag])
-> (SenderTag -> SenderTag -> [SenderTag])
-> (SenderTag -> SenderTag -> [SenderTag])
-> (SenderTag -> SenderTag -> SenderTag -> [SenderTag])
-> Enum SenderTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SenderTag -> SenderTag
succ :: SenderTag -> SenderTag
$cpred :: SenderTag -> SenderTag
pred :: SenderTag -> SenderTag
$ctoEnum :: Int -> SenderTag
toEnum :: Int -> SenderTag
$cfromEnum :: SenderTag -> Int
fromEnum :: SenderTag -> Int
$cenumFrom :: SenderTag -> [SenderTag]
enumFrom :: SenderTag -> [SenderTag]
$cenumFromThen :: SenderTag -> SenderTag -> [SenderTag]
enumFromThen :: SenderTag -> SenderTag -> [SenderTag]
$cenumFromTo :: SenderTag -> SenderTag -> [SenderTag]
enumFromTo :: SenderTag -> SenderTag -> [SenderTag]
$cenumFromThenTo :: SenderTag -> SenderTag -> SenderTag -> [SenderTag]
enumFromThenTo :: SenderTag -> SenderTag -> SenderTag -> [SenderTag]
Enum, Int -> SenderTag -> ShowS
[SenderTag] -> ShowS
SenderTag -> [Char]
(Int -> SenderTag -> ShowS)
-> (SenderTag -> [Char])
-> ([SenderTag] -> ShowS)
-> Show SenderTag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SenderTag -> ShowS
showsPrec :: Int -> SenderTag -> ShowS
$cshow :: SenderTag -> [Char]
show :: SenderTag -> [Char]
$cshowList :: [SenderTag] -> ShowS
showList :: [SenderTag] -> ShowS
Show, SenderTag -> SenderTag -> Bool
(SenderTag -> SenderTag -> Bool)
-> (SenderTag -> SenderTag -> Bool) -> Eq SenderTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SenderTag -> SenderTag -> Bool
== :: SenderTag -> SenderTag -> Bool
$c/= :: SenderTag -> SenderTag -> Bool
/= :: SenderTag -> SenderTag -> Bool
Eq)

instance ParseMLS SenderTag where
  parseMLS :: Get SenderTag
parseMLS = forall w a.
(Bounded a, Enum a, Integral w, Binary w) =>
[Char] -> Get a
parseMLSEnum @Word8 [Char]
"sender type"

instance SerialiseMLS SenderTag where
  serialiseMLS :: SenderTag -> Put
serialiseMLS = forall w a. (Enum a, Integral w, Binary w) => a -> Put
serialiseMLSEnum @Word8

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data Sender
  = SenderMember LeafIndex
  | SenderExternal Word32
  | SenderNewMemberProposal
  | SenderNewMemberCommit
  deriving (Sender -> Sender -> Bool
(Sender -> Sender -> Bool)
-> (Sender -> Sender -> Bool) -> Eq Sender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sender -> Sender -> Bool
== :: Sender -> Sender -> Bool
$c/= :: Sender -> Sender -> Bool
/= :: Sender -> Sender -> Bool
Eq, Int -> Sender -> ShowS
[Sender] -> ShowS
Sender -> [Char]
(Int -> Sender -> ShowS)
-> (Sender -> [Char]) -> ([Sender] -> ShowS) -> Show Sender
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sender -> ShowS
showsPrec :: Int -> Sender -> ShowS
$cshow :: Sender -> [Char]
show :: Sender -> [Char]
$cshowList :: [Sender] -> ShowS
showList :: [Sender] -> ShowS
Show, (forall x. Sender -> Rep Sender x)
-> (forall x. Rep Sender x -> Sender) -> Generic Sender
forall x. Rep Sender x -> Sender
forall x. Sender -> Rep Sender x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Sender -> Rep Sender x
from :: forall x. Sender -> Rep Sender x
$cto :: forall x. Rep Sender x -> Sender
to :: forall x. Rep Sender x -> Sender
Generic)
  deriving (Gen Sender
Gen Sender -> (Sender -> [Sender]) -> Arbitrary Sender
Sender -> [Sender]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Sender
arbitrary :: Gen Sender
$cshrink :: Sender -> [Sender]
shrink :: Sender -> [Sender]
Arbitrary) via (GenericUniform Sender)

instance ParseMLS Sender where
  parseMLS :: Get Sender
parseMLS =
    Get SenderTag
forall a. ParseMLS a => Get a
parseMLS Get SenderTag -> (SenderTag -> Get Sender) -> Get Sender
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SenderTag
SenderMemberTag -> LeafIndex -> Sender
SenderMember (LeafIndex -> Sender) -> Get LeafIndex -> Get Sender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LeafIndex
forall a. ParseMLS a => Get a
parseMLS
      SenderTag
SenderExternalTag -> LeafIndex -> Sender
SenderExternal (LeafIndex -> Sender) -> Get LeafIndex -> Get Sender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LeafIndex
forall a. ParseMLS a => Get a
parseMLS
      SenderTag
SenderNewMemberProposalTag -> Sender -> Get Sender
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sender
SenderNewMemberProposal
      SenderTag
SenderNewMemberCommitTag -> Sender -> Get Sender
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sender
SenderNewMemberCommit

instance SerialiseMLS Sender where
  serialiseMLS :: Sender -> Put
serialiseMLS (SenderMember LeafIndex
i) = do
    SenderTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS SenderTag
SenderMemberTag
    LeafIndex -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS LeafIndex
i
  serialiseMLS (SenderExternal LeafIndex
w) = do
    SenderTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS SenderTag
SenderExternalTag
    LeafIndex -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS LeafIndex
w
  serialiseMLS Sender
SenderNewMemberProposal =
    SenderTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS SenderTag
SenderNewMemberProposalTag
  serialiseMLS Sender
SenderNewMemberCommit =
    SenderTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS SenderTag
SenderNewMemberCommitTag

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data FramedContent = FramedContent
  { FramedContent -> GroupId
groupId :: GroupId,
    FramedContent -> Epoch
epoch :: Epoch,
    FramedContent -> Sender
sender :: Sender,
    FramedContent -> ByteString
authenticatedData :: ByteString,
    FramedContent -> FramedContentData
content :: FramedContentData
  }
  deriving (FramedContent -> FramedContent -> Bool
(FramedContent -> FramedContent -> Bool)
-> (FramedContent -> FramedContent -> Bool) -> Eq FramedContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramedContent -> FramedContent -> Bool
== :: FramedContent -> FramedContent -> Bool
$c/= :: FramedContent -> FramedContent -> Bool
/= :: FramedContent -> FramedContent -> Bool
Eq, Int -> FramedContent -> ShowS
[FramedContent] -> ShowS
FramedContent -> [Char]
(Int -> FramedContent -> ShowS)
-> (FramedContent -> [Char])
-> ([FramedContent] -> ShowS)
-> Show FramedContent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramedContent -> ShowS
showsPrec :: Int -> FramedContent -> ShowS
$cshow :: FramedContent -> [Char]
show :: FramedContent -> [Char]
$cshowList :: [FramedContent] -> ShowS
showList :: [FramedContent] -> ShowS
Show)

instance ParseMLS FramedContent where
  parseMLS :: Get FramedContent
parseMLS =
    GroupId
-> Epoch
-> Sender
-> ByteString
-> FramedContentData
-> FramedContent
FramedContent
      (GroupId
 -> Epoch
 -> Sender
 -> ByteString
 -> FramedContentData
 -> FramedContent)
-> Get GroupId
-> Get
     (Epoch
      -> Sender -> ByteString -> FramedContentData -> FramedContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GroupId
forall a. ParseMLS a => Get a
parseMLS
      Get
  (Epoch
   -> Sender -> ByteString -> FramedContentData -> FramedContent)
-> Get Epoch
-> Get (Sender -> ByteString -> FramedContentData -> FramedContent)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Epoch
forall a. ParseMLS a => Get a
parseMLS
      Get (Sender -> ByteString -> FramedContentData -> FramedContent)
-> Get Sender
-> Get (ByteString -> FramedContentData -> FramedContent)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Sender
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> FramedContentData -> FramedContent)
-> Get ByteString -> Get (FramedContentData -> FramedContent)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get (FramedContentData -> FramedContent)
-> Get FramedContentData -> Get FramedContent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FramedContentData
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS FramedContent where
  serialiseMLS :: FramedContent -> Put
serialiseMLS FramedContent
fc = do
    GroupId -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContent
fc.groupId
    Epoch -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContent
fc.epoch
    Sender -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContent
fc.sender
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt FramedContent
fc.authenticatedData
    FramedContentData -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContent
fc.content

data FramedContentDataTag
  = FramedContentApplicationDataTag
  | FramedContentProposalTag
  | FramedContentCommitTag
  deriving (Int -> FramedContentDataTag
FramedContentDataTag -> Int
FramedContentDataTag -> [FramedContentDataTag]
FramedContentDataTag -> FramedContentDataTag
FramedContentDataTag
-> FramedContentDataTag -> [FramedContentDataTag]
FramedContentDataTag
-> FramedContentDataTag
-> FramedContentDataTag
-> [FramedContentDataTag]
(FramedContentDataTag -> FramedContentDataTag)
-> (FramedContentDataTag -> FramedContentDataTag)
-> (Int -> FramedContentDataTag)
-> (FramedContentDataTag -> Int)
-> (FramedContentDataTag -> [FramedContentDataTag])
-> (FramedContentDataTag
    -> FramedContentDataTag -> [FramedContentDataTag])
-> (FramedContentDataTag
    -> FramedContentDataTag -> [FramedContentDataTag])
-> (FramedContentDataTag
    -> FramedContentDataTag
    -> FramedContentDataTag
    -> [FramedContentDataTag])
-> Enum FramedContentDataTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FramedContentDataTag -> FramedContentDataTag
succ :: FramedContentDataTag -> FramedContentDataTag
$cpred :: FramedContentDataTag -> FramedContentDataTag
pred :: FramedContentDataTag -> FramedContentDataTag
$ctoEnum :: Int -> FramedContentDataTag
toEnum :: Int -> FramedContentDataTag
$cfromEnum :: FramedContentDataTag -> Int
fromEnum :: FramedContentDataTag -> Int
$cenumFrom :: FramedContentDataTag -> [FramedContentDataTag]
enumFrom :: FramedContentDataTag -> [FramedContentDataTag]
$cenumFromThen :: FramedContentDataTag
-> FramedContentDataTag -> [FramedContentDataTag]
enumFromThen :: FramedContentDataTag
-> FramedContentDataTag -> [FramedContentDataTag]
$cenumFromTo :: FramedContentDataTag
-> FramedContentDataTag -> [FramedContentDataTag]
enumFromTo :: FramedContentDataTag
-> FramedContentDataTag -> [FramedContentDataTag]
$cenumFromThenTo :: FramedContentDataTag
-> FramedContentDataTag
-> FramedContentDataTag
-> [FramedContentDataTag]
enumFromThenTo :: FramedContentDataTag
-> FramedContentDataTag
-> FramedContentDataTag
-> [FramedContentDataTag]
Enum, FramedContentDataTag
FramedContentDataTag
-> FramedContentDataTag -> Bounded FramedContentDataTag
forall a. a -> a -> Bounded a
$cminBound :: FramedContentDataTag
minBound :: FramedContentDataTag
$cmaxBound :: FramedContentDataTag
maxBound :: FramedContentDataTag
Bounded, FramedContentDataTag -> FramedContentDataTag -> Bool
(FramedContentDataTag -> FramedContentDataTag -> Bool)
-> (FramedContentDataTag -> FramedContentDataTag -> Bool)
-> Eq FramedContentDataTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramedContentDataTag -> FramedContentDataTag -> Bool
== :: FramedContentDataTag -> FramedContentDataTag -> Bool
$c/= :: FramedContentDataTag -> FramedContentDataTag -> Bool
/= :: FramedContentDataTag -> FramedContentDataTag -> Bool
Eq, Eq FramedContentDataTag
Eq FramedContentDataTag =>
(FramedContentDataTag -> FramedContentDataTag -> Ordering)
-> (FramedContentDataTag -> FramedContentDataTag -> Bool)
-> (FramedContentDataTag -> FramedContentDataTag -> Bool)
-> (FramedContentDataTag -> FramedContentDataTag -> Bool)
-> (FramedContentDataTag -> FramedContentDataTag -> Bool)
-> (FramedContentDataTag
    -> FramedContentDataTag -> FramedContentDataTag)
-> (FramedContentDataTag
    -> FramedContentDataTag -> FramedContentDataTag)
-> Ord FramedContentDataTag
FramedContentDataTag -> FramedContentDataTag -> Bool
FramedContentDataTag -> FramedContentDataTag -> Ordering
FramedContentDataTag
-> FramedContentDataTag -> FramedContentDataTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FramedContentDataTag -> FramedContentDataTag -> Ordering
compare :: FramedContentDataTag -> FramedContentDataTag -> Ordering
$c< :: FramedContentDataTag -> FramedContentDataTag -> Bool
< :: FramedContentDataTag -> FramedContentDataTag -> Bool
$c<= :: FramedContentDataTag -> FramedContentDataTag -> Bool
<= :: FramedContentDataTag -> FramedContentDataTag -> Bool
$c> :: FramedContentDataTag -> FramedContentDataTag -> Bool
> :: FramedContentDataTag -> FramedContentDataTag -> Bool
$c>= :: FramedContentDataTag -> FramedContentDataTag -> Bool
>= :: FramedContentDataTag -> FramedContentDataTag -> Bool
$cmax :: FramedContentDataTag
-> FramedContentDataTag -> FramedContentDataTag
max :: FramedContentDataTag
-> FramedContentDataTag -> FramedContentDataTag
$cmin :: FramedContentDataTag
-> FramedContentDataTag -> FramedContentDataTag
min :: FramedContentDataTag
-> FramedContentDataTag -> FramedContentDataTag
Ord, Int -> FramedContentDataTag -> ShowS
[FramedContentDataTag] -> ShowS
FramedContentDataTag -> [Char]
(Int -> FramedContentDataTag -> ShowS)
-> (FramedContentDataTag -> [Char])
-> ([FramedContentDataTag] -> ShowS)
-> Show FramedContentDataTag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramedContentDataTag -> ShowS
showsPrec :: Int -> FramedContentDataTag -> ShowS
$cshow :: FramedContentDataTag -> [Char]
show :: FramedContentDataTag -> [Char]
$cshowList :: [FramedContentDataTag] -> ShowS
showList :: [FramedContentDataTag] -> ShowS
Show)

instance ParseMLS FramedContentDataTag where
  parseMLS :: Get FramedContentDataTag
parseMLS = forall w a.
(Bounded a, Enum a, Integral w, Binary w) =>
[Char] -> Get a
parseMLSEnum @Word8 [Char]
"ContentType"

instance SerialiseMLS FramedContentDataTag where
  serialiseMLS :: FramedContentDataTag -> Put
serialiseMLS = forall w a. (Enum a, Integral w, Binary w) => a -> Put
serialiseMLSEnum @Word8

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4
data FramedContentData
  = FramedContentApplicationData ByteString
  | FramedContentProposal (RawMLS Proposal)
  | FramedContentCommit (RawMLS Commit)
  deriving (FramedContentData -> FramedContentData -> Bool
(FramedContentData -> FramedContentData -> Bool)
-> (FramedContentData -> FramedContentData -> Bool)
-> Eq FramedContentData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramedContentData -> FramedContentData -> Bool
== :: FramedContentData -> FramedContentData -> Bool
$c/= :: FramedContentData -> FramedContentData -> Bool
/= :: FramedContentData -> FramedContentData -> Bool
Eq, Int -> FramedContentData -> ShowS
[FramedContentData] -> ShowS
FramedContentData -> [Char]
(Int -> FramedContentData -> ShowS)
-> (FramedContentData -> [Char])
-> ([FramedContentData] -> ShowS)
-> Show FramedContentData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramedContentData -> ShowS
showsPrec :: Int -> FramedContentData -> ShowS
$cshow :: FramedContentData -> [Char]
show :: FramedContentData -> [Char]
$cshowList :: [FramedContentData] -> ShowS
showList :: [FramedContentData] -> ShowS
Show)

framedContentDataTag :: FramedContentData -> FramedContentDataTag
framedContentDataTag :: FramedContentData -> FramedContentDataTag
framedContentDataTag (FramedContentApplicationData ByteString
_) = FramedContentDataTag
FramedContentApplicationDataTag
framedContentDataTag (FramedContentProposal RawMLS Proposal
_) = FramedContentDataTag
FramedContentProposalTag
framedContentDataTag (FramedContentCommit RawMLS Commit
_) = FramedContentDataTag
FramedContentCommitTag

instance ParseMLS FramedContentData where
  parseMLS :: Get FramedContentData
parseMLS =
    Get FramedContentDataTag
forall a. ParseMLS a => Get a
parseMLS Get FramedContentDataTag
-> (FramedContentDataTag -> Get FramedContentData)
-> Get FramedContentData
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      FramedContentDataTag
FramedContentApplicationDataTag ->
        ByteString -> FramedContentData
FramedContentApplicationData (ByteString -> FramedContentData)
-> Get ByteString -> Get FramedContentData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      FramedContentDataTag
FramedContentProposalTag -> RawMLS Proposal -> FramedContentData
FramedContentProposal (RawMLS Proposal -> FramedContentData)
-> Get (RawMLS Proposal) -> Get FramedContentData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS Proposal)
forall a. ParseMLS a => Get a
parseMLS
      FramedContentDataTag
FramedContentCommitTag -> RawMLS Commit -> FramedContentData
FramedContentCommit (RawMLS Commit -> FramedContentData)
-> Get (RawMLS Commit) -> Get FramedContentData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS Commit)
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS FramedContentData where
  serialiseMLS :: FramedContentData -> Put
serialiseMLS (FramedContentApplicationData ByteString
bs) = do
    FramedContentDataTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentDataTag
FramedContentApplicationDataTag
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt ByteString
bs
  serialiseMLS (FramedContentProposal RawMLS Proposal
prop) = do
    FramedContentDataTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentDataTag
FramedContentProposalTag
    RawMLS Proposal -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS Proposal
prop
  serialiseMLS (FramedContentCommit RawMLS Commit
commit) = do
    FramedContentDataTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentDataTag
FramedContentCommitTag
    RawMLS Commit -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS RawMLS Commit
commit

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.1-2
data FramedContentTBS = FramedContentTBS
  { FramedContentTBS -> ProtocolVersion
protocolVersion :: ProtocolVersion,
    FramedContentTBS -> WireFormatTag
wireFormat :: WireFormatTag,
    FramedContentTBS -> RawMLS FramedContent
content :: RawMLS FramedContent,
    FramedContentTBS -> Maybe (RawMLS GroupContext)
groupContext :: Maybe (RawMLS GroupContext)
  }
  deriving (FramedContentTBS -> FramedContentTBS -> Bool
(FramedContentTBS -> FramedContentTBS -> Bool)
-> (FramedContentTBS -> FramedContentTBS -> Bool)
-> Eq FramedContentTBS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramedContentTBS -> FramedContentTBS -> Bool
== :: FramedContentTBS -> FramedContentTBS -> Bool
$c/= :: FramedContentTBS -> FramedContentTBS -> Bool
/= :: FramedContentTBS -> FramedContentTBS -> Bool
Eq, Int -> FramedContentTBS -> ShowS
[FramedContentTBS] -> ShowS
FramedContentTBS -> [Char]
(Int -> FramedContentTBS -> ShowS)
-> (FramedContentTBS -> [Char])
-> ([FramedContentTBS] -> ShowS)
-> Show FramedContentTBS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramedContentTBS -> ShowS
showsPrec :: Int -> FramedContentTBS -> ShowS
$cshow :: FramedContentTBS -> [Char]
show :: FramedContentTBS -> [Char]
$cshowList :: [FramedContentTBS] -> ShowS
showList :: [FramedContentTBS] -> ShowS
Show)

instance SerialiseMLS FramedContentTBS where
  serialiseMLS :: FramedContentTBS -> Put
serialiseMLS FramedContentTBS
tbs = do
    ProtocolVersion -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentTBS
tbs.protocolVersion
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentTBS
tbs.wireFormat
    RawMLS FramedContent -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentTBS
tbs.content
    (RawMLS GroupContext -> Put) -> Maybe (RawMLS GroupContext) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ RawMLS GroupContext -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS FramedContentTBS
tbs.groupContext

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.1-2
data FramedContentAuthData = FramedContentAuthData
  { FramedContentAuthData -> ByteString
signature_ :: ByteString,
    -- Present iff it is part of a commit.
    FramedContentAuthData -> Maybe ByteString
confirmationTag :: Maybe ByteString
  }
  deriving (FramedContentAuthData -> FramedContentAuthData -> Bool
(FramedContentAuthData -> FramedContentAuthData -> Bool)
-> (FramedContentAuthData -> FramedContentAuthData -> Bool)
-> Eq FramedContentAuthData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramedContentAuthData -> FramedContentAuthData -> Bool
== :: FramedContentAuthData -> FramedContentAuthData -> Bool
$c/= :: FramedContentAuthData -> FramedContentAuthData -> Bool
/= :: FramedContentAuthData -> FramedContentAuthData -> Bool
Eq, Int -> FramedContentAuthData -> ShowS
[FramedContentAuthData] -> ShowS
FramedContentAuthData -> [Char]
(Int -> FramedContentAuthData -> ShowS)
-> (FramedContentAuthData -> [Char])
-> ([FramedContentAuthData] -> ShowS)
-> Show FramedContentAuthData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramedContentAuthData -> ShowS
showsPrec :: Int -> FramedContentAuthData -> ShowS
$cshow :: FramedContentAuthData -> [Char]
show :: FramedContentAuthData -> [Char]
$cshowList :: [FramedContentAuthData] -> ShowS
showList :: [FramedContentAuthData] -> ShowS
Show)

parseFramedContentAuthData :: FramedContentDataTag -> Get FramedContentAuthData
parseFramedContentAuthData :: FramedContentDataTag -> Get FramedContentAuthData
parseFramedContentAuthData FramedContentDataTag
t = do
  ByteString
sig <- forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
  Maybe ByteString
confirmationTag <- case FramedContentDataTag
t of
    FramedContentDataTag
FramedContentCommitTag -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Get ByteString -> Get (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
    FramedContentDataTag
_ -> Maybe ByteString -> Get (Maybe ByteString)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
  FramedContentAuthData -> Get FramedContentAuthData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString -> FramedContentAuthData
FramedContentAuthData ByteString
sig Maybe ByteString
confirmationTag)

instance SerialiseMLS FramedContentAuthData where
  serialiseMLS :: FramedContentAuthData -> Put
serialiseMLS FramedContentAuthData
ad = do
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt FramedContentAuthData
ad.signature_
    (ByteString -> Put) -> Maybe ByteString -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt) FramedContentAuthData
ad.confirmationTag

--------------------------------------------------------------------------------
-- Servant

data MLSMessageSendingStatus = MLSMessageSendingStatus
  { MLSMessageSendingStatus -> [Event]
mmssEvents :: [Event],
    MLSMessageSendingStatus -> UTCTimeMillis
mmssTime :: UTCTimeMillis
  }
  deriving (MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool
(MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool)
-> (MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool)
-> Eq MLSMessageSendingStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool
== :: MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool
$c/= :: MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool
/= :: MLSMessageSendingStatus -> MLSMessageSendingStatus -> Bool
Eq, Int -> MLSMessageSendingStatus -> ShowS
[MLSMessageSendingStatus] -> ShowS
MLSMessageSendingStatus -> [Char]
(Int -> MLSMessageSendingStatus -> ShowS)
-> (MLSMessageSendingStatus -> [Char])
-> ([MLSMessageSendingStatus] -> ShowS)
-> Show MLSMessageSendingStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSMessageSendingStatus -> ShowS
showsPrec :: Int -> MLSMessageSendingStatus -> ShowS
$cshow :: MLSMessageSendingStatus -> [Char]
show :: MLSMessageSendingStatus -> [Char]
$cshowList :: [MLSMessageSendingStatus] -> ShowS
showList :: [MLSMessageSendingStatus] -> ShowS
Show)
  deriving ([MLSMessageSendingStatus] -> Value
[MLSMessageSendingStatus] -> Encoding
MLSMessageSendingStatus -> Value
MLSMessageSendingStatus -> Encoding
(MLSMessageSendingStatus -> Value)
-> (MLSMessageSendingStatus -> Encoding)
-> ([MLSMessageSendingStatus] -> Value)
-> ([MLSMessageSendingStatus] -> Encoding)
-> ToJSON MLSMessageSendingStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MLSMessageSendingStatus -> Value
toJSON :: MLSMessageSendingStatus -> Value
$ctoEncoding :: MLSMessageSendingStatus -> Encoding
toEncoding :: MLSMessageSendingStatus -> Encoding
$ctoJSONList :: [MLSMessageSendingStatus] -> Value
toJSONList :: [MLSMessageSendingStatus] -> Value
$ctoEncodingList :: [MLSMessageSendingStatus] -> Encoding
toEncodingList :: [MLSMessageSendingStatus] -> Encoding
A.ToJSON, Value -> Parser [MLSMessageSendingStatus]
Value -> Parser MLSMessageSendingStatus
(Value -> Parser MLSMessageSendingStatus)
-> (Value -> Parser [MLSMessageSendingStatus])
-> FromJSON MLSMessageSendingStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MLSMessageSendingStatus
parseJSON :: Value -> Parser MLSMessageSendingStatus
$cparseJSONList :: Value -> Parser [MLSMessageSendingStatus]
parseJSONList :: Value -> Parser [MLSMessageSendingStatus]
A.FromJSON, Typeable MLSMessageSendingStatus
Typeable MLSMessageSendingStatus =>
(Proxy MLSMessageSendingStatus
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema MLSMessageSendingStatus
Proxy MLSMessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy MLSMessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy MLSMessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema MLSMessageSendingStatus

instance ToSchema MLSMessageSendingStatus where
  schema :: ValueSchema NamedSwaggerDoc MLSMessageSendingStatus
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSMessageSendingStatus
     MLSMessageSendingStatus
-> ValueSchema NamedSwaggerDoc MLSMessageSendingStatus
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"MLSMessageSendingStatus" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   MLSMessageSendingStatus
   MLSMessageSendingStatus
 -> ValueSchema NamedSwaggerDoc MLSMessageSendingStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSMessageSendingStatus
     MLSMessageSendingStatus
-> ValueSchema NamedSwaggerDoc MLSMessageSendingStatus
forall a b. (a -> b) -> a -> b
$
      [Event] -> UTCTimeMillis -> MLSMessageSendingStatus
MLSMessageSendingStatus
        ([Event] -> UTCTimeMillis -> MLSMessageSendingStatus)
-> SchemaP SwaggerDoc Object [Pair] MLSMessageSendingStatus [Event]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSMessageSendingStatus
     (UTCTimeMillis -> MLSMessageSendingStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MLSMessageSendingStatus -> [Event]
mmssEvents
          (MLSMessageSendingStatus -> [Event])
-> SchemaP SwaggerDoc Object [Pair] [Event] [Event]
-> SchemaP SwaggerDoc Object [Pair] MLSMessageSendingStatus [Event]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [Event] [Event]
-> SchemaP SwaggerDoc Object [Pair] [Event] [Event]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"events"
            ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A list of events caused by sending the message.")
            (ValueSchema NamedSwaggerDoc Event
-> SchemaP SwaggerDoc Value Value [Event] [Event]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Event
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MLSMessageSendingStatus
  (UTCTimeMillis -> MLSMessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MLSMessageSendingStatus UTCTimeMillis
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSMessageSendingStatus
     MLSMessageSendingStatus
forall a b.
SchemaP SwaggerDoc Object [Pair] MLSMessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MLSMessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MLSMessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSMessageSendingStatus -> UTCTimeMillis
mmssTime
          (MLSMessageSendingStatus -> UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
-> SchemaP
     SwaggerDoc Object [Pair] MLSMessageSendingStatus UTCTimeMillis
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"time"
            ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The time of sending the message.")
            SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema