{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Crypto.HPKE.Setup (
    setupBaseS,
    setupBaseR,
    setupPSKS,
    setupPSKR,
    setupS,
    setupR,
) where

import qualified Control.Exception as E

import Crypto.HPKE.AEAD
import Crypto.HPKE.Context
import Crypto.HPKE.ID
import Crypto.HPKE.KDF
import Crypto.HPKE.KEM
import Crypto.HPKE.KeySchedule
import Crypto.HPKE.Types

-- | Setting up base/auth mode for a sender.
--   This throws 'HPKEError'.
setupBaseS
    :: KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> Maybe EncodedSecretKey
    -- ^ My ephemeral secret key. Automatically generated if 'Nothing'
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> IO (EncodedPublicKey, ContextS)
setupBaseS :: KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupBaseS KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id Maybe EncodedSecretKey
mskEm Maybe EncodedSecretKey
mskSm EncodedPublicKey
pkRm ByteString
info =
    HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupS HPKEMap
defaultHPKEMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id Maybe EncodedSecretKey
mskEm Maybe EncodedSecretKey
mskSm EncodedPublicKey
pkRm ByteString
info ByteString
"" ByteString
""
  where
    mode :: Mode
mode = case Maybe EncodedSecretKey
mskSm of
        Maybe EncodedSecretKey
Nothing -> Mode
ModeBase
        Maybe EncodedSecretKey
_ -> Mode
ModeAuth

-- | Setting up base/auth mode for a receiver with its key pair.
--   This throws 'HPKEError'.
setupBaseR
    :: KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> EncodedSecretKey
    -- ^ My secret key
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> IO ContextR
setupBaseR :: KEM_ID
-> KDF_ID
-> AEAD_ID
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> IO ContextR
setupBaseR KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm EncodedPublicKey
enc ByteString
info =
    HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO ContextR
setupR HPKEMap
defaultHPKEMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm EncodedPublicKey
enc ByteString
info ByteString
"" ByteString
""
  where
    mode :: Mode
mode = case Maybe EncodedSecretKey
mskSm of
        Maybe EncodedSecretKey
Nothing -> Mode
ModeBase
        Maybe EncodedSecretKey
_ -> Mode
ModeAuth

----------------------------------------------------------------

-- | Setting up psk/auth_psk mode for a sender.
--   This throws 'HPKEError'.
setupPSKS
    :: KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> Maybe EncodedSecretKey
    -- ^ My ephemeral secret key. Automatically generated if 'Nothing'
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> PSK
    -> PSK_ID
    -> IO (EncodedPublicKey, ContextS)
setupPSKS :: KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupPSKS KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id Maybe EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm =
    HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupS HPKEMap
defaultHPKEMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id Maybe EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm
  where
    mode :: Mode
mode = case Maybe EncodedSecretKey
mskSm of
        Maybe EncodedSecretKey
Nothing -> Mode
ModePsk
        Maybe EncodedSecretKey
_ -> Mode
ModeAuthPsk

-- | Setting up psk/auth_psk mode for a receiver with its key pair.
--   This throws 'HPKEError'.
setupPSKR
    :: KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> EncodedSecretKey
    -- ^ My secret key
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> PSK
    -> PSK_ID
    -> IO ContextR
setupPSKR :: KEM_ID
-> KDF_ID
-> AEAD_ID
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO ContextR
setupPSKR KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm =
    HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO ContextR
setupR HPKEMap
defaultHPKEMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm
  where
    mode :: Mode
mode = case Maybe EncodedSecretKey
mskSm of
        Maybe EncodedSecretKey
Nothing -> Mode
ModePsk
        Maybe EncodedSecretKey
_ -> Mode
ModeAuthPsk

----------------------------------------------------------------

setupS
    :: HPKEMap
    -> Mode
    -> KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> Maybe EncodedSecretKey
    -- ^ My ephemeral secret key. Automatically generated if 'Nothing'
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> PSK
    -> PSK_ID
    -> IO (EncodedPublicKey, ContextS)
setupS :: HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupS HPKEMap
hpkeMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id Maybe EncodedSecretKey
mskEm Maybe EncodedSecretKey
mskSm EncodedPublicKey
pkRm ByteString
info ByteString
psk ByteString
psk_id = do
    Mode -> ByteString -> ByteString -> IO ()
verifyPSKInput Mode
mode ByteString
psk ByteString
psk_id
    let r :: Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
r = HPKEMap
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
look HPKEMap
hpkeMap KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id
    Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
-> (((KEMGroup, KDFHash), KDFHash, AEADCipher)
    -> IO (EncodedPublicKey, ContextS))
-> IO (EncodedPublicKey, ContextS)
forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
r ((((KEMGroup, KDFHash), KDFHash, AEADCipher)
  -> IO (EncodedPublicKey, ContextS))
 -> IO (EncodedPublicKey, ContextS))
-> (((KEMGroup, KDFHash), KDFHash, AEADCipher)
    -> IO (EncodedPublicKey, ContextS))
-> IO (EncodedPublicKey, ContextS)
forall a b. (a -> b) -> a -> b
$ \((KEMGroup Proxy c
group, KDFHash h
h), KDFHash h
h', AEADCipher Proxy a
c) -> do
        let derive :: KeyDeriveFunction
derive = h -> ByteString -> KeyDeriveFunction
forall h.
(HashAlgorithm h, KDF h) =>
h -> ByteString -> KeyDeriveFunction
extractAndExpand h
h (ByteString -> KeyDeriveFunction)
-> ByteString -> KeyDeriveFunction
forall a b. (a -> b) -> a -> b
$ KEM_ID -> ByteString
suiteKEM KEM_ID
kem_id
        encap <- case Maybe EncodedSecretKey
mskEm of
            Maybe EncodedSecretKey
Nothing -> Proxy c -> KeyDeriveFunction -> Maybe EncodedSecretKey -> IO Encap
forall group.
(EllipticCurve group, EllipticCurveDH group) =>
Proxy group
-> KeyDeriveFunction -> Maybe EncodedSecretKey -> IO Encap
encapGen Proxy c
group KeyDeriveFunction
derive Maybe EncodedSecretKey
mskSm
            Just EncodedSecretKey
skEm -> Encap -> IO Encap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Encap -> IO Encap) -> Encap -> IO Encap
forall a b. (a -> b) -> a -> b
$ Proxy c
-> KeyDeriveFunction
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> Encap
forall group.
(EllipticCurve group, EllipticCurveDH group) =>
Proxy group
-> KeyDeriveFunction
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> Encap
encapEnv Proxy c
group KeyDeriveFunction
derive EncodedSecretKey
skEm Maybe EncodedSecretKey
mskSm
        throwOnError (encap pkRm) $ \(SharedSecret
shared_secret, EncodedPublicKey
enc) -> do
            let (Int
nk, Int
nn, ByteString -> Seal
seal', ByteString -> Seal
_) = Proxy a -> (Int, Int, ByteString -> Seal, ByteString -> Seal)
forall a.
Aead a =>
Proxy a -> (Int, Int, ByteString -> Seal, ByteString -> Seal)
aeadParams Proxy a
c
                suite' :: ByteString
