{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

import Imports
import Test.QuickCheck
import Wire.API.MLS.Serialisation

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-5.1.1-2
newtype HPKEPublicKey = HPKEPublicKey {HPKEPublicKey -> ByteString
unHPKEPublicKey :: ByteString}
  deriving (Int -> HPKEPublicKey -> ShowS
[HPKEPublicKey] -> ShowS
HPKEPublicKey -> String
(Int -> HPKEPublicKey -> ShowS)
-> (HPKEPublicKey -> String)
-> ([HPKEPublicKey] -> ShowS)
-> Show HPKEPublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HPKEPublicKey -> ShowS
showsPrec :: Int -> HPKEPublicKey -> ShowS
$cshow :: HPKEPublicKey -> String
show :: HPKEPublicKey -> String
$cshowList :: [HPKEPublicKey] -> ShowS
showList :: [HPKEPublicKey] -> ShowS
Show, HPKEPublicKey -> HPKEPublicKey -> Bool
(HPKEPublicKey -> HPKEPublicKey -> Bool)
-> (HPKEPublicKey -> HPKEPublicKey -> Bool) -> Eq HPKEPublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HPKEPublicKey -> HPKEPublicKey -> Bool
== :: HPKEPublicKey -> HPKEPublicKey -> Bool
$c/= :: HPKEPublicKey -> HPKEPublicKey -> Bool
/= :: HPKEPublicKey -> HPKEPublicKey -> Bool
Eq, Gen HPKEPublicKey
Gen HPKEPublicKey
-> (HPKEPublicKey -> [HPKEPublicKey]) -> Arbitrary HPKEPublicKey
HPKEPublicKey -> [HPKEPublicKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen HPKEPublicKey
arbitrary :: Gen HPKEPublicKey
$cshrink :: HPKEPublicKey -> [HPKEPublicKey]
shrink :: HPKEPublicKey -> [HPKEPublicKey]
Arbitrary)

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

instance SerialiseMLS HPKEPublicKey where
  serialiseMLS :: HPKEPublicKey -> Put
serialiseMLS = forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt (ByteString -> Put)
-> (HPKEPublicKey -> ByteString) -> HPKEPublicKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HPKEPublicKey -> ByteString
unHPKEPublicKey