{-# LANGUAGE RecordWildCards #-}

-- | Types for Configuration of Encrypted Client Hello.
module Network.TLS.ECH.Config (
    -- * Types
    ECHConfigList,
    ECHConfig (..),
    ECHConfigContents (..),
    HpkeKeyConfig (..),
    ConfigId,
    EncodedServerPublicKey (..),
    HpkeSymmetricCipherSuite (..),
    ECHConfigExtensionType,
    ECHConfigExtension (..),

    -- * ECH configuration list
    decodeECHConfigList,
    encodeECHConfigList,
    loadECHConfigList,
    loadECHSecretKeys,

    -- * ECH configuration
    decodeECHConfig,
    encodeECHConfig,

    -- * Low level
    getECHConfigList,
    putECHConfigList,
    sizeOfECHConfigList,
    getECHConfig,
    putECHConfig,
    sizeOfECHConfig,
) where

import qualified Control.Exception as E
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as C8
import Data.Char (isDigit)
import Data.Word
import Network.ByteOrder
import System.FilePath (takeFileName)
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

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

class SizeOf a where
    sizeof :: a -> Int

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

-- | Type for cipher suite.
data HpkeSymmetricCipherSuite = HpkeSymmetricCipherSuite
    { HpkeSymmetricCipherSuite -> Word16
kdf_id :: Word16
    , HpkeSymmetricCipherSuite -> Word16
aead_id :: Word16
    }
    deriving (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
(HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> Eq HpkeSymmetricCipherSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
== :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
$c/= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
/= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
Eq, Eq HpkeSymmetricCipherSuite
Eq HpkeSymmetricCipherSuite =>
(HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Ordering)
-> (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> (HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool)
-> (HpkeSymmetricCipherSuite
    -> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite)
-> (HpkeSymmetricCipherSuite
    -> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite)
-> Ord HpkeSymmetricCipherSuite
HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Ordering
HpkeSymmetricCipherSuite
-> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite
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 :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Ordering
compare :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Ordering
$c< :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
< :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
$c<= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
<= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
$c> :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
> :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
$c>= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
>= :: HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite -> Bool
$cmax :: HpkeSymmetricCipherSuite
-> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite
max :: HpkeSymmetricCipherSuite
-> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite
$cmin :: HpkeSymmetricCipherSuite
-> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite
min :: HpkeSymmetricCipherSuite
-> HpkeSymmetricCipherSuite -> HpkeSymmetricCipherSuite
Ord)

instance SizeOf HpkeSymmetricCipherSuite where
    sizeof :: HpkeSymmetricCipherSuite -> Offset
sizeof HpkeSymmetricCipherSuite
_ = Offset
4

instance Show HpkeSymmetricCipherSuite where
    show :: HpkeSymmetricCipherSuite -> String
show HpkeSymmetricCipherSuite{Word16
kdf_id :: HpkeSymmetricCipherSuite -> Word16
aead_id :: HpkeSymmetricCipherSuite -> Word16
kdf_id :: Word16
aead_id :: Word16
..} = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall {t}. (Eq t, Num t, PrintfArg t) => t -> String
showKDF_ID Word16
kdf_id String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall {t}. (Eq t, Num t, PrintfArg t) => t -> String
showAEAD_ID Word16
aead_id String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
      where
        showKDF_ID :: t -> String
showKDF_ID t
0x0000 = String
"KDF-Reserved"
        showKDF_ID t
0x0001 = String
"HKDF-SHA256"
        showKDF_ID t
0x0002 = String
"HKDF-SHA384"
        showKDF_ID t
0x0003 = String
"HKDF-SHA512"
        showKDF_ID t
x = String
"KDF_ID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"0x04" t
x
        showAEAD_ID :: t -> String
showAEAD_ID t
0x0000 = String
"AEAD_Reserved"
        showAEAD_ID t
0x0001 = String
"AES-128-GCM"
        showAEAD_ID t
0x0002 = String
"AES-256-GCM"
        showAEAD_ID t
0x0003 = String
"ChaCha20Poly1305"
        showAEAD_ID t
0xFFFF = String
"Export-only"
        showAEAD_ID t
x = String
"AEAD_ID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"0x04" t
x

getHpkeSymmetricCipherSuite :: ReadBuffer -> IO HpkeSymmetricCipherSuite
getHpkeSymmetricCipherSuite :: ReadBuffer -> IO HpkeSymmetricCipherSuite
getHpkeSymmetricCipherSuite ReadBuffer
rbuf =
    Word16 -> Word16 -> HpkeSymmetricCipherSuite
HpkeSymmetricCipherSuite (Word16 -> Word16 -> HpkeSymmetricCipherSuite)
-> IO Word16 -> IO (Word16 -> HpkeSymmetricCipherSuite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf IO (Word16 -> HpkeSymmetricCipherSuite)
-> IO Word16 -> IO HpkeSymmetricCipherSuite
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf

putHpkeSymmetricCipherSuite :: WriteBuffer -> HpkeSymmetricCipherSuite -> IO ()
putHpkeSymmetricCipherSuite :: WriteBuffer -> HpkeSymmetricCipherSuite -> IO ()
putHpkeSymmetricCipherSuite WriteBuffer
wbuf HpkeSymmetricCipherSuite{Word16
kdf_id :: HpkeSymmetricCipherSuite -> Word16
aead_id :: HpkeSymmetricCipherSuite -> Word16
kdf_id :: Word16
aead_id :: Word16
..} = do
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
kdf_id
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
aead_id

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

-- | Encoded public key.
newtype EncodedServerPublicKey = EncodedServerPublicKey ByteString
    deriving (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
(EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> Eq EncodedServerPublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
== :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
$c/= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
/= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
Eq, Eq EncodedServerPublicKey
Eq EncodedServerPublicKey =>
(EncodedServerPublicKey -> EncodedServerPublicKey -> Ordering)
-> (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> (EncodedServerPublicKey -> EncodedServerPublicKey -> Bool)
-> (EncodedServerPublicKey
    -> EncodedServerPublicKey -> EncodedServerPublicKey)
-> (EncodedServerPublicKey
    -> EncodedServerPublicKey -> EncodedServerPublicKey)
-> Ord EncodedServerPublicKey
EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
EncodedServerPublicKey -> EncodedServerPublicKey -> Ordering
EncodedServerPublicKey
-> EncodedServerPublicKey -> EncodedServerPublicKey
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 :: EncodedServerPublicKey -> EncodedServerPublicKey -> Ordering
compare :: EncodedServerPublicKey -> EncodedServerPublicKey -> Ordering
$c< :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
< :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
$c<= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
<= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
$c> :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
> :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
$c>= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
>= :: EncodedServerPublicKey -> EncodedServerPublicKey -> Bool
$cmax :: EncodedServerPublicKey
-> EncodedServerPublicKey -> EncodedServerPublicKey
max :: EncodedServerPublicKey
-> EncodedServerPublicKey -> EncodedServerPublicKey
$cmin :: EncodedServerPublicKey
-> EncodedServerPublicKey -> EncodedServerPublicKey
min :: EncodedServerPublicKey
-> EncodedServerPublicKey -> EncodedServerPublicKey
Ord)

instance Show EncodedServerPublicKey where
    show :: EncodedServerPublicKey -> String
show (EncodedServerPublicKey ByteString
bs) = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
B16.encode ByteString
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

instance SizeOf EncodedServerPublicKey where
    sizeof :: EncodedServerPublicKey -> Offset
sizeof (EncodedServerPublicKey ByteString
bs) = Offset
2 Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ ByteString -> Offset
BS.length ByteString
bs

-- | Configuration identifier.
type ConfigId = Word8

-- | Key configuration.
data HpkeKeyConfig = HpkeKeyConfig
    { HpkeKeyConfig -> Word8
config_id :: ConfigId
    , HpkeKeyConfig -> Word16
kem_id :: Word16
    , HpkeKeyConfig -> EncodedServerPublicKey
public_key :: EncodedServerPublicKey
    , HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
cipher_suites :: [HpkeSymmetricCipherSuite]
    }
    deriving (HpkeKeyConfig -> HpkeKeyConfig -> Bool
(HpkeKeyConfig -> HpkeKeyConfig -> Bool)
-> (HpkeKeyConfig -> HpkeKeyConfig -> Bool) -> Eq HpkeKeyConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
== :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
$c/= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
/= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
Eq, Eq HpkeKeyConfig
Eq HpkeKeyConfig =>
(HpkeKeyConfig -> HpkeKeyConfig -> Ordering)
-> (HpkeKeyConfig -> HpkeKeyConfig -> Bool)
-> (HpkeKeyConfig -> HpkeKeyConfig -> Bool)
-> (HpkeKeyConfig -> HpkeKeyConfig -> Bool)
-> (HpkeKeyConfig -> HpkeKeyConfig -> Bool)
-> (HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig)
-> (HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig)
-> Ord HpkeKeyConfig
HpkeKeyConfig -> HpkeKeyConfig -> Bool
HpkeKeyConfig -> HpkeKeyConfig -> Ordering
HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig
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 :: HpkeKeyConfig -> HpkeKeyConfig -> Ordering
compare :: HpkeKeyConfig -> HpkeKeyConfig -> Ordering
$c< :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
< :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
$c<= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
<= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
$c> :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
> :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
$c>= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
>= :: HpkeKeyConfig -> HpkeKeyConfig -> Bool
$cmax :: HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig
max :: HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig
$cmin :: HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig
min :: HpkeKeyConfig -> HpkeKeyConfig -> HpkeKeyConfig
Ord)

instance SizeOf HpkeKeyConfig where
    sizeof :: HpkeKeyConfig -> Offset
sizeof HpkeKeyConfig{[HpkeSymmetricCipherSuite]
Word8
Word16
EncodedServerPublicKey
config_id :: HpkeKeyConfig -> Word8
kem_id :: HpkeKeyConfig -> Word16
public_key :: HpkeKeyConfig -> EncodedServerPublicKey
cipher_suites :: HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
config_id :: Word8
kem_id :: Word16
public_key :: EncodedServerPublicKey
cipher_suites :: [HpkeSymmetricCipherSuite]
..} = Offset
5 Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ EncodedServerPublicKey -> Offset
forall a. SizeOf a => a -> Offset
sizeof EncodedServerPublicKey
public_key Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ [Offset] -> Offset
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((HpkeSymmetricCipherSuite -> Offset)
-> [HpkeSymmetricCipherSuite] -> [Offset]
forall a b. (a -> b) -> [a] -> [b]
map HpkeSymmetricCipherSuite -> Offset
forall a. SizeOf a => a -> Offset
sizeof [HpkeSymmetricCipherSuite]
cipher_suites)

instance Show HpkeKeyConfig where
    show :: HpkeKeyConfig -> String
show HpkeKeyConfig{[HpkeSymmetricCipherSuite]
Word8
Word16
EncodedServerPublicKey
config_id :: HpkeKeyConfig -> Word8
kem_id :: HpkeKeyConfig -> Word16
public_key :: HpkeKeyConfig -> EncodedServerPublicKey
cipher_suites :: HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
config_id :: Word8
kem_id :: Word16
public_key :: EncodedServerPublicKey
cipher_suites :: [HpkeSymmetricCipherSuite]
..} =
        String
"{"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
config_id
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall {t}. (Eq t, Num t, PrintfArg t) => t -> String
showKEM_ID Word16
kem_id
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ EncodedServerPublicKey -> String
forall a. Show a => a -> String
show EncodedServerPublicKey
public_key
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ [HpkeSymmetricCipherSuite] -> String
forall a. Show a => a -> String
show [HpkeSymmetricCipherSuite]
cipher_suites
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
      where
        showKEM_ID :: t -> String
showKEM_ID t
0x0000 = String
"KEM_Reserved"
        showKEM_ID t
0x0010 = String
"DHKEM(P-256, HKDF-SHA256)"
        showKEM_ID t
0x0011 = String
"DHKEM(P-384, HKDF-SHA384)"
        showKEM_ID t
0x0012 = String
"DHKEM(P-521, HKDF-SHA512)"
        showKEM_ID t
0x0020 = String
"DHKEM(X25519, HKDF-SHA256)"
        showKEM_ID t
0x0021 = String
"DHKEM(X448, HKDF-SHA512)"
        showKEM_ID t
x = String
"KEM_ID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"0x04" t
x

getHpkeKeyConfig :: ReadBuffer -> IO HpkeKeyConfig
getHpkeKeyConfig :: ReadBuffer -> IO HpkeKeyConfig
getHpkeKeyConfig ReadBuffer
rbuf = do
    Word8
cfid <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    Word16
kid <- ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    EncodedServerPublicKey
pk <- ByteString -> EncodedServerPublicKey
EncodedServerPublicKey (ByteString -> EncodedServerPublicKey)
-> IO ByteString -> IO EncodedServerPublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO ByteString
getOpaque16 ReadBuffer
rbuf
    [HpkeSymmetricCipherSuite]
cs <- ReadBuffer
-> (ReadBuffer -> IO HpkeSymmetricCipherSuite)
-> IO [HpkeSymmetricCipherSuite]
forall a. ReadBuffer -> (ReadBuffer -> IO a) -> IO [a]
getList16 ReadBuffer
rbuf ReadBuffer -> IO HpkeSymmetricCipherSuite
getHpkeSymmetricCipherSuite
    HpkeKeyConfig -> IO HpkeKeyConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HpkeKeyConfig -> IO HpkeKeyConfig)
-> HpkeKeyConfig -> IO HpkeKeyConfig
forall a b. (a -> b) -> a -> b
$ Word8
-> Word16
-> EncodedServerPublicKey
-> [HpkeSymmetricCipherSuite]
-> HpkeKeyConfig
HpkeKeyConfig Word8
cfid Word16
kid EncodedServerPublicKey
pk [HpkeSymmetricCipherSuite]
cs

putHpkeKeyConfig :: WriteBuffer -> HpkeKeyConfig -> IO ()
putHpkeKeyConfig :: WriteBuffer -> HpkeKeyConfig -> IO ()
putHpkeKeyConfig WriteBuffer
wbuf HpkeKeyConfig{[HpkeSymmetricCipherSuite]
Word8
Word16
EncodedServerPublicKey
config_id :: HpkeKeyConfig -> Word8
kem_id :: HpkeKeyConfig -> Word16
public_key :: HpkeKeyConfig -> EncodedServerPublicKey
cipher_suites :: HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
config_id :: Word8
kem_id :: Word16
public_key :: EncodedServerPublicKey
cipher_suites :: [HpkeSymmetricCipherSuite]
..} = do
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
config_id
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
kem_id
    let EncodedServerPublicKey ByteString
pk = EncodedServerPublicKey
public_key
    WriteBuffer -> ByteString -> IO ()
putOpaque16 WriteBuffer
wbuf ByteString
pk
    WriteBuffer
-> (WriteBuffer -> HpkeSymmetricCipherSuite -> IO ())
-> [HpkeSymmetricCipherSuite]
-> IO ()
forall a.
WriteBuffer -> (WriteBuffer -> a -> IO ()) -> [a] -> IO ()
putList16 WriteBuffer
wbuf WriteBuffer -> HpkeSymmetricCipherSuite -> IO ()
putHpkeSymmetricCipherSuite [HpkeSymmetricCipherSuite]
cipher_suites

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

-- | Extension type.
type ECHConfigExtensionType = Word16

-- | Raw extension.
data ECHConfigExtension = ECHConfigExtension
    { ECHConfigExtension -> Word16
ece_type :: ECHConfigExtensionType
    , ECHConfigExtension -> ByteString
ece_data :: ByteString
    }
    deriving (ECHConfigExtension -> ECHConfigExtension -> Bool
(ECHConfigExtension -> ECHConfigExtension -> Bool)
-> (ECHConfigExtension -> ECHConfigExtension -> Bool)
-> Eq ECHConfigExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ECHConfigExtension -> ECHConfigExtension -> Bool
== :: ECHConfigExtension -> ECHConfigExtension -> Bool
$c/= :: ECHConfigExtension -> ECHConfigExtension -> Bool
/= :: ECHConfigExtension -> ECHConfigExtension -> Bool
Eq, Eq ECHConfigExtension
Eq ECHConfigExtension =>
(ECHConfigExtension -> ECHConfigExtension -> Ordering)
-> (ECHConfigExtension -> ECHConfigExtension -> Bool)
-> (ECHConfigExtension -> ECHConfigExtension -> Bool)
-> (ECHConfigExtension -> ECHConfigExtension -> Bool)
-> (ECHConfigExtension -> ECHConfigExtension -> Bool)
-> (ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension)
-> (ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension)
-> Ord ECHConfigExtension
ECHConfigExtension -> ECHConfigExtension -> Bool
ECHConfigExtension -> ECHConfigExtension -> Ordering
ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension
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 :: ECHConfigExtension -> ECHConfigExtension -> Ordering
compare :: ECHConfigExtension -> ECHConfigExtension -> Ordering
$c< :: ECHConfigExtension -> ECHConfigExtension -> Bool
< :: ECHConfigExtension -> ECHConfigExtension -> Bool
$c<= :: ECHConfigExtension -> ECHConfigExtension -> Bool
<= :: ECHConfigExtension -> ECHConfigExtension -> Bool
$c> :: ECHConfigExtension -> ECHConfigExtension -> Bool
> :: ECHConfigExtension -> ECHConfigExtension -> Bool
$c>= :: ECHConfigExtension -> ECHConfigExtension -> Bool
>= :: ECHConfigExtension -> ECHConfigExtension -> Bool
$cmax :: ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension
max :: ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension
$cmin :: ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension
min :: ECHConfigExtension -> ECHConfigExtension -> ECHConfigExtension
Ord, Offset -> ECHConfigExtension -> ShowS
[ECHConfigExtension] -> ShowS
ECHConfigExtension -> String
(Offset -> ECHConfigExtension -> ShowS)
-> (ECHConfigExtension -> String)
-> ([ECHConfigExtension] -> ShowS)
-> Show ECHConfigExtension
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Offset -> ECHConfigExtension -> ShowS
showsPrec :: Offset -> ECHConfigExtension -> ShowS
$cshow :: ECHConfigExtension -> String
show :: ECHConfigExtension -> String
$cshowList :: [ECHConfigExtension] -> ShowS
showList :: [ECHConfigExtension] -> ShowS
Show)

instance SizeOf ECHConfigExtension where
    sizeof :: ECHConfigExtension -> Offset
sizeof ECHConfigExtension{Word16
ByteString
ece_type :: ECHConfigExtension -> Word16
ece_data :: ECHConfigExtension -> ByteString
ece_type :: Word16
ece_data :: ByteString
..} = Offset
4 Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ ByteString -> Offset
BS.length ByteString
ece_data

getECHConfigExtension :: ReadBuffer -> IO ECHConfigExtension
getECHConfigExtension :: ReadBuffer -> IO ECHConfigExtension
getECHConfigExtension ReadBuffer
rbuf = do
    Word16
typ <- ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    ByteString
ext <- ReadBuffer -> IO ByteString
getOpaque16 ReadBuffer
rbuf
    ECHConfigExtension -> IO ECHConfigExtension
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ECHConfigExtension -> IO ECHConfigExtension)
-> ECHConfigExtension -> IO ECHConfigExtension
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> ECHConfigExtension
ECHConfigExtension Word16
typ ByteString
ext

putECHConfigExtension :: WriteBuffer -> ECHConfigExtension -> IO ()
putECHConfigExtension :: WriteBuffer -> ECHConfigExtension -> IO ()
putECHConfigExtension WriteBuffer
wbuf ECHConfigExtension{Word16
ByteString
ece_type :: ECHConfigExtension -> Word16
ece_data :: ECHConfigExtension -> ByteString
ece_type :: Word16
ece_data :: ByteString
..} = do
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
ece_type
    WriteBuffer -> ByteString -> IO ()
putOpaque16 WriteBuffer
wbuf ByteString
ece_data

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

data ECHConfigContents = ECHConfigContents
    { ECHConfigContents -> HpkeKeyConfig
key_config :: HpkeKeyConfig
    , ECHConfigContents -> Word8
maximum_name_length :: Word8
    , ECHConfigContents -> String
public_name :: String
    , ECHConfigContents -> [ECHConfigExtension]
extensions :: [ECHConfigExtension]
    }
    deriving (ECHConfigContents -> ECHConfigContents -> Bool
(ECHConfigContents -> ECHConfigContents -> Bool)
-> (ECHConfigContents -> ECHConfigContents -> Bool)
-> Eq ECHConfigContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ECHConfigContents -> ECHConfigContents -> Bool
== :: ECHConfigContents -> ECHConfigContents -> Bool
$c/= :: ECHConfigContents -> ECHConfigContents -> Bool
/= :: ECHConfigContents -> ECHConfigContents -> Bool
Eq, Eq ECHConfigContents
Eq ECHConfigContents =>
(ECHConfigContents -> ECHConfigContents -> Ordering)
-> (ECHConfigContents -> ECHConfigContents -> Bool)
-> (ECHConfigContents -> ECHConfigContents -> Bool)
-> (ECHConfigContents -> ECHConfigContents -> Bool)
-> (ECHConfigContents -> ECHConfigContents -> Bool)
-> (ECHConfigContents -> ECHConfigContents -> ECHConfigContents)
-> (ECHConfigContents -> ECHConfigContents -> ECHConfigContents)
-> Ord ECHConfigContents
ECHConfigContents -> ECHConfigContents -> Bool
ECHConfigContents -> ECHConfigContents -> Ordering
ECHConfigContents -> ECHConfigContents -> ECHConfigContents
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 :: ECHConfigContents -> ECHConfigContents -> Ordering
compare :: ECHConfigContents -> ECHConfigContents -> Ordering
$c< :: ECHConfigContents -> ECHConfigContents -> Bool
< :: ECHConfigContents -> ECHConfigContents -> Bool
$c<= :: ECHConfigContents -> ECHConfigContents -> Bool
<= :: ECHConfigContents -> ECHConfigContents -> Bool
$c> :: ECHConfigContents -> ECHConfigContents -> Bool
> :: ECHConfigContents -> ECHConfigContents -> Bool
$c>= :: ECHConfigContents -> ECHConfigContents -> Bool
>= :: ECHConfigContents -> ECHConfigContents -> Bool
$cmax :: ECHConfigContents -> ECHConfigContents -> ECHConfigContents
max :: ECHConfigContents -> ECHConfigContents -> ECHConfigContents
$cmin :: ECHConfigContents -> ECHConfigContents -> ECHConfigContents
min :: ECHConfigContents -> ECHConfigContents -> ECHConfigContents
Ord, Offset -> ECHConfigContents -> ShowS
[ECHConfigContents] -> ShowS
ECHConfigContents -> String
(Offset -> ECHConfigContents -> ShowS)
-> (ECHConfigContents -> String)
-> ([ECHConfigContents] -> ShowS)
-> Show ECHConfigContents
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Offset -> ECHConfigContents -> ShowS
showsPrec :: Offset -> ECHConfigContents -> ShowS
$cshow :: ECHConfigContents -> String
show :: ECHConfigContents -> String
$cshowList :: [ECHConfigContents] -> ShowS
showList :: [ECHConfigContents] -> ShowS
Show)

instance SizeOf ECHConfigContents where
    sizeof :: ECHConfigContents -> Offset
sizeof ECHConfigContents{String
[ECHConfigExtension]
Word8
HpkeKeyConfig
key_config :: ECHConfigContents -> HpkeKeyConfig
maximum_name_length :: ECHConfigContents -> Word8
public_name :: ECHConfigContents -> String
extensions :: ECHConfigContents -> [ECHConfigExtension]
key_config :: HpkeKeyConfig
maximum_name_length :: Word8
public_name :: String
extensions :: [ECHConfigExtension]
..} =
        HpkeKeyConfig -> Offset
forall a. SizeOf a => a -> Offset
sizeof HpkeKeyConfig
key_config
            Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
4
            Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ ByteString -> Offset
BS.length (String -> ByteString
C8.pack String
public_name)
            Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ [Offset] -> Offset
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ECHConfigExtension -> Offset) -> [ECHConfigExtension] -> [Offset]
forall a b. (a -> b) -> [a] -> [b]
map ECHConfigExtension -> Offset
forall a. SizeOf a => a -> Offset
sizeof [ECHConfigExtension]
extensions)

getECHConfigContents :: ReadBuffer -> IO ECHConfigContents
getECHConfigContents :: ReadBuffer -> IO ECHConfigContents
getECHConfigContents ReadBuffer
rbuf = do
    HpkeKeyConfig
kcf <- ReadBuffer -> IO HpkeKeyConfig
getHpkeKeyConfig ReadBuffer
rbuf
    Word8
mnl <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    String
pn <- ByteString -> String
C8.unpack (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO ByteString
getOpaque8 ReadBuffer
rbuf
    [ECHConfigExtension]
exts <- ReadBuffer
-> (ReadBuffer -> IO ECHConfigExtension) -> IO [ECHConfigExtension]
forall a. ReadBuffer -> (ReadBuffer -> IO a) -> IO [a]
getList16 ReadBuffer
rbuf ReadBuffer -> IO ECHConfigExtension
getECHConfigExtension
    ECHConfigContents -> IO ECHConfigContents
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ECHConfigContents -> IO ECHConfigContents)
-> ECHConfigContents -> IO ECHConfigContents
forall a b. (a -> b) -> a -> b
$ HpkeKeyConfig
-> Word8 -> String -> [ECHConfigExtension] -> ECHConfigContents
ECHConfigContents HpkeKeyConfig
kcf Word8
mnl String
pn [ECHConfigExtension]
exts

putECHConfigContents :: WriteBuffer -> ECHConfigContents -> IO ()
putECHConfigContents :: WriteBuffer -> ECHConfigContents -> IO ()
putECHConfigContents WriteBuffer
wbuf ECHConfigContents{String
[ECHConfigExtension]
Word8
HpkeKeyConfig
key_config :: ECHConfigContents -> HpkeKeyConfig
maximum_name_length :: ECHConfigContents -> Word8
public_name :: ECHConfigContents -> String
extensions :: ECHConfigContents -> [ECHConfigExtension]
key_config :: HpkeKeyConfig
maximum_name_length :: Word8
public_name :: String
extensions :: [ECHConfigExtension]
..} = do
    WriteBuffer -> HpkeKeyConfig -> IO ()
putHpkeKeyConfig WriteBuffer
wbuf HpkeKeyConfig
key_config
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
maximum_name_length
    WriteBuffer -> ByteString -> IO ()
putOpaque8 WriteBuffer
wbuf (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack String
public_name
    WriteBuffer
-> (WriteBuffer -> ECHConfigExtension -> IO ())
-> [ECHConfigExtension]
-> IO ()
forall a.
WriteBuffer -> (WriteBuffer -> a -> IO ()) -> [a] -> IO ()
putList16 WriteBuffer
wbuf WriteBuffer -> ECHConfigExtension -> IO ()
putECHConfigExtension [ECHConfigExtension]
extensions

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

-- | Type for configuration of encrypted client hello.
data ECHConfig = ECHConfig
    { ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
    }
    deriving (ECHConfig -> ECHConfig -> Bool
(ECHConfig -> ECHConfig -> Bool)
-> (ECHConfig -> ECHConfig -> Bool) -> Eq ECHConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ECHConfig -> ECHConfig -> Bool
== :: ECHConfig -> ECHConfig -> Bool
$c/= :: ECHConfig -> ECHConfig -> Bool
/= :: ECHConfig -> ECHConfig -> Bool
Eq, Eq ECHConfig
Eq ECHConfig =>
(ECHConfig -> ECHConfig -> Ordering)
-> (ECHConfig -> ECHConfig -> Bool)
-> (ECHConfig -> ECHConfig -> Bool)
-> (ECHConfig -> ECHConfig -> Bool)
-> (ECHConfig -> ECHConfig -> Bool)
-> (ECHConfig -> ECHConfig -> ECHConfig)
-> (ECHConfig -> ECHConfig -> ECHConfig)
-> Ord ECHConfig
ECHConfig -> ECHConfig -> Bool
ECHConfig -> ECHConfig -> Ordering
ECHConfig -> ECHConfig -> ECHConfig
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 :: ECHConfig -> ECHConfig -> Ordering
compare :: ECHConfig -> ECHConfig -> Ordering
$c< :: ECHConfig -> ECHConfig -> Bool
< :: ECHConfig -> ECHConfig -> Bool
$c<= :: ECHConfig -> ECHConfig -> Bool
<= :: ECHConfig -> ECHConfig -> Bool
$c> :: ECHConfig -> ECHConfig -> Bool
> :: ECHConfig -> ECHConfig -> Bool
$c>= :: ECHConfig -> ECHConfig -> Bool
>= :: ECHConfig -> ECHConfig -> Bool
$cmax :: ECHConfig -> ECHConfig -> ECHConfig
max :: ECHConfig -> ECHConfig -> ECHConfig
$cmin :: ECHConfig -> ECHConfig -> ECHConfig
min :: ECHConfig -> ECHConfig -> ECHConfig
Ord)

instance SizeOf ECHConfig where
    sizeof :: ECHConfig -> Offset
sizeof ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = Offset
4 Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ ECHConfigContents -> Offset
forall a. SizeOf a => a -> Offset
sizeof ECHConfigContents
contents

instance Show ECHConfig where
    show :: ECHConfig -> String
show ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = ECHConfigContents -> String
forall a. Show a => a -> String
show ECHConfigContents
contents

getECHConfig :: ReadBuffer -> IO ECHConfig
getECHConfig :: ReadBuffer -> IO ECHConfig
getECHConfig ReadBuffer
rbuf = do
    Word16
_ver <- ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    Word16
_len <- ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    ECHConfigContents -> ECHConfig
ECHConfig (ECHConfigContents -> ECHConfig)
-> IO ECHConfigContents -> IO ECHConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO ECHConfigContents
getECHConfigContents ReadBuffer
rbuf

putECHConfig :: WriteBuffer -> ECHConfig -> IO ()
putECHConfig :: WriteBuffer -> ECHConfig -> IO ()
putECHConfig WriteBuffer
wbuf ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = do
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
0xfe0d
    WriteBuffer -> IO () -> IO ()
withLength16 WriteBuffer
wbuf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WriteBuffer -> ECHConfigContents -> IO ()
putECHConfigContents WriteBuffer
wbuf ECHConfigContents
contents

sizeOfECHConfig :: ECHConfig -> Int
sizeOfECHConfig :: ECHConfig -> Offset
sizeOfECHConfig ECHConfig
cnf = ECHConfig -> Offset
forall a. SizeOf a => a -> Offset
sizeof ECHConfig
cnf

-- | Encoder for 'ECHConfig'.
encodeECHConfig :: ECHConfig -> ByteString
encodeECHConfig :: ECHConfig -> ByteString
encodeECHConfig ECHConfig
cnf = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Offset -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Offset
siz ((WriteBuffer -> IO ()) -> IO ByteString)
-> (WriteBuffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> WriteBuffer -> ECHConfig -> IO ()
putECHConfig WriteBuffer
wbuf ECHConfig
cnf
  where
    siz :: Offset
siz = ECHConfig -> Offset
sizeOfECHConfig ECHConfig
cnf

-- | Decoder for 'ECHConfig'.
decodeECHConfig :: ByteString -> Maybe ECHConfig
decodeECHConfig :: ByteString -> Maybe ECHConfig
decodeECHConfig ByteString
bs =
    IO (Maybe ECHConfig) -> Maybe ECHConfig
forall a. IO a -> a
unsafePerformIO (IO (Maybe ECHConfig) -> Maybe ECHConfig)
-> IO (Maybe ECHConfig) -> Maybe ECHConfig
forall a b. (a -> b) -> a -> b
$
        (SomeException -> IO (Maybe ECHConfig))
-> IO (Maybe ECHConfig) -> IO (Maybe ECHConfig)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle SomeException -> IO (Maybe ECHConfig)
forall {m :: * -> *} {a}. Monad m => SomeException -> m (Maybe a)
handler (IO (Maybe ECHConfig) -> IO (Maybe ECHConfig))
-> IO (Maybe ECHConfig) -> IO (Maybe ECHConfig)
forall a b. (a -> b) -> a -> b
$
            ByteString
-> (ReadBuffer -> IO (Maybe ECHConfig)) -> IO (Maybe ECHConfig)
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
bs ((ReadBuffer -> IO (Maybe ECHConfig)) -> IO (Maybe ECHConfig))
-> (ReadBuffer -> IO (Maybe ECHConfig)) -> IO (Maybe ECHConfig)
forall a b. (a -> b) -> a -> b
$
                \ReadBuffer
rbuf -> ECHConfig -> Maybe ECHConfig
forall a. a -> Maybe a
Just (ECHConfig -> Maybe ECHConfig)
-> IO ECHConfig -> IO (Maybe ECHConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO ECHConfig
getECHConfig ReadBuffer
rbuf
  where
    handler :: SomeException -> m (Maybe a)
handler (E.SomeException e
_) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

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

-- | A list of 'ECHConfig'.
type ECHConfigList = [ECHConfig]

getECHConfigList :: ReadBuffer -> IO [ECHConfig]
getECHConfigList :: ReadBuffer -> IO [ECHConfig]
getECHConfigList ReadBuffer
rbuf = ReadBuffer -> (ReadBuffer -> IO ECHConfig) -> IO [ECHConfig]
forall a. ReadBuffer -> (ReadBuffer -> IO a) -> IO [a]
getList16 ReadBuffer
rbuf ReadBuffer -> IO ECHConfig
getECHConfig

putECHConfigList :: WriteBuffer -> [ECHConfig] -> IO ()
putECHConfigList :: WriteBuffer -> [ECHConfig] -> IO ()
putECHConfigList WriteBuffer
wbuf [ECHConfig]
configs =
    WriteBuffer
-> (WriteBuffer -> ECHConfig -> IO ()) -> [ECHConfig] -> IO ()
forall a.
WriteBuffer -> (WriteBuffer -> a -> IO ()) -> [a] -> IO ()
putList16 WriteBuffer
wbuf WriteBuffer -> ECHConfig -> IO ()
putECHConfig [ECHConfig]
configs

sizeOfECHConfigList :: [ECHConfig] -> Int
sizeOfECHConfigList :: [ECHConfig] -> Offset
sizeOfECHConfigList [ECHConfig]
configs = [Offset] -> Offset
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ECHConfig -> Offset) -> [ECHConfig] -> [Offset]
forall a b. (a -> b) -> [a] -> [b]
map ECHConfig -> Offset
sizeOfECHConfig [ECHConfig]
configs) Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
2

-- | Encoder for 'ECHConfigList'.
encodeECHConfigList :: [ECHConfig] -> ByteString
encodeECHConfigList :: [ECHConfig] -> ByteString
encodeECHConfigList [ECHConfig]
configs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Offset -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Offset
siz ((WriteBuffer -> IO ()) -> IO ByteString)
-> (WriteBuffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf ->
    WriteBuffer -> [ECHConfig] -> IO ()
putECHConfigList WriteBuffer
wbuf [ECHConfig]
configs
  where
    siz :: Offset
siz = [ECHConfig] -> Offset
sizeOfECHConfigList [ECHConfig]
configs

-- | Decoder for 'ECHConfigList'.
decodeECHConfigList :: ByteString -> Maybe [ECHConfig]
decodeECHConfigList :: ByteString -> Maybe [ECHConfig]
decodeECHConfigList ByteString
bs =
    IO (Maybe [ECHConfig]) -> Maybe [ECHConfig]
forall a. IO a -> a
unsafePerformIO (IO (Maybe [ECHConfig]) -> Maybe [ECHConfig])
-> IO (Maybe [ECHConfig]) -> Maybe [ECHConfig]
forall a b. (a -> b) -> a -> b
$
        (SomeException -> IO (Maybe [ECHConfig]))
-> IO (Maybe [ECHConfig]) -> IO (Maybe [ECHConfig])
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle SomeException -> IO (Maybe [ECHConfig])
forall {m :: * -> *} {a}. Monad m => SomeException -> m (Maybe a)
handler (IO (Maybe [ECHConfig]) -> IO (Maybe [ECHConfig]))
-> IO (Maybe [ECHConfig]) -> IO (Maybe [ECHConfig])
forall a b. (a -> b) -> a -> b
$
            ByteString
-> (ReadBuffer -> IO (Maybe [ECHConfig])) -> IO (Maybe [ECHConfig])
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
bs ((ReadBuffer -> IO (Maybe [ECHConfig])) -> IO (Maybe [ECHConfig]))
-> (ReadBuffer -> IO (Maybe [ECHConfig])) -> IO (Maybe [ECHConfig])
forall a b. (a -> b) -> a -> b
$
                \ReadBuffer
rbuf -> [ECHConfig] -> Maybe [ECHConfig]
forall a. a -> Maybe a
Just ([ECHConfig] -> Maybe [ECHConfig])
-> IO [ECHConfig] -> IO (Maybe [ECHConfig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO [ECHConfig]
getECHConfigList ReadBuffer
rbuf
  where
    handler :: SomeException -> m (Maybe a)
handler (E.SomeException e
_) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Loading the wire format of 'ECHConfigList' and
--   decode it into 'ECHConfigList'.
loadECHConfigList :: FilePath -> IO [ECHConfig]
loadECHConfigList :: String -> IO [ECHConfig]
loadECHConfigList String
file = do
    ByteString
bs <- String -> IO ByteString
C8.readFile String
file
    ByteString -> (ReadBuffer -> IO [ECHConfig]) -> IO [ECHConfig]
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
bs ((ReadBuffer -> IO [ECHConfig]) -> IO [ECHConfig])
-> (ReadBuffer -> IO [ECHConfig]) -> IO [ECHConfig]
forall a b. (a -> b) -> a -> b
$ ReadBuffer -> IO [ECHConfig]
getECHConfigList

-- | Loading secret keys stored in files whose names
-- are "\<num\>.key".
--
-- > loadECHSecretKeys ["0.key", "1.key"]
loadECHSecretKeys :: [FilePath] -> IO [(ConfigId, ByteString)]
loadECHSecretKeys :: [String] -> IO [(Word8, ByteString)]
loadECHSecretKeys [String]
files = (String -> IO (Word8, ByteString))
-> [String] -> IO [(Word8, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Word8, ByteString)
loadECHSecretKey [String]
files
  where
    loadECHSecretKey :: String -> IO (Word8, ByteString)
loadECHSecretKey String
file = do
        let numstr :: String
numstr = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
file
            key :: Word8
key = String -> Word8
forall a. Read a => String -> a
read String
numstr :: ConfigId
        ByteString
val <- String -> IO ByteString
C8.readFile String
file
        (Word8, ByteString) -> IO (Word8, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
key, ByteString
val)

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

getOpaque8 :: ReadBuffer -> IO ByteString
getOpaque8 :: ReadBuffer -> IO ByteString
getOpaque8 ReadBuffer
rbuf = do
    Offset
len <- Word8 -> Offset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Offset) -> IO Word8 -> IO Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    ReadBuffer -> Offset -> IO ByteString
forall a. Readable a => a -> Offset -> IO ByteString
extractByteString ReadBuffer
rbuf Offset
len

putOpaque8 :: WriteBuffer -> ByteString -> IO ()
putOpaque8 :: WriteBuffer -> ByteString -> IO ()
putOpaque8 WriteBuffer
wbuf ByteString
x = do
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Offset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Offset -> Word8) -> Offset -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Offset
BS.length ByteString
x
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
x

getOpaque16 :: ReadBuffer -> IO ByteString
getOpaque16 :: ReadBuffer -> IO ByteString
getOpaque16 ReadBuffer
rbuf = do
    Offset
len <- Word16 -> Offset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Offset) -> IO Word16 -> IO Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    ReadBuffer -> Offset -> IO ByteString
forall a. Readable a => a -> Offset -> IO ByteString
extractByteString ReadBuffer
rbuf Offset
len

putOpaque16 :: WriteBuffer -> ByteString -> IO ()
putOpaque16 :: WriteBuffer -> ByteString -> IO ()
putOpaque16 WriteBuffer
wbuf ByteString
x = do
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ Offset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Offset -> Word16) -> Offset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Offset
BS.length ByteString
x
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
x

getList16 :: ReadBuffer -> (ReadBuffer -> IO a) -> IO [a]
getList16 :: forall a. ReadBuffer -> (ReadBuffer -> IO a) -> IO [a]
getList16 ReadBuffer
rbuf ReadBuffer -> IO a
parer = do
    Offset
len <- Word16 -> Offset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Offset) -> IO Word16 -> IO Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word16
forall a. Readable a => a -> IO Word16
read16 ReadBuffer
rbuf
    Offset
cur <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
position ReadBuffer
rbuf
    let lim :: Offset
lim = Offset
cur Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
len
    Offset -> ([a] -> [a]) -> IO [a]
forall {b}. Offset -> ([a] -> b) -> IO b
loop Offset
lim [a] -> [a]
forall a. a -> a
id
  where
    loop :: Offset -> ([a] -> b) -> IO b
loop Offset
lim [a] -> b
build = do
        Offset
cur <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
position ReadBuffer
rbuf
        if Offset
cur Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Offset
lim
            then do
                a
x <- ReadBuffer -> IO a
parer ReadBuffer
rbuf
                Offset -> ([a] -> b) -> IO b
loop Offset
lim ([a] -> b
build ([a] -> b) -> ([a] -> [a]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
            else b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ [a] -> b
build []

withLength16 :: WriteBuffer -> IO () -> IO ()
withLength16 :: WriteBuffer -> IO () -> IO ()
withLength16 WriteBuffer
wbuf IO ()
builder = do
    Offset
lenpos <- WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
position WriteBuffer
wbuf
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf Word16
0
    Offset
old <- WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
position WriteBuffer
wbuf
    IO ()
builder
    Offset
new <- WriteBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
position WriteBuffer
wbuf
    let len :: Offset
len = Offset
new Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
old
    WriteBuffer -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff WriteBuffer
wbuf (Offset
lenpos Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
new)
    WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ Offset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Offset
len
    WriteBuffer -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff WriteBuffer
wbuf Offset
len

putList16 :: WriteBuffer -> (WriteBuffer -> a -> IO ()) -> [a] -> IO ()
putList16 :: forall a.
WriteBuffer -> (WriteBuffer -> a -> IO ()) -> [a] -> IO ()
putList16 WriteBuffer
wbuf WriteBuffer -> a -> IO ()
builder [a]
xxs =
    WriteBuffer -> IO () -> IO ()
withLength16 WriteBuffer
wbuf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [a] -> IO ()
loop [a]
xxs
  where
    loop :: [a] -> IO ()
loop [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop (a
x : [a]
xs) = do
        WriteBuffer -> a -> IO ()
builder WriteBuffer
wbuf a
x
        [a] -> IO ()
loop [a]
xs