suite' = KEM_ID -> KDF_ID -> AEAD_ID -> ByteString
suiteHPKE KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id
                keys :: Either HPKEError (ByteString, ByteString, Int, PRK h)
keys = h
-> ByteString
-> Int
-> Int
-> Mode
-> ByteString
-> ByteString
-> ByteString
-> SharedSecret
-> Either HPKEError (ByteString, ByteString, Int, PRK h)
forall h.
(HashAlgorithm h, KDF h) =>
h
-> ByteString
-> Int
-> Int
-> Mode
-> ByteString
-> ByteString
-> ByteString
-> SharedSecret
-> Either HPKEError (ByteString, ByteString, Int, PRK h)
keySchedule h
h' ByteString
suite' Int
nk Int
nn Mode
mode ByteString
info ByteString
psk ByteString
psk_id SharedSecret
shared_secret
            Either HPKEError (ByteString, ByteString, Int, PRK h)
-> ((ByteString, ByteString, Int, PRK h)
    -> IO (EncodedPublicKey, ContextS))
-> IO (EncodedPublicKey, ContextS)
forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError Either HPKEError (ByteString, ByteString, Int, PRK h)
keys (((ByteString, ByteString, Int, PRK h)
  -> IO (EncodedPublicKey, ContextS))
 -> IO (EncodedPublicKey, ContextS))
-> ((ByteString, ByteString, Int, PRK h)
    -> IO (EncodedPublicKey, ContextS))
-> IO (EncodedPublicKey, ContextS)
forall a b. (a -> b) -> a -> b
$ \(ByteString
key, ByteString
nonce, Int
_, PRK h
prk) -> do
                let expand' :: ByteString -> Int -> ByteString
expand' = ByteString
-> PRK h -> ByteString -> ByteString -> Int -> ByteString
forall h.
KDF h =>
ByteString
-> PRK h -> ByteString -> ByteString -> Int -> ByteString
labeledExpand ByteString
suite' PRK h
prk ByteString
"sec"
                ctx <- ByteString
-> ByteString
-> (ByteString -> Seal)
-> (ByteString -> Int -> ByteString)
-> IO ContextS
newContextS ByteString
key ByteString
nonce ByteString -> Seal
seal' ByteString -> Int -> ByteString
expand'
                return (enc, ctx)

setupR
    :: HPKEMap
    -> Mode
    -> KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> EncodedSecretKey
    -- ^ My secret key
    -> Maybe EncodedSecretKey
    -- ^ My secret key for authentication.
    --   'mode_base' is used if 'Nothing'. 'base_auth' is used, otherwise.
    -> EncodedPublicKey
    -- ^ Peer's public key.
    -> Info
    -> PSK
    -> PSK_ID
    -> IO ContextR
setupR :: HPKEMap
-> Mode
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> ByteString
-> ByteString
-> IO ContextR
setupR HPKEMap
hpkeMap Mode
mode KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm EncodedPublicKey
enc ByteString
info ByteString
psk ByteString
psk_id = do
    Mode -> ByteString -> ByteString -> IO ()
verifyPSKInput Mode
mode ByteString
psk ByteString
psk_id
    let r :: Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
r = HPKEMap
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
look HPKEMap
hpkeMap KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id
    Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
-> (((KEMGroup, KDFHash), KDFHash, AEADCipher) -> IO ContextR)
-> IO ContextR
forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
r ((((KEMGroup, KDFHash), KDFHash, AEADCipher) -> IO ContextR)
 -> IO ContextR)
-> (((KEMGroup, KDFHash), KDFHash, AEADCipher) -> IO ContextR)
-> IO ContextR
forall a b. (a -> b) -> a -> b
$ \((KEMGroup Proxy c
group, KDFHash h
h), KDFHash h
h', AEADCipher Proxy a
c) -> do
        let derive :: KeyDeriveFunction
derive = h -> ByteString -> KeyDeriveFunction
forall h.
(HashAlgorithm h, KDF h) =>
h -> ByteString -> KeyDeriveFunction
extractAndExpand h
h (ByteString -> KeyDeriveFunction)
-> ByteString -> KeyDeriveFunction
forall a b. (a -> b) -> a -> b
$ KEM_ID -> ByteString
suiteKEM KEM_ID
kem_id
            decap :: Decap
decap = Proxy c
-> KeyDeriveFunction
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> Decap
forall group.
(EllipticCurve group, EllipticCurveDH group) =>
Proxy group
-> KeyDeriveFunction
-> EncodedSecretKey
-> Maybe EncodedSecretKey
-> Decap
decapEnv Proxy c
group KeyDeriveFunction
derive EncodedSecretKey
skRm Maybe EncodedSecretKey
mskSm
        Either HPKEError SharedSecret
-> (SharedSecret -> IO ContextR) -> IO ContextR
forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError (Decap
decap EncodedPublicKey
enc) ((SharedSecret -> IO ContextR) -> IO ContextR)
-> (SharedSecret -> IO ContextR) -> IO ContextR
forall a b. (a -> b) -> a -> b
$ \SharedSecret
shared_secret -> do
            let (Int
nk, Int
nn, ByteString -> Seal
_, ByteString -> Seal
open') = Proxy a -> (Int, Int, ByteString -> Seal, ByteString -> Seal)
forall a.
Aead a =>
Proxy a -> (Int, Int, ByteString -> Seal, ByteString -> Seal)
aeadParams Proxy a
c
                suite' :: ByteString
suite' = KEM_ID -> KDF_ID -> AEAD_ID -> ByteString
suiteHPKE KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id
                keys :: Either HPKEError (ByteString, ByteString, Int, PRK h)
keys = h
-> ByteString
-> Int
-> Int
-> Mode
-> ByteString
-> ByteString
-> ByteString
-> SharedSecret
-> Either HPKEError (ByteString, ByteString, Int, PRK h)
forall h.
(HashAlgorithm h, KDF h) =>
h
-> ByteString
-> Int
-> Int
-> Mode
-> ByteString
-> ByteString
-> ByteString
-> SharedSecret
-> Either HPKEError (ByteString, ByteString, Int, PRK h)
keySchedule h
h' ByteString
suite' Int
nk Int
nn Mode
mode ByteString
info ByteString
psk ByteString
psk_id SharedSecret
shared_secret
            Either HPKEError (ByteString, ByteString, Int, PRK h)
-> ((ByteString, ByteString, Int, PRK h) -> IO ContextR)
-> IO ContextR
forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError Either HPKEError (ByteString, ByteString, Int, PRK h)
keys (((ByteString, ByteString, Int, PRK h) -> IO ContextR)
 -> IO ContextR)
-> ((ByteString, ByteString, Int, PRK h) -> IO ContextR)
-> IO ContextR
forall a b. (a -> b) -> a -> b
$ \(ByteString
key, ByteString
nonce, Int
_, PRK h
prk) -> do
                let expand' :: ByteString -> Int -> ByteString
expand' = ByteString
-> PRK h -> ByteString -> ByteString -> Int -> ByteString
forall h.
KDF h =>
ByteString
-> PRK h -> ByteString -> ByteString -> Int -> ByteString
labeledExpand ByteString
suite' PRK h
prk ByteString
"sec"
                ByteString
-> ByteString
-> (ByteString -> Seal)
-> (ByteString -> Int -> ByteString)
-> IO ContextR
newContextR ByteString
key ByteString
nonce ByteString -> Seal
open' ByteString -> Int -> ByteString
expand'

aeadParams
    :: Aead a
    => Proxy a -> (Int, Int, Key -> Seal, Key -> Open)
aeadParams :: forall a.
Aead a =>
Proxy a -> (Int, Int, ByteString -> Seal, ByteString -> Seal)
aeadParams Proxy a
c = (Proxy a -> Int
forall a. Aead a => Proxy a -> Int
nK Proxy a
c, Proxy a -> Int
forall a. Aead a => Proxy a -> Int
nN Proxy a
c, Proxy a -> ByteString -> Seal
forall a. Aead a => Proxy a -> ByteString -> Seal
sealA Proxy a
c, Proxy a -> ByteString -> Seal
forall a. Aead a => Proxy a -> ByteString -> Seal
openA Proxy a
c)

throwOnError :: Either HPKEError v -> (v -> IO a) -> IO a
throwOnError :: forall v a. Either HPKEError v -> (v -> IO a) -> IO a
throwOnError (Left HPKEError
err) v -> IO a
_body = HPKEError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO HPKEError
err
throwOnError (Right v
ss) v -> IO a
body = v -> IO a
body v
ss

----------------------------------------------------------------

look
    :: HPKEMap
    -> KEM_ID
    -> KDF_ID
    -> AEAD_ID
    -> Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
look :: HPKEMap
-> KEM_ID
-> KDF_ID
-> AEAD_ID
-> Either HPKEError ((KEMGroup, KDFHash), KDFHash, AEADCipher)
look HPKEMap{[(AEAD_ID, AEADCipher)]
[(KDF_ID, KDFHash)]
[(KEM_ID, (KEMGroup, KDFHash))]
kemMap :: [(KEM_ID, (KEMGroup, KDFHash))]
kdfMap :: [(KDF_ID, KDFHash)]
cipherMap :: [(AEAD_ID, AEADCipher)]
cipherMap :: HPKEMap -> [(AEAD_ID, AEADCipher)]
kdfMap :: HPKEMap -> [(KDF_ID, KDFHash)]
kemMap :: HPKEMap -> [(KEM_ID, (KEMGroup, KDFHash))]
..} KEM_ID
kem_id KDF_ID
kdf_id AEAD_ID
aead_id = do
    k <- KEM_ID
-> [(KEM_ID, (KEMGroup, KDFHash))]
-> Either HPKEError (KEMGroup, KDFHash)
forall k v. (Eq k, Show k) => k -> [(k, v)] -> Either HPKEError v
lookupE KEM_ID
kem_id [(KEM_ID, (KEMGroup, KDFHash))]
kemMap
    h <- lookupE kdf_id kdfMap
    a <- lookupE aead_id cipherMap
    return (k, h, a)

verifyPSKInput :: Mode -> PSK -> PSK_ID -> IO ()
verifyPSKInput :: Mode -> ByteString -> ByteString -> IO ()
verifyPSKInput Mode
mode ByteString
psk ByteString
psk_id
    | Bool
got_psk Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
got_psk_id =
        HPKEError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (HPKEError -> IO ()) -> HPKEError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> HPKEError
ValidationError String
"mismatch for psk and psk_id"
    | Bool
got_psk Bool -> Bool -> Bool
&& Mode
mode Mode -> [Mode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mode
ModeBase, Mode
ModeAuth] =
        HPKEError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (HPKEError -> IO ()) -> HPKEError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> HPKEError
ValidationError String
"invalid mode (1)"
    | (Bool -> Bool
not Bool
got_psk) Bool -> Bool -> Bool
&& Mode
mode Mode -> [Mode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mode
ModePsk, Mode
ModeAuthPsk] =
        HPKEError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (HPKEError -> IO ()) -> HPKEError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> HPKEError
ValidationError String
"invalid mode (2)"
    | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    got_psk :: Bool
got_psk = ByteString
psk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""
    got_psk_id :: Bool
got_psk_id = ByteString
psk_id ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
""

----------------------------------------------------------------

suiteKEM :: KEM_ID -> Suite
suiteKEM :: KEM_ID -> ByteString
suiteKEM KEM_ID
kem_id = ByteString
"KEM" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
i
  where
    i :: ByteString
i = Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
2 (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ KEM_ID -> Word16
fromKEM_ID KEM_ID
kem_id

suiteHPKE :: KEM_ID -> KDF_ID -> AEAD_ID -> Suite
suiteHPKE :: KEM_ID -> KDF_ID -> AEAD_ID -> ByteString
suiteHPKE KEM_ID
kem_id KDF_ID
hkdf_id AEAD_ID
aead_id = ByteString
"HPKE" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
i0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
i1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
i2
  where
    i0 :: ByteString
i0 = Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
2 (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ KEM_ID -> Word16
fromKEM_ID KEM_ID
kem_id
    i1 :: ByteString
i1 = Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
2 (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ KDF_ID -> Word16
fromKDF_ID KDF_ID
hkdf_id
    i2 :: ByteString
i2 = Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
2 (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ AEAD_ID -> Word16
fromAEAD_ID AEAD_ID
aead_id