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

import Data.OpenApi qualified as S
import Imports
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Commit
import Wire.API.MLS.KeyPackage
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.1-5
data Welcome = Welcome
  { Welcome -> CipherSuite
welCipherSuite :: CipherSuite,
    Welcome -> [GroupSecrets]
welSecrets :: [GroupSecrets],
    Welcome -> ByteString
welGroupInfo :: ByteString
  }
  deriving (Int -> Welcome -> ShowS
[Welcome] -> ShowS
Welcome -> String
(Int -> Welcome -> ShowS)
-> (Welcome -> String) -> ([Welcome] -> ShowS) -> Show Welcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Welcome -> ShowS
showsPrec :: Int -> Welcome -> ShowS
$cshow :: Welcome -> String
show :: Welcome -> String
$cshowList :: [Welcome] -> ShowS
showList :: [Welcome] -> ShowS
Show, Welcome -> Welcome -> Bool
(Welcome -> Welcome -> Bool)
-> (Welcome -> Welcome -> Bool) -> Eq Welcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Welcome -> Welcome -> Bool
== :: Welcome -> Welcome -> Bool
$c/= :: Welcome -> Welcome -> Bool
/= :: Welcome -> Welcome -> Bool
Eq, (forall x. Welcome -> Rep Welcome x)
-> (forall x. Rep Welcome x -> Welcome) -> Generic Welcome
forall x. Rep Welcome x -> Welcome
forall x. Welcome -> Rep Welcome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Welcome -> Rep Welcome x
from :: forall x. Welcome -> Rep Welcome x
$cto :: forall x. Rep Welcome x -> Welcome
to :: forall x. Rep Welcome x -> Welcome
Generic)
  deriving (Gen Welcome
Gen Welcome -> (Welcome -> [Welcome]) -> Arbitrary Welcome
Welcome -> [Welcome]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Welcome
arbitrary :: Gen Welcome
$cshrink :: Welcome -> [Welcome]
shrink :: Welcome -> [Welcome]
Arbitrary) via (GenericUniform Welcome)

instance S.ToSchema Welcome where
  declareNamedSchema :: Proxy Welcome -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Welcome
_ = 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
"Welcome")

instance ParseMLS Welcome where
  parseMLS :: Get Welcome
parseMLS =
    CipherSuite -> [GroupSecrets] -> ByteString -> Welcome
Welcome
      (CipherSuite -> [GroupSecrets] -> ByteString -> Welcome)
-> Get CipherSuite -> Get ([GroupSecrets] -> ByteString -> Welcome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherSuite
forall a. ParseMLS a => Get a
parseMLS
      Get ([GroupSecrets] -> ByteString -> Welcome)
-> Get [GroupSecrets] -> Get (ByteString -> Welcome)
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 GroupSecrets
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> Welcome) -> Get ByteString -> Get Welcome
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 Welcome where
  serialiseMLS :: Welcome -> Put
serialiseMLS (Welcome CipherSuite
cs [GroupSecrets]
ss ByteString
gi) = do
    CipherSuite -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS CipherSuite
cs
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt GroupSecrets -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS [GroupSecrets]
ss
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt ByteString
gi

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

instance ParseMLS GroupSecrets where
  parseMLS :: Get GroupSecrets
parseMLS = KeyPackageRef -> HPKECiphertext -> GroupSecrets
GroupSecrets (KeyPackageRef -> HPKECiphertext -> GroupSecrets)
-> Get KeyPackageRef -> Get (HPKECiphertext -> GroupSecrets)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get KeyPackageRef
forall a. ParseMLS a => Get a
parseMLS Get (HPKECiphertext -> GroupSecrets)
-> Get HPKECiphertext -> Get GroupSecrets
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get HPKECiphertext
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS GroupSecrets where
  serialiseMLS :: GroupSecrets -> Put
serialiseMLS (GroupSecrets KeyPackageRef
kp HPKECiphertext
sec) = do
    KeyPackageRef -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS KeyPackageRef
kp
    HPKECiphertext -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS HPKECiphertext
sec