-- 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.Commit where

import Imports
import Wire.API.MLS.LeafNode
import Wire.API.MLS.Proposal
import Wire.API.MLS.Serialisation
import Wire.Arbitrary

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-12.4-3
data Commit = Commit
  { Commit -> [ProposalOrRef]
proposals :: [ProposalOrRef],
    Commit -> Maybe UpdatePath
path :: Maybe UpdatePath
  }
  deriving (Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
/= :: Commit -> Commit -> Bool
Eq, Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
(Int -> Commit -> ShowS)
-> (Commit -> String) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Commit -> ShowS
showsPrec :: Int -> Commit -> ShowS
$cshow :: Commit -> String
show :: Commit -> String
$cshowList :: [Commit] -> ShowS
showList :: [Commit] -> ShowS
Show, (forall x. Commit -> Rep Commit x)
-> (forall x. Rep Commit x -> Commit) -> Generic Commit
forall x. Rep Commit x -> Commit
forall x. Commit -> Rep Commit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Commit -> Rep Commit x
from :: forall x. Commit -> Rep Commit x
$cto :: forall x. Rep Commit x -> Commit
to :: forall x. Rep Commit x -> Commit
Generic)
  deriving (Gen Commit
Gen Commit -> (Commit -> [Commit]) -> Arbitrary Commit
Commit -> [Commit]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Commit
arbitrary :: Gen Commit
$cshrink :: Commit -> [Commit]
shrink :: Commit -> [Commit]
Arbitrary) via (GenericUniform Commit)

instance ParseMLS Commit where
  parseMLS :: Get Commit
parseMLS =
    [ProposalOrRef] -> Maybe UpdatePath -> Commit
Commit
      ([ProposalOrRef] -> Maybe UpdatePath -> Commit)
-> Get [ProposalOrRef] -> Get (Maybe UpdatePath -> Commit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w a. (Binary w, Integral w) => Get a -> Get [a]
parseMLSVector @VarInt Get ProposalOrRef
forall a. ParseMLS a => Get a
parseMLS
      Get (Maybe UpdatePath -> Commit)
-> Get (Maybe UpdatePath) -> Get Commit
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get UpdatePath -> Get (Maybe UpdatePath)
forall a. Get a -> Get (Maybe a)
parseMLSOptional Get UpdatePath
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS Commit where
  serialiseMLS :: Commit -> Put
serialiseMLS Commit
c = do
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt ProposalOrRef -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS Commit
c.proposals
    (UpdatePath -> Put) -> Maybe UpdatePath -> Put
forall a. (a -> Put) -> Maybe a -> Put
serialiseMLSOptional UpdatePath -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS Commit
c.path

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-7.6-2
data UpdatePath = UpdatePath
  { UpdatePath -> RawMLS LeafNode
leaf :: RawMLS LeafNode,
    UpdatePath -> [UpdatePathNode]
nodes :: [UpdatePathNode]
  }
  deriving (UpdatePath -> UpdatePath -> Bool
(UpdatePath -> UpdatePath -> Bool)
-> (UpdatePath -> UpdatePath -> Bool) -> Eq UpdatePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdatePath -> UpdatePath -> Bool
== :: UpdatePath -> UpdatePath -> Bool
$c/= :: UpdatePath -> UpdatePath -> Bool
/= :: UpdatePath -> UpdatePath -> Bool
Eq, Int -> UpdatePath -> ShowS
[UpdatePath] -> ShowS
UpdatePath -> String
(Int -> UpdatePath -> ShowS)
-> (UpdatePath -> String)
-> ([UpdatePath] -> ShowS)
-> Show UpdatePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdatePath -> ShowS
showsPrec :: Int -> UpdatePath -> ShowS
$cshow :: UpdatePath -> String
show :: UpdatePath -> String
$cshowList :: [UpdatePath] -> ShowS
showList :: [UpdatePath] -> ShowS
Show, (forall x. UpdatePath -> Rep UpdatePath x)
-> (forall x. Rep UpdatePath x -> UpdatePath) -> Generic UpdatePath
forall x. Rep UpdatePath x -> UpdatePath
forall x. UpdatePath -> Rep UpdatePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdatePath -> Rep UpdatePath x
from :: forall x. UpdatePath -> Rep UpdatePath x
$cto :: forall x. Rep UpdatePath x -> UpdatePath
to :: forall x. Rep UpdatePath x -> UpdatePath
Generic)
  deriving (Gen UpdatePath
Gen UpdatePath
-> (UpdatePath -> [UpdatePath]) -> Arbitrary UpdatePath
UpdatePath -> [UpdatePath]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdatePath
arbitrary :: Gen UpdatePath
$cshrink :: UpdatePath -> [UpdatePath]
shrink :: UpdatePath -> [UpdatePath]
Arbitrary) via (GenericUniform UpdatePath)

instance ParseMLS UpdatePath where
  parseMLS :: Get UpdatePath
parseMLS = RawMLS LeafNode -> [UpdatePathNode] -> UpdatePath
UpdatePath (RawMLS LeafNode -> [UpdatePathNode] -> UpdatePath)
-> Get (RawMLS LeafNode) -> Get ([UpdatePathNode] -> UpdatePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RawMLS LeafNode)
forall a. ParseMLS a => Get a
parseMLS Get ([UpdatePathNode] -> UpdatePath)
-> Get [UpdatePathNode] -> Get UpdatePath
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 a. (Binary w, Integral w) => Get a -> Get [a]
parseMLSVector @VarInt Get UpdatePathNode
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS UpdatePath where
  serialiseMLS :: UpdatePath -> Put
serialiseMLS UpdatePath
up = do
    RawMLS LeafNode -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS UpdatePath
up.leaf
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt UpdatePathNode -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS UpdatePath
up.nodes

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-7.6-2
data UpdatePathNode = UpdatePathNode
  { UpdatePathNode -> ByteString
publicKey :: ByteString,
    UpdatePathNode -> [HPKECiphertext]
secret :: [HPKECiphertext]
  }
  deriving (UpdatePathNode -> UpdatePathNode -> Bool
(UpdatePathNode -> UpdatePathNode -> Bool)
-> (UpdatePathNode -> UpdatePathNode -> Bool) -> Eq UpdatePathNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdatePathNode -> UpdatePathNode -> Bool
== :: UpdatePathNode -> UpdatePathNode -> Bool
$c/= :: UpdatePathNode -> UpdatePathNode -> Bool
/= :: UpdatePathNode -> UpdatePathNode -> Bool
Eq, Int -> UpdatePathNode -> ShowS
[UpdatePathNode] -> ShowS
UpdatePathNode -> String
(Int -> UpdatePathNode -> ShowS)
-> (UpdatePathNode -> String)
-> ([UpdatePathNode] -> ShowS)
-> Show UpdatePathNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdatePathNode -> ShowS
showsPrec :: Int -> UpdatePathNode -> ShowS
$cshow :: UpdatePathNode -> String
show :: UpdatePathNode -> String
$cshowList :: [UpdatePathNode] -> ShowS
showList :: [UpdatePathNode] -> ShowS
Show, (forall x. UpdatePathNode -> Rep UpdatePathNode x)
-> (forall x. Rep UpdatePathNode x -> UpdatePathNode)
-> Generic UpdatePathNode
forall x. Rep UpdatePathNode x -> UpdatePathNode
forall x. UpdatePathNode -> Rep UpdatePathNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdatePathNode -> Rep UpdatePathNode x
from :: forall x. UpdatePathNode -> Rep UpdatePathNode x
$cto :: forall x. Rep UpdatePathNode x -> UpdatePathNode
to :: forall x. Rep UpdatePathNode x -> UpdatePathNode
Generic)
  deriving (Gen UpdatePathNode
Gen UpdatePathNode
-> (UpdatePathNode -> [UpdatePathNode]) -> Arbitrary UpdatePathNode
UpdatePathNode -> [UpdatePathNode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdatePathNode
arbitrary :: Gen UpdatePathNode
$cshrink :: UpdatePathNode -> [UpdatePathNode]
shrink :: UpdatePathNode -> [UpdatePathNode]
Arbitrary) via (GenericUniform UpdatePathNode)

instance ParseMLS UpdatePathNode where
  parseMLS :: Get UpdatePathNode
parseMLS = ByteString -> [HPKECiphertext] -> UpdatePathNode
UpdatePathNode (ByteString -> [HPKECiphertext] -> UpdatePathNode)
-> Get ByteString -> Get ([HPKECiphertext] -> UpdatePathNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt Get ([HPKECiphertext] -> UpdatePathNode)
-> Get [HPKECiphertext] -> Get UpdatePathNode
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 a. (Binary w, Integral w) => Get a -> Get [a]
parseMLSVector @VarInt Get HPKECiphertext
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS UpdatePathNode where
  serialiseMLS :: UpdatePathNode -> Put
serialiseMLS UpdatePathNode
upn = do
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt UpdatePathNode
upn.publicKey
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt HPKECiphertext -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS UpdatePathNode
upn.secret

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-7.6-2
data HPKECiphertext = HPKECiphertext
  { HPKECiphertext -> ByteString
output :: ByteString,
    HPKECiphertext -> ByteString
ciphertext :: ByteString
  }
  deriving (HPKECiphertext -> HPKECiphertext -> Bool
(HPKECiphertext -> HPKECiphertext -> Bool)
-> (HPKECiphertext -> HPKECiphertext -> Bool) -> Eq HPKECiphertext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HPKECiphertext -> HPKECiphertext -> Bool
== :: HPKECiphertext -> HPKECiphertext -> Bool
$c/= :: HPKECiphertext -> HPKECiphertext -> Bool
/= :: HPKECiphertext -> HPKECiphertext -> Bool
Eq, Int -> HPKECiphertext -> ShowS
[HPKECiphertext] -> ShowS
HPKECiphertext -> String
(Int -> HPKECiphertext -> ShowS)
-> (HPKECiphertext -> String)
-> ([HPKECiphertext] -> ShowS)
-> Show HPKECiphertext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HPKECiphertext -> ShowS
showsPrec :: Int -> HPKECiphertext -> ShowS
$cshow :: HPKECiphertext -> String
show :: HPKECiphertext -> String
$cshowList :: [HPKECiphertext] -> ShowS
showList :: [HPKECiphertext] -> ShowS
Show, (forall x. HPKECiphertext -> Rep HPKECiphertext x)
-> (forall x. Rep HPKECiphertext x -> HPKECiphertext)
-> Generic HPKECiphertext
forall x. Rep HPKECiphertext x -> HPKECiphertext
forall x. HPKECiphertext -> Rep HPKECiphertext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HPKECiphertext -> Rep HPKECiphertext x
from :: forall x. HPKECiphertext -> Rep HPKECiphertext x
$cto :: forall x. Rep HPKECiphertext x -> HPKECiphertext
to :: forall x. Rep HPKECiphertext x -> HPKECiphertext
Generic)
  deriving (Gen HPKECiphertext
Gen HPKECiphertext
-> (HPKECiphertext -> [HPKECiphertext]) -> Arbitrary HPKECiphertext
HPKECiphertext -> [HPKECiphertext]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen HPKECiphertext
arbitrary :: Gen HPKECiphertext
$cshrink :: HPKECiphertext -> [HPKECiphertext]
shrink :: HPKECiphertext -> [HPKECiphertext]
Arbitrary) via (GenericUniform HPKECiphertext)

instance ParseMLS HPKECiphertext where
  parseMLS :: Get HPKECiphertext
parseMLS = ByteString -> ByteString -> HPKECiphertext
HPKECiphertext (ByteString -> ByteString -> HPKECiphertext)
-> Get ByteString -> Get (ByteString -> HPKECiphertext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt Get (ByteString -> HPKECiphertext)
-> Get ByteString -> Get HPKECiphertext
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

instance SerialiseMLS HPKECiphertext where
  serialiseMLS :: HPKECiphertext -> Put
serialiseMLS (HPKECiphertext ByteString
out ByteString
ct) = do
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt ByteString
out
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt ByteString
ct