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

module Network.TLS.Handshake.Client.ClientHello (
    sendClientHello,
    getPreSharedKeyInfo,
) where

import qualified Control.Exception as E
import Crypto.HPKE
import qualified Data.ByteString as B
import Network.TLS.ECH.Config
import System.Random

import Network.TLS.Cipher
import Network.TLS.Context.Internal
import Network.TLS.Crypto
import Network.TLS.Extension
import Network.TLS.Handshake.Client.Common
import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Common13
import Network.TLS.Handshake.Control
import Network.TLS.Handshake.Random
import Network.TLS.Handshake.State
import Network.TLS.Handshake.State13
import Network.TLS.Handshake.TranscriptHash
import Network.TLS.IO
import Network.TLS.Imports
import Network.TLS.Packet hiding (getExtensions)
import Network.TLS.Parameters
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.Types

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

sendClientHello
    :: ClientParams
    -> Context
    -> [Group]
    -> Maybe (ClientRandom, Session, Version)
    -> PreSharedKeyInfo
    -> IO ClientRandom
sendClientHello :: ClientParams
-> Context
-> [Group]
-> Maybe (ClientRandom, Session, Version)
-> PreSharedKeyInfo
-> IO ClientRandom
sendClientHello ClientParams
cparams Context
ctx [Group]
groups Maybe (ClientRandom, Session, Version)
mparams PreSharedKeyInfo
pskinfo = do
    ClientRandom
crand <- Maybe (ClientRandom, Session, Version) -> IO ClientRandom
forall {c}. Maybe (ClientRandom, Session, c) -> IO ClientRandom
generateClientHelloParams Maybe (ClientRandom, Session, Version)
mparams -- Inner for ECH
    ClientParams
-> Context -> [Group] -> ClientRandom -> PreSharedKeyInfo -> IO ()
sendClientHello' ClientParams
cparams Context
ctx [Group]
groups ClientRandom
crand PreSharedKeyInfo
pskinfo
    ClientRandom -> IO ClientRandom
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientRandom
crand
  where
    highestVer :: Version
highestVer = [Version] -> Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    tls13 :: Bool
tls13 = Version
highestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13
    ems :: EMSMode
ems = Supported -> EMSMode
supportedExtendedMainSecret (Supported -> EMSMode) -> Supported -> EMSMode
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx

    -- Client random and session in the second client hello for
    -- retry must be the same as the first one.
    generateClientHelloParams :: Maybe (ClientRandom, Session, c) -> IO ClientRandom
generateClientHelloParams (Just (ClientRandom
crand, Session
clientSession, c
_)) = do
        Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State Context
ctx ((TLS13State -> TLS13State) -> IO ())
-> (TLS13State -> TLS13State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TLS13State
st -> TLS13State
st{tls13stSession = clientSession}
        ClientRandom -> IO ClientRandom
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientRandom
crand
    generateClientHelloParams Maybe (ClientRandom, Session, c)
Nothing = do
        ClientRandom
crand <- Context -> IO ClientRandom
clientRandom Context
ctx
        let paramSession :: Session
paramSession = case ClientParams -> [(ByteString, SessionData)]
clientSessions ClientParams
cparams of
                [] -> Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
                (ByteString
sidOrTkt, SessionData
sdata) : [(ByteString, SessionData)]
_
                    | SessionData -> Version
sessionVersion SessionData
sdata Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13 -> Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
                    | EMSMode
ems EMSMode -> EMSMode -> Bool
forall a. Eq a => a -> a -> Bool
== EMSMode
RequireEMS Bool -> Bool -> Bool
&& Bool
noSessionEMS -> Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
                    | ByteString -> Bool
isTicket ByteString
sidOrTkt -> Maybe ByteString -> Session
Session (Maybe ByteString -> Session) -> Maybe ByteString -> Session
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toSessionID ByteString
sidOrTkt
                    | Bool
otherwise -> Maybe ByteString -> Session
Session (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
sidOrTkt)
                  where
                    noSessionEMS :: Bool
noSessionEMS = SessionFlag
SessionEMS SessionFlag -> [SessionFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` SessionData -> [SessionFlag]
sessionFlags SessionData
sdata
        -- In compatibility mode a client not offering a pre-TLS 1.3
        -- session MUST generate a new 32-byte value
        if Bool
tls13 Bool -> Bool -> Bool
&& Session
paramSession Session -> Session -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Bool -> Bool
not (Context -> Bool
ctxQUICMode Context
ctx)
            then do
                Session
randomSession <- Context -> IO Session
newSession Context
ctx
                Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State Context
ctx ((TLS13State -> TLS13State) -> IO ())
-> (TLS13State -> TLS13State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TLS13State
st -> TLS13State
st{tls13stSession = randomSession}
                ClientRandom -> IO ClientRandom
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientRandom
crand
            else do
                Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State Context
ctx ((TLS13State -> TLS13State) -> IO ())
-> (TLS13State -> TLS13State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TLS13State
st -> TLS13State
st{tls13stSession = paramSession}
                ClientRandom -> IO ClientRandom
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientRandom
crand

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

sendClientHello'
    :: ClientParams
    -> Context
    -> [Group]
    -> ClientRandom
    -> ( Maybe ([ByteString], SessionData, CipherChoice, Word32)
       , Maybe CipherChoice
       , Bool
       )
    -> IO ()
sendClientHello' :: ClientParams
-> Context -> [Group] -> ClientRandom -> PreSharedKeyInfo -> IO ()
sendClientHello' ClientParams
cparams Context
ctx [Group]
groups ClientRandom
crand (Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo, Maybe CipherChoice
rtt0info, Bool
rtt0) = do
    let ver :: Version
ver = if Bool
tls13 then Version
TLS12 else Version
highestVer
    Session
clientSession <- TLS13State -> Session
tls13stSession (TLS13State -> Session) -> IO TLS13State -> IO Session
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> IO TLS13State
getTLS13State Context
ctx
    Bool
hrr <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS13HRR
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hrr (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Version -> ClientRandom -> IO ()
startHandshake Context
ctx Version
ver ClientRandom
crand
    Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> TLSSt ()
setVersionIfUnset Version
highestVer
    let cipherIds :: [CipherId]
cipherIds = (Cipher -> CipherId) -> [Cipher] -> [CipherId]
forall a b. (a -> b) -> [a] -> [b]
map (Word16 -> CipherId
CipherId (Word16 -> CipherId) -> (Cipher -> Word16) -> Cipher -> CipherId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cipher -> Word16
cipherID) [Cipher]
ciphers
        mkClientHello :: [ExtensionRaw] -> ClientHello
mkClientHello [ExtensionRaw]
exts =
            CH
                { chVersion :: Version
chVersion = Version
ver
                , chRandom :: ClientRandom
chRandom = ClientRandom
crand
                , chSession :: Session
chSession = Session
clientSession
                , chCiphers :: [CipherId]
chCiphers = [CipherId]
cipherIds
                , chComps :: [CompressionID]
chComps = [CompressionID
0]
                , chExtensions :: [ExtensionRaw]
chExtensions = [ExtensionRaw]
exts
                }
    Context -> Maybe Int -> IO ()
setMyRecordLimit Context
ctx (Maybe Int -> IO ()) -> Maybe Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Limit -> Maybe Int
limitRecordSize (Limit -> Maybe Int) -> Limit -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Shared -> Limit
sharedLimit (Shared -> Limit) -> Shared -> Limit
forall a b. (a -> b) -> a -> b
$ Context -> Shared
ctxShared Context
ctx
    [ExtensionRaw]
extensions0 <- [Maybe ExtensionRaw] -> [ExtensionRaw]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ExtensionRaw] -> [ExtensionRaw])
-> IO [Maybe ExtensionRaw] -> IO [ExtensionRaw]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Maybe ExtensionRaw]
getExtensions
    let extensions1 :: [ExtensionRaw]
extensions1 = Shared -> [ExtensionRaw]
sharedHelloExtensions (ClientParams -> Shared
clientShared ClientParams
cparams) [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
forall a. [a] -> [a] -> [a]
++ [ExtensionRaw]
extensions0
    [ExtensionRaw]
extensions <- [ExtensionRaw] -> ClientHello -> IO [ExtensionRaw]
forall {m :: * -> *}.
MonadIO m =>
[ExtensionRaw] -> ClientHello -> m [ExtensionRaw]
adjustPreSharedKeyExt [ExtensionRaw]
extensions1 (ClientHello -> IO [ExtensionRaw])
-> ClientHello -> IO [ExtensionRaw]
forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> ClientHello
mkClientHello [ExtensionRaw]
extensions1
    let ch0 :: ClientHello
ch0 = [ExtensionRaw] -> ClientHello
mkClientHello [ExtensionRaw]
extensions
    Context -> String -> ByteString -> IO ()
updateTranscriptHashI Context
ctx String
"ClientHelloI" (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Handshake -> ByteString
encodeHandshake (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
ch0
    let nhpks :: [(KEM_ID, KDF_ID, AEAD_ID)]
nhpks = Supported -> [(KEM_ID, KDF_ID, AEAD_ID)]
supportedHPKE (Supported -> [(KEM_ID, KDF_ID, AEAD_ID)])
-> Supported -> [(KEM_ID, KDF_ID, AEAD_ID)]
forall a b. (a -> b) -> a -> b
$ ClientParams -> Supported
clientSupported ClientParams
cparams
        echcnfs :: ECHConfigList
echcnfs = Shared -> ECHConfigList
sharedECHConfigList (Shared -> ECHConfigList) -> Shared -> ECHConfigList
forall a b. (a -> b) -> a -> b
$ ClientParams -> Shared
clientShared ClientParams
cparams
        mEchParams :: Maybe (KDF_ID, AEAD_ID, ECHConfig)
mEchParams = [(KEM_ID, KDF_ID, AEAD_ID)]
-> ECHConfigList -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList [(KEM_ID, KDF_ID, AEAD_ID)]
nhpks ECHConfigList
echcnfs
    ClientHello
ch <-
        if ClientParams -> Bool
clientUseECH ClientParams
cparams
            then case Maybe (KDF_ID, AEAD_ID, ECHConfig)
mEchParams of
                Maybe (KDF_ID, AEAD_ID, ECHConfig)
Nothing -> do
                    if Bool
hrr
                        then do
                            ClientHello
chI <- Maybe ClientHello -> ClientHello
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ClientHello -> ClientHello)
-> IO (Maybe ClientHello) -> IO ClientHello
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> HandshakeM (Maybe ClientHello) -> IO (Maybe ClientHello)
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM (Maybe ClientHello)
getClientHello
                            let ch0' :: ClientHello
ch0' = ClientHello
ch0{chExtensions = take 1 (chExtensions chI) ++ drop 1 (chExtensions ch0)}
                            Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientHello -> HandshakeM ()
setClientHello ClientHello
ch0'
                            ClientHello -> IO ClientHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientHello
ch0'
                        else do
                            ExtensionRaw
gEchExt <- IO ExtensionRaw
greasingEchExt
                            let ch0' :: ClientHello
ch0' = ClientHello
ch0{chExtensions = gEchExt : drop 1 (chExtensions ch0)}
                            Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientHello -> HandshakeM ()
setClientHello ClientHello
ch0'
                            ClientHello -> IO ClientHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientHello
ch0'
                Just (KDF_ID, AEAD_ID, ECHConfig)
echParams -> do
                    Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientHello -> HandshakeM ()
setClientHello ClientHello
ch0
                    Maybe ClientRandom
mcrandO <- Context
-> HandshakeM (Maybe ClientRandom) -> IO (Maybe ClientRandom)
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM (Maybe ClientRandom)
getOuterClientRandom
                    ClientRandom
crandO <- case Maybe ClientRandom
mcrandO of
                        Maybe ClientRandom
Nothing -> Context -> IO ClientRandom
clientRandom Context
ctx
                        Just ClientRandom
x -> ClientRandom -> IO ClientRandom
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientRandom
x
                    Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        ClientRandom -> HandshakeM ()
setClientRandom ClientRandom
crandO
                        Maybe ClientRandom -> HandshakeM ()
setOuterClientRandom (Maybe ClientRandom -> HandshakeM ())
-> Maybe ClientRandom -> HandshakeM ()
forall a b. (a -> b) -> a -> b
$ ClientRandom -> Maybe ClientRandom
forall a. a -> Maybe a
Just ClientRandom
crandO
                    Maybe ExtensionRaw
mpskExt <- IO (Maybe ExtensionRaw)
randomPreSharedKeyExt
                    Context
-> ClientHello
-> (KDF_ID, AEAD_ID, ECHConfig)
-> ClientRandom
-> Maybe ExtensionRaw
-> IO ClientHello
createEncryptedClientHello Context
ctx ClientHello
ch0 (KDF_ID, AEAD_ID, ECHConfig)
echParams ClientRandom
crandO Maybe ExtensionRaw
mpskExt
            else do
                Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientHello -> HandshakeM ()
setClientHello ClientHello
ch0
                ClientHello -> IO ClientHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientHello
ch0
    Context -> Packet -> IO ()
sendPacket12 Context
ctx (Packet -> IO ()) -> Packet -> IO ()
forall a b. (a -> b) -> a -> b
$ [Handshake] -> Packet
Handshake [ClientHello -> Handshake
ClientHello ClientHello
ch]
    Maybe EarlySecretInfo
mEarlySecInfo <- case Maybe CipherChoice
rtt0info of
        Maybe CipherChoice
Nothing -> Maybe EarlySecretInfo -> IO (Maybe EarlySecretInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EarlySecretInfo
forall a. Maybe a
Nothing
        Just CipherChoice
info -> EarlySecretInfo -> Maybe EarlySecretInfo
forall a. a -> Maybe a
Just (EarlySecretInfo -> Maybe EarlySecretInfo)
-> IO EarlySecretInfo -> IO (Maybe EarlySecretInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CipherChoice -> IO EarlySecretInfo
getEarlySecretInfo CipherChoice
info
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hrr (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> ClientState -> IO ()
contextSync Context
ctx (ClientState -> IO ()) -> ClientState -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe EarlySecretInfo -> ClientState
SendClientHello Maybe EarlySecretInfo
mEarlySecInfo
    let sentExtensions :: [ExtensionID]
sentExtensions = (ExtensionRaw -> ExtensionID) -> [ExtensionRaw] -> [ExtensionID]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExtensionRaw ExtensionID
i ByteString
_) -> ExtensionID
i) [ExtensionRaw]
extensions
    Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State Context
ctx ((TLS13State -> TLS13State) -> IO ())
-> (TLS13State -> TLS13State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TLS13State
st -> TLS13State
st{tls13stSentExtensions = sentExtensions}
  where
    ciphers :: [Cipher]
ciphers = Supported -> [Cipher]
supportedCiphers (Supported -> [Cipher]) -> Supported -> [Cipher]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    highestVer :: Version
highestVer = [Version] -> Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    tls13 :: Bool
tls13 = Version
highestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13
    ems :: EMSMode
ems = Supported -> EMSMode
supportedExtendedMainSecret (Supported -> EMSMode) -> Supported -> EMSMode
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    groupToSend :: Maybe Group
groupToSend = [Group] -> Maybe Group
forall a. [a] -> Maybe a
listToMaybe [Group]
groups

    -- List of extensions to send in ClientHello, ordered such that we never
    -- terminate with a zero-length extension.  Some buggy implementations
    -- are allergic to an extension with empty data at final position.
    --
    -- Without TLS 1.3, the list ends with extension "signature_algorithms"
    -- with length >= 2 bytes.  When TLS 1.3 is enabled, extensions
    -- "psk_key_exchange_modes" (currently always sent) and "pre_shared_key"
    -- (not always present) have length > 0.
    getExtensions :: IO [Maybe ExtensionRaw]
getExtensions =
        [IO (Maybe ExtensionRaw)] -> IO [Maybe ExtensionRaw]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
            [ {- 0xfe0d -} IO (Maybe ExtensionRaw)
echExt
            , {- 0x00 -} IO (Maybe ExtensionRaw)
sniExt
            , {- 0x0a -} IO (Maybe ExtensionRaw)
groupExt
            , {- 0x0b -} IO (Maybe ExtensionRaw)
ecPointExt
            , {- 0x0d -} IO (Maybe ExtensionRaw)
signatureAlgExt
            , {- 0x10 -} IO (Maybe ExtensionRaw)
alpnExt
            , {- 0x17 -} IO (Maybe ExtensionRaw)
emsExt
            , {- 0x1b -} IO (Maybe ExtensionRaw)
compCertExt
            , {- 0x1c -} IO (Maybe ExtensionRaw)
recordSizeLimitExt
            , {- 0x23 -} IO (Maybe ExtensionRaw)
sessionTicketExt
            , {- 0x2a -} IO (Maybe ExtensionRaw)
earlyDataExt
            , {- 0x2b -} IO (Maybe ExtensionRaw)
versionExt
            , {- 0x2c -} IO (Maybe ExtensionRaw)
cookieExt
            , {- 0x2d -} IO (Maybe ExtensionRaw)
pskExchangeModeExt
            , {- 0x31 -} IO (Maybe ExtensionRaw)
postHandshakeAuthExt
            , {- 0x33 -} IO (Maybe ExtensionRaw)
keyShareExt
            , {- 0xff01 -} IO (Maybe ExtensionRaw)
secureRenegExt
            , {- 0x29 -} IO (Maybe ExtensionRaw)
preSharedKeyExt -- MUST be last (RFC 8446)
            ]

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

    sniExt :: IO (Maybe ExtensionRaw)
sniExt =
        if ClientParams -> Bool
clientUseServerNameIndication ClientParams
cparams
            then do
                let sni :: String
sni = (String, ByteString) -> String
forall a b. (a, b) -> a
fst ((String, ByteString) -> String) -> (String, ByteString) -> String
forall a b. (a -> b) -> a -> b
$ ClientParams -> (String, ByteString)
clientServerIdentification ClientParams
cparams
                Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> TLSSt ()
setClientSNI String
sni
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ServerName -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (ServerName -> ExtensionRaw) -> ServerName -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ServerNameType] -> ServerName
ServerName [String -> ServerNameType
ServerNameHostName String
sni]
            else Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    groupExt :: IO (Maybe ExtensionRaw)
groupExt =
        Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$
            ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                SupportedGroups -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SupportedGroups -> ExtensionRaw)
-> SupportedGroups -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                    [Group] -> SupportedGroups
SupportedGroups (Supported -> [Group]
supportedGroups (Supported -> [Group]) -> Supported -> [Group]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx)

    ecPointExt :: IO (Maybe ExtensionRaw)
ecPointExt =
        Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$
            ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                EcPointFormatsSupported -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (EcPointFormatsSupported -> ExtensionRaw)
-> EcPointFormatsSupported -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                    [EcPointFormat] -> EcPointFormatsSupported
EcPointFormatsSupported [EcPointFormat
EcPointFormat_Uncompressed]

    signatureAlgExt :: IO (Maybe ExtensionRaw)
signatureAlgExt =
        Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$
            ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                SignatureAlgorithms -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SignatureAlgorithms -> ExtensionRaw)
-> SignatureAlgorithms -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$
                    [HashAndSignatureAlgorithm] -> SignatureAlgorithms
SignatureAlgorithms ([HashAndSignatureAlgorithm] -> SignatureAlgorithms)
-> [HashAndSignatureAlgorithm] -> SignatureAlgorithms
forall a b. (a -> b) -> a -> b
$
                        Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
-> Supported -> [HashAndSignatureAlgorithm]
forall a b. (a -> b) -> a -> b
$
                            ClientParams -> Supported
clientSupported ClientParams
cparams

    alpnExt :: IO (Maybe ExtensionRaw)
alpnExt = do
        Maybe [ByteString]
mprotos <- ClientHooks -> IO (Maybe [ByteString])
onSuggestALPN (ClientHooks -> IO (Maybe [ByteString]))
-> ClientHooks -> IO (Maybe [ByteString])
forall a b. (a -> b) -> a -> b
$ ClientParams -> ClientHooks
clientHooks ClientParams
cparams
        case Maybe [ByteString]
mprotos of
            Maybe [ByteString]
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just [ByteString]
protos -> do
                Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> TLSSt ()
setClientALPNSuggest [ByteString]
protos
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ApplicationLayerProtocolNegotiation -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (ApplicationLayerProtocolNegotiation -> ExtensionRaw)
-> ApplicationLayerProtocolNegotiation -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ApplicationLayerProtocolNegotiation
ApplicationLayerProtocolNegotiation [ByteString]
protos

    emsExt :: IO (Maybe ExtensionRaw)
emsExt =
        Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$
            if EMSMode
ems EMSMode -> EMSMode -> Bool
forall a. Eq a => a -> a -> Bool
== EMSMode
NoEMS Bool -> Bool -> Bool
|| (Version -> Bool) -> [Version] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13) (Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx)
                then Maybe ExtensionRaw
forall a. Maybe a
Nothing
                else ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ExtendedMainSecret -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw ExtendedMainSecret
ExtendedMainSecret

    compCertExt :: IO (Maybe ExtensionRaw)
compCertExt = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ CompressCertificate -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw ([CertificateCompressionAlgorithm] -> CompressCertificate
CompressCertificate [CertificateCompressionAlgorithm
CCA_Zlib])

    recordSizeLimitExt :: IO (Maybe ExtensionRaw)
recordSizeLimitExt = case Limit -> Maybe Int
limitRecordSize (Limit -> Maybe Int) -> Limit -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Shared -> Limit
sharedLimit (Shared -> Limit) -> Shared -> Limit
forall a b. (a -> b) -> a -> b
$ Context -> Shared
ctxShared Context
ctx of
        Maybe Int
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
        Just Int
siz -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ RecordSizeLimit -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (RecordSizeLimit -> ExtensionRaw)
-> RecordSizeLimit -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ Word16 -> RecordSizeLimit
RecordSizeLimit (Word16 -> RecordSizeLimit) -> Word16 -> RecordSizeLimit
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz

    sessionTicketExt :: IO (Maybe ExtensionRaw)
sessionTicketExt = do
        case ClientParams -> [(ByteString, SessionData)]
clientSessions ClientParams
cparams of
            (ByteString
sidOrTkt, SessionData
_) : [(ByteString, SessionData)]
_
                | ByteString -> Bool
isTicket ByteString
sidOrTkt -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SessionTicket -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SessionTicket -> ExtensionRaw) -> SessionTicket -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ByteString -> SessionTicket
SessionTicket ByteString
sidOrTkt
            [(ByteString, SessionData)]
_ -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SessionTicket -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SessionTicket -> ExtensionRaw) -> SessionTicket -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ByteString -> SessionTicket
SessionTicket ByteString
""

    earlyDataExt :: IO (Maybe ExtensionRaw)
earlyDataExt
        | Bool
rtt0 = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ EarlyDataIndication -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (Maybe Word32 -> EarlyDataIndication
EarlyDataIndication Maybe Word32
forall a. Maybe a
Nothing)
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    versionExt :: IO (Maybe ExtensionRaw)
versionExt
        | ClientParams -> Bool
clientUseECH ClientParams
cparams = do
            let vers :: [Version]
vers = Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
            if Version
TLS13 Version -> [Version] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
vers
                then
                    Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SupportedVersions -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SupportedVersions -> ExtensionRaw)
-> SupportedVersions -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [Version] -> SupportedVersions
SupportedVersionsClientHello [Version
TLS13]
                else
                    TLSError -> IO (Maybe ExtensionRaw)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (Maybe ExtensionRaw))
-> TLSError -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ String -> TLSError
Error_Misc String
"TLS 1.3 must be specified for Encrypted Client Hello"
        | Bool
tls13 = do
            let vers :: [Version]
vers = (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
filter (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS12) ([Version] -> [Version]) -> [Version] -> [Version]
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
            Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SupportedVersions -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SupportedVersions -> ExtensionRaw)
-> SupportedVersions -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [Version] -> SupportedVersions
SupportedVersionsClientHello [Version]
vers
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    cookieExt :: IO (Maybe ExtensionRaw)
cookieExt = do
        Maybe Cookie
mcookie <- Context -> TLSSt (Maybe Cookie) -> IO (Maybe Cookie)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe Cookie)
getTLS13Cookie
        case Maybe Cookie
mcookie of
            Maybe Cookie
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just Cookie
cookie -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ Cookie -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw Cookie
cookie

    pskExchangeModeExt :: IO (Maybe ExtensionRaw)
pskExchangeModeExt
        | Bool
tls13 = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ PskKeyExchangeModes -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (PskKeyExchangeModes -> ExtensionRaw)
-> PskKeyExchangeModes -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [PskKexMode] -> PskKeyExchangeModes
PskKeyExchangeModes [PskKexMode
PSK_DHE_KE]
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    postHandshakeAuthExt :: IO (Maybe ExtensionRaw)
postHandshakeAuthExt
        | Context -> Bool
ctxQUICMode Context
ctx = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
        | Bool
tls13 = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ PostHandshakeAuth -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw PostHandshakeAuth
PostHandshakeAuth
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    -- FIXME
    keyShareExt :: IO (Maybe ExtensionRaw)
keyShareExt
        | Bool
tls13 = case Maybe Group
groupToSend of
            Maybe Group
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just Group
grp -> do
                (GroupPrivate
cpri, KeyShareEntry
ent) <- Context -> Group -> IO (GroupPrivate, KeyShareEntry)
makeClientKeyShare Context
ctx Group
grp
                Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ GroupPrivate -> HandshakeM ()
setGroupPrivate GroupPrivate
cpri
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ KeyShare -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (KeyShare -> ExtensionRaw) -> KeyShare -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [KeyShareEntry] -> KeyShare
KeyShareClientHello [KeyShareEntry
ent]
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    secureRenegExt :: IO (Maybe ExtensionRaw)
secureRenegExt =
        if Supported -> Bool
supportedSecureRenegotiation (Supported -> Bool) -> Supported -> Bool
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
            then do
                VerifyData ByteString
cvd <- Context -> TLSSt VerifyData -> IO VerifyData
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt VerifyData -> IO VerifyData)
-> TLSSt VerifyData -> IO VerifyData
forall a b. (a -> b) -> a -> b
$ Role -> TLSSt VerifyData
getVerifyData Role
ClientRole
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SecureRenegotiation -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SecureRenegotiation -> ExtensionRaw)
-> SecureRenegotiation -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
cvd ByteString
""
            else Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    -- ECHClientHelloInner should be replaced if ECHConfigList is not available.
    echExt :: IO (Maybe ExtensionRaw)
echExt
        | ClientParams -> Bool
clientUseECH ClientParams
cparams = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ EncryptedClientHello -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw EncryptedClientHello
ECHClientHelloInner
        | Bool
otherwise = Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    preSharedKeyExt :: IO (Maybe ExtensionRaw)
preSharedKeyExt =
        case Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo of
            Maybe ([ByteString], SessionData, CipherChoice, Word32)
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just ([ByteString]
identities, SessionData
_, CipherChoice
choice, Word32
obfAge) -> do
                let zero :: ByteString
zero = CipherChoice -> ByteString
cZero CipherChoice
choice
                    pskIdentities :: [PskIdentity]
pskIdentities = (ByteString -> PskIdentity) -> [ByteString] -> [PskIdentity]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
x -> ByteString -> Word32 -> PskIdentity
PskIdentity ByteString
x Word32
obfAge) [ByteString]
identities
                    -- [zero] is a place holds.
                    -- adjustPreSharedKeyExt will replace them.
                    binders :: [ByteString]
binders = Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate ([PskIdentity] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PskIdentity]
pskIdentities) ByteString
zero
                    offeredPsks :: PreSharedKey
offeredPsks = [PskIdentity] -> [ByteString] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity]
pskIdentities [ByteString]
binders
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ PreSharedKey -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw PreSharedKey
offeredPsks

    randomPreSharedKeyExt :: IO (Maybe ExtensionRaw)
    randomPreSharedKeyExt :: IO (Maybe ExtensionRaw)
randomPreSharedKeyExt =
        case Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo of
            Maybe ([ByteString], SessionData, CipherChoice, Word32)
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just ([ByteString]
identities, SessionData
_, CipherChoice
choice, Word32
_) -> do
                let zero :: ByteString
zero = CipherChoice -> ByteString
cZero CipherChoice
choice
                ByteString
zeroR <- (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (ByteString, StdGen)) -> IO ByteString)
-> (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
uniformByteString (Int -> StdGen -> (ByteString, StdGen))
-> Int -> StdGen -> (ByteString, StdGen)
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
zero
                Word32
obfAgeR <- (StdGen -> (Word32, StdGen)) -> IO Word32
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (Word32, StdGen)) -> IO Word32)
-> (StdGen -> (Word32, StdGen)) -> IO Word32
forall a b. (a -> b) -> a -> b
$ StdGen -> (Word32, StdGen)
forall g. RandomGen g => g -> (Word32, g)
genWord32
                let genPskId :: ByteString -> m PskIdentity
genPskId ByteString
x = do
                        ByteString
xR <- (StdGen -> (ByteString, StdGen)) -> m ByteString
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (ByteString, StdGen)) -> m ByteString)
-> (StdGen -> (ByteString, StdGen)) -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
uniformByteString (Int -> StdGen -> (ByteString, StdGen))
-> Int -> StdGen -> (ByteString, StdGen)
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
x
                        PskIdentity -> m PskIdentity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PskIdentity -> m PskIdentity) -> PskIdentity -> m PskIdentity
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32 -> PskIdentity
PskIdentity ByteString
xR Word32
obfAgeR
                [PskIdentity]
pskIdentitiesR <- (ByteString -> IO PskIdentity) -> [ByteString] -> IO [PskIdentity]
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 ByteString -> IO PskIdentity
forall {m :: * -> *}. MonadIO m => ByteString -> m PskIdentity
genPskId [ByteString]
identities
                let bindersR :: [ByteString]
bindersR = Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate ([PskIdentity] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PskIdentity]
pskIdentitiesR) ByteString
zeroR
                    offeredPsksR :: PreSharedKey
offeredPsksR = [PskIdentity] -> [ByteString] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity]
pskIdentitiesR [ByteString]
bindersR
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ PreSharedKey -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw PreSharedKey
offeredPsksR

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

    adjustPreSharedKeyExt :: [ExtensionRaw] -> ClientHello -> m [ExtensionRaw]
adjustPreSharedKeyExt [ExtensionRaw]
exts ClientHello
ch =
        case Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo of
            Maybe ([ByteString], SessionData, CipherChoice, Word32)
Nothing -> [ExtensionRaw] -> m [ExtensionRaw]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ExtensionRaw]
exts
            Just ([ByteString]
identities, SessionData
sdata, CipherChoice
choice, Word32
_) -> do
                let psk :: ByteString
psk = SessionData -> ByteString
sessionSecret SessionData
sdata
                    earlySecret :: BaseSecret EarlySecret
earlySecret = CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
initEarlySecret CipherChoice
choice (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
psk)
                Context -> HandshakeM () -> m ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
forall a b. (a -> b) -> a -> b
$ BaseSecret EarlySecret -> HandshakeM ()
setTLS13EarlySecret BaseSecret EarlySecret
earlySecret
                let ech :: ByteString
ech = Handshake -> ByteString
encodeHandshake (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
ch
                    h :: Hash
h = CipherChoice -> Hash
cHash CipherChoice
choice
                    siz :: Int
siz = (Hash -> Int
hashDigestSize Hash
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
identities Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                    binder :: ByteString
binder = BaseSecret EarlySecret -> Hash -> Int -> ByteString -> ByteString
makePSKBinder BaseSecret EarlySecret
earlySecret Hash
h Int
siz ByteString
ech
                -- PSK is shared by the previous TLS session.
                -- So, PSK is unique for identities.
                let binders :: [ByteString]
binders = Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
identities) ByteString
binder
                let exts' :: [ExtensionRaw]
exts' = [ExtensionRaw] -> [ExtensionRaw]
forall a. HasCallStack => [a] -> [a]
init [ExtensionRaw]
exts [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
forall a. [a] -> [a] -> [a]
++ [ExtensionRaw -> ExtensionRaw
adjust ([ExtensionRaw] -> ExtensionRaw
forall a. HasCallStack => [a] -> a
last [ExtensionRaw]
exts)]
                    adjust :: ExtensionRaw -> ExtensionRaw
adjust (ExtensionRaw ExtensionID
eid ByteString
withoutBinders) = ExtensionID -> ByteString -> ExtensionRaw
ExtensionRaw ExtensionID
eid ByteString
withBinders
                      where
                        withBinders :: ByteString
withBinders = ByteString -> [ByteString] -> ByteString
replacePSKBinder ByteString
withoutBinders [ByteString]
binders
                [ExtensionRaw] -> m [ExtensionRaw]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ExtensionRaw]
exts'

    getEarlySecretInfo :: CipherChoice -> IO EarlySecretInfo
getEarlySecretInfo CipherChoice
choice = do
        let usedCipher :: Cipher
usedCipher = CipherChoice -> Cipher
cCipher CipherChoice
choice
            usedHash :: Hash
usedHash = CipherChoice -> Hash
cHash CipherChoice
choice
        Just BaseSecret EarlySecret
earlySecret <- Context
-> HandshakeM (Maybe (BaseSecret EarlySecret))
-> IO (Maybe (BaseSecret EarlySecret))
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM (Maybe (BaseSecret EarlySecret))
getTLS13EarlySecret
        SecretPair EarlySecret
earlyKey <- Context
-> CipherChoice
-> Either ByteString (BaseSecret EarlySecret)
-> IO (SecretPair EarlySecret)
calculateEarlySecret Context
ctx CipherChoice
choice (BaseSecret EarlySecret
-> Either ByteString (BaseSecret EarlySecret)
forall a b. b -> Either a b
Right BaseSecret EarlySecret
earlySecret)
        let clientEarlySecret :: ClientTrafficSecret EarlySecret
clientEarlySecret = SecretPair EarlySecret -> ClientTrafficSecret EarlySecret
forall a. SecretPair a -> ClientTrafficSecret a
pairClient SecretPair EarlySecret
earlyKey
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Context -> Bool
ctxQUICMode Context
ctx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Context -> (forall {b}. Monoid b => PacketFlightM b ()) -> IO ()
forall a.
Context -> (forall b. Monoid b => PacketFlightM b a) -> IO a
runPacketFlight Context
ctx ((forall {b}. Monoid b => PacketFlightM b ()) -> IO ())
-> (forall {b}. Monoid b => PacketFlightM b ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> PacketFlightM b ()
forall b. Monoid b => Context -> PacketFlightM b ()
sendChangeCipherSpec13 Context
ctx
            Context
-> Hash -> Cipher -> ClientTrafficSecret EarlySecret -> IO ()
forall ty.
TrafficSecret ty =>
Context -> Hash -> Cipher -> ty -> IO ()
setTxRecordState Context
ctx Hash
usedHash Cipher
usedCipher ClientTrafficSecret EarlySecret
clientEarlySecret
            Context -> Established -> IO ()
setEstablished Context
ctx Established
EarlyDataSending
        -- We set RTT0Sent even in quicMode
        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ RTT0Status -> HandshakeM ()
setTLS13RTT0Status RTT0Status
RTT0Sent
        EarlySecretInfo -> IO EarlySecretInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EarlySecretInfo -> IO EarlySecretInfo)
-> EarlySecretInfo -> IO EarlySecretInfo
forall a b. (a -> b) -> a -> b
$ Cipher -> ClientTrafficSecret EarlySecret -> EarlySecretInfo
EarlySecretInfo Cipher
usedCipher ClientTrafficSecret EarlySecret
clientEarlySecret

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

type PreSharedKeyInfo =
    ( Maybe ([SessionIDorTicket], SessionData, CipherChoice, Second)
    , Maybe CipherChoice
    , Bool
    )

getPreSharedKeyInfo
    :: ClientParams
    -> Context
    -> IO PreSharedKeyInfo
getPreSharedKeyInfo :: ClientParams -> Context -> IO PreSharedKeyInfo
getPreSharedKeyInfo ClientParams
cparams Context
ctx = do
    Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo <- IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
getPskInfo
    let rtt0info :: Maybe CipherChoice
rtt0info = Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo Maybe ([ByteString], SessionData, CipherChoice, Word32)
-> (([ByteString], SessionData, CipherChoice, Word32)
    -> Maybe CipherChoice)
-> Maybe CipherChoice
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([ByteString], SessionData, CipherChoice, Word32)
-> Maybe CipherChoice
forall {a} {a} {d}. (a, SessionData, a, d) -> Maybe a
get0RTTinfo
        rtt0 :: Bool
rtt0 = Maybe CipherChoice -> Bool
forall a. Maybe a -> Bool
isJust Maybe CipherChoice
rtt0info
    PreSharedKeyInfo -> IO PreSharedKeyInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([ByteString], SessionData, CipherChoice, Word32)
pskInfo, Maybe CipherChoice
rtt0info, Bool
rtt0)
  where
    ciphers :: [Cipher]
ciphers = Supported -> [Cipher]
supportedCiphers (Supported -> [Cipher]) -> Supported -> [Cipher]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    highestVer :: Version
highestVer = [Version] -> Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
    tls13 :: Bool
tls13 = Version
highestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13

    sessions :: Maybe ([ByteString], SessionData, Cipher)
sessions = case ClientParams -> [(ByteString, SessionData)]
clientSessions ClientParams
cparams of
        [] -> Maybe ([ByteString], SessionData, Cipher)
forall a. Maybe a
Nothing
        (ByteString
sid, SessionData
sdata) : [(ByteString, SessionData)]
xs -> do
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
tls13
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SessionData -> Version
sessionVersion SessionData
sdata Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13)
            let cid :: Word16
cid = SessionData -> Word16
sessionCipher SessionData
sdata
                sids :: [ByteString]
sids = ((ByteString, SessionData) -> ByteString)
-> [(ByteString, SessionData)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, SessionData) -> ByteString
forall a b. (a, b) -> a
fst [(ByteString, SessionData)]
xs
            Cipher
sCipher <- Word16 -> [Cipher] -> Maybe Cipher
findCipher Word16
cid [Cipher]
ciphers
            ([ByteString], SessionData, Cipher)
-> Maybe ([ByteString], SessionData, Cipher)
forall a. a -> Maybe a
Just (ByteString
sid ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
sids, SessionData
sdata, Cipher
sCipher)

    getPskInfo :: IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
getPskInfo = case Maybe ([ByteString], SessionData, Cipher)
sessions of
        Maybe ([ByteString], SessionData, Cipher)
Nothing -> Maybe ([ByteString], SessionData, CipherChoice, Word32)
-> IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([ByteString], SessionData, CipherChoice, Word32)
forall a. Maybe a
Nothing
        Just ([ByteString]
identity, SessionData
sdata, Cipher
sCipher) -> do
            let tinfo :: TLS13TicketInfo
tinfo = Maybe TLS13TicketInfo -> TLS13TicketInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TLS13TicketInfo -> TLS13TicketInfo)
-> Maybe TLS13TicketInfo -> TLS13TicketInfo
forall a b. (a -> b) -> a -> b
$ SessionData -> Maybe TLS13TicketInfo
sessionTicketInfo SessionData
sdata
            Word32
age <- TLS13TicketInfo -> IO Word32
getAge TLS13TicketInfo
tinfo
            Maybe ([ByteString], SessionData, CipherChoice, Word32)
-> IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([ByteString], SessionData, CipherChoice, Word32)
 -> IO (Maybe ([ByteString], SessionData, CipherChoice, Word32)))
-> Maybe ([ByteString], SessionData, CipherChoice, Word32)
-> IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
forall a b. (a -> b) -> a -> b
$
                if Word32 -> TLS13TicketInfo -> Bool
isAgeValid Word32
age TLS13TicketInfo
tinfo
                    then
                        ([ByteString], SessionData, CipherChoice, Word32)
-> Maybe ([ByteString], SessionData, CipherChoice, Word32)
forall a. a -> Maybe a
Just
                            ( [ByteString]
identity
                            , SessionData
sdata
                            , Version -> Cipher -> CipherChoice
makeCipherChoice Version
TLS13 Cipher
sCipher
                            , Word32 -> TLS13TicketInfo -> Word32
ageToObfuscatedAge Word32
age TLS13TicketInfo
tinfo
                            )
                    else Maybe ([ByteString], SessionData, CipherChoice, Word32)
forall a. Maybe a
Nothing

    get0RTTinfo :: (a, SessionData, a, d) -> Maybe a
get0RTTinfo (a
_, SessionData
sdata, a
choice, d
_)
        | ClientParams -> Bool
clientUseEarlyData ClientParams
cparams Bool -> Bool -> Bool
&& SessionData -> Int
sessionMaxEarlyDataSize SessionData
sdata Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
choice
        | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

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

createEncryptedClientHello
    :: Context
    -> ClientHello
    -> (KDF_ID, AEAD_ID, ECHConfig)
    -> ClientRandom
    -> Maybe ExtensionRaw
    -> IO ClientHello
createEncryptedClientHello :: Context
-> ClientHello
-> (KDF_ID, AEAD_ID, ECHConfig)
-> ClientRandom
-> Maybe ExtensionRaw
-> IO ClientHello
createEncryptedClientHello Context
ctx ch0 :: ClientHello
ch0@CH{[CompressionID]
[CipherId]
[ExtensionRaw]
Version
Session
ClientRandom
chVersion :: ClientHello -> Version
chRandom :: ClientHello -> ClientRandom
chSession :: ClientHello -> Session
chCiphers :: ClientHello -> [CipherId]
chComps :: ClientHello -> [CompressionID]
chExtensions :: ClientHello -> [ExtensionRaw]
chVersion :: Version
chRandom :: ClientRandom
chSession :: Session
chCiphers :: [CipherId]
chComps :: [CompressionID]
chExtensions :: [ExtensionRaw]
..} echParams :: (KDF_ID, AEAD_ID, ECHConfig)
echParams@(KDF_ID
kdfid, AEAD_ID
aeadid, ECHConfig
conf) ClientRandom
crO Maybe ExtensionRaw
mpskExt = (HPKEError -> IO ClientHello) -> IO ClientHello -> IO ClientHello
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle HPKEError -> IO ClientHello
hpkeHandler (IO ClientHello -> IO ClientHello)
-> IO ClientHello -> IO ClientHello
forall a b. (a -> b) -> a -> b
$ do
    let ([ExtensionRaw]
chExtsO, [ExtensionRaw]
chExtsI) = String
-> Maybe ExtensionRaw
-> [ExtensionRaw]
-> ([ExtensionRaw], [ExtensionRaw])
dupCompExts (ECHConfig -> String
cnfPublicName ECHConfig
conf) Maybe ExtensionRaw
mpskExt [ExtensionRaw]
chExtensions
        chI :: ClientHello
chI =
            ClientHello
ch0
                { chSession = Session Nothing
                , chExtensions = chExtsI
                }
    Just (ByteString -> ByteString -> IO ByteString
func, EncodedPublicKey
enc, Int
taglen) <- Context
-> (KDF_ID, AEAD_ID, ECHConfig)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
getHPKE Context
ctx (KDF_ID, AEAD_ID, ECHConfig)
echParams
    let bsI :: ByteString
bsI = Handshake -> ByteString
encodeHandshake' (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
chI
        padLen :: Int
padLen = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
B.length ByteString
bsI Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
31)
        bsI' :: ByteString
bsI' = ByteString
bsI ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> CompressionID -> ByteString
B.replicate Int
padLen CompressionID
0
    let outerZ :: EncryptedClientHello
outerZ =
            ECHClientHelloOuter
                { echCipherSuite :: (KDF_ID, AEAD_ID)
echCipherSuite = (KDF_ID
kdfid, AEAD_ID
aeadid)
                , echConfigId :: CompressionID
echConfigId = ECHConfig -> CompressionID
cnfConfigId ECHConfig
conf
                , echEnc :: EncodedPublicKey
echEnc = EncodedPublicKey
enc
                , echPayload :: ByteString
echPayload = Int -> CompressionID -> ByteString
B.replicate (ByteString -> Int
B.length ByteString
bsI' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
taglen) CompressionID
0
                }
        echOZ :: ByteString
echOZ = EncryptedClientHello -> ByteString
forall a. Extension a => a -> ByteString
extensionEncode EncryptedClientHello
outerZ
        chExtsOTail :: [ExtensionRaw]
chExtsOTail = Int -> [ExtensionRaw] -> [ExtensionRaw]
forall a. Int -> [a] -> [a]
drop Int
1 [ExtensionRaw]
chExtsO
        chOZ :: ClientHello
chOZ =
            ClientHello
ch0
                { chRandom = crO
                , chExtensions =
                    ExtensionRaw EID_EncryptedClientHello echOZ : chExtsOTail
                }
        aad :: ByteString
aad = Handshake -> ByteString
encodeHandshake' (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
chOZ
    ByteString
bsO <- ByteString -> ByteString -> IO ByteString
func ByteString
aad ByteString
bsI'
    let outer :: EncryptedClientHello
outer =
            ECHClientHelloOuter
                { echCipherSuite :: (KDF_ID, AEAD_ID)
echCipherSuite = (KDF_ID
kdfid, AEAD_ID
aeadid)
                , echConfigId :: CompressionID
echConfigId = ECHConfig -> CompressionID
cnfConfigId ECHConfig
conf
                , echEnc :: EncodedPublicKey
echEnc = EncodedPublicKey
enc
                , echPayload :: ByteString
echPayload = ByteString
bsO
                }
        echO :: ByteString
echO = EncryptedClientHello -> ByteString
forall a. Extension a => a -> ByteString
extensionEncode EncryptedClientHello
outer
        chO :: ClientHello
chO =
            ClientHello
chOZ
                { chExtensions =
                    ExtensionRaw EID_EncryptedClientHello echO : chExtsOTail
                }
    ClientHello -> IO ClientHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientHello
chO
  where
    hpkeHandler :: HPKEError -> IO ClientHello
    hpkeHandler :: HPKEError -> IO ClientHello
hpkeHandler HPKEError
_ = ClientHello -> IO ClientHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientHello
ch0

dupCompExts
    :: HostName
    -> Maybe ExtensionRaw
    -> [ExtensionRaw]
    -> ([ExtensionRaw], [ExtensionRaw]) -- Outer, inner
dupCompExts :: String
-> Maybe ExtensionRaw
-> [ExtensionRaw]
-> ([ExtensionRaw], [ExtensionRaw])
dupCompExts String
host Maybe ExtensionRaw
mpskExt [ExtensionRaw]
chExts = [ExtensionRaw] -> ([ExtensionRaw], [ExtensionRaw])
step1 [ExtensionRaw]
chExts
  where
    step1 :: [ExtensionRaw] -> ([ExtensionRaw], [ExtensionRaw])
step1 (echExtI :: ExtensionRaw
echExtI@(ExtensionRaw ExtensionID
EID_EncryptedClientHello ByteString
_) : [ExtensionRaw]
exts) =
        (ExtensionRaw
echExtO ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
os, ExtensionRaw
echExtI ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
is)
      where
        echExtO :: ExtensionRaw
echExtO = ExtensionID -> ByteString -> ExtensionRaw
ExtensionRaw ExtensionID
EID_EncryptedClientHello ByteString
""
        ([ExtensionRaw]
os, [ExtensionRaw]
is) = [ExtensionRaw] -> ([ExtensionRaw], [ExtensionRaw])
step2 [ExtensionRaw]
exts
    step1 [ExtensionRaw]
_ = String -> ([ExtensionRaw], [ExtensionRaw])
forall a. HasCallStack => String -> a
error String
"step1"
    step2 :: [ExtensionRaw] -> ([ExtensionRaw], [ExtensionRaw])
step2 (sniExtI :: ExtensionRaw
sniExtI@(ExtensionRaw ExtensionID
EID_ServerName ByteString
_) : [ExtensionRaw]
exts) =
        (ExtensionRaw
sniExtO ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
os, ExtensionRaw
sniExtI ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
is)
      where
        sniExtO :: ExtensionRaw
sniExtO = ServerName -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (ServerName -> ExtensionRaw) -> ServerName -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ServerNameType] -> ServerName
ServerName [String -> ServerNameType
ServerNameHostName String
host]
        ([ExtensionRaw]
os, [ExtensionRaw]
is) = [ExtensionRaw]
-> ([ExtensionID] -> [ExtensionID])
-> ([ExtensionRaw], [ExtensionRaw])
step3 [ExtensionRaw]
exts [ExtensionID] -> [ExtensionID]
forall a. a -> a
id
    step2 [ExtensionRaw]
_ = String -> ([ExtensionRaw], [ExtensionRaw])
forall a. HasCallStack => String -> a
error String
"step2"
    step3 :: [ExtensionRaw]
-> ([ExtensionID] -> [ExtensionID])
-> ([ExtensionRaw], [ExtensionRaw])
step3 [] [ExtensionID] -> [ExtensionID]
build = ([], [ExtensionRaw
echOuterExt])
      where
        echOuterExt :: ExtensionRaw
echOuterExt = EchOuterExtensions -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (EchOuterExtensions -> ExtensionRaw)
-> EchOuterExtensions -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ExtensionID] -> EchOuterExtensions
EchOuterExtensions ([ExtensionID] -> EchOuterExtensions)
-> [ExtensionID] -> EchOuterExtensions
forall a b. (a -> b) -> a -> b
$ [ExtensionID] -> [ExtensionID]
build []
    step3 [pskExtI :: ExtensionRaw
pskExtI@(ExtensionRaw ExtensionID
EID_PreSharedKey ByteString
_)] [ExtensionID] -> [ExtensionID]
build =
        ([ExtensionRaw
pskExtO], [ExtensionRaw
echOuterExt, ExtensionRaw
pskExtI])
      where
        echOuterExt :: ExtensionRaw
echOuterExt = EchOuterExtensions -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (EchOuterExtensions -> ExtensionRaw)
-> EchOuterExtensions -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ExtensionID] -> EchOuterExtensions
EchOuterExtensions ([ExtensionID] -> EchOuterExtensions)
-> [ExtensionID] -> EchOuterExtensions
forall a b. (a -> b) -> a -> b
$ [ExtensionID] -> [ExtensionID]
build []
        pskExtO :: ExtensionRaw
pskExtO = Maybe ExtensionRaw -> ExtensionRaw
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ExtensionRaw
mpskExt
    step3 (i :: ExtensionRaw
i@(ExtensionRaw ExtensionID
eid ByteString
_) : [ExtensionRaw]
is) [ExtensionID] -> [ExtensionID]
build = (ExtensionRaw
i ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
os', [ExtensionRaw]
is')
      where
        ([ExtensionRaw]
os', [ExtensionRaw]
is') = [ExtensionRaw]
-> ([ExtensionID] -> [ExtensionID])
-> ([ExtensionRaw], [ExtensionRaw])
step3 [ExtensionRaw]
is ([ExtensionID] -> [ExtensionID]
build ([ExtensionID] -> [ExtensionID])
-> ([ExtensionID] -> [ExtensionID])
-> [ExtensionID]
-> [ExtensionID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtensionID
eid ExtensionID -> [ExtensionID] -> [ExtensionID]
forall a. a -> [a] -> [a]
:))

getHPKE
    :: Context
    -> (KDF_ID, AEAD_ID, ECHConfig)
    -> IO (Maybe (AAD -> PlainText -> IO CipherText, EncodedPublicKey, Int))
getHPKE :: Context
-> (KDF_ID, AEAD_ID, ECHConfig)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
getHPKE Context
ctx (KDF_ID
kdfid, AEAD_ID
aeadid, ECHConfig
conf) = do
    Maybe (ByteString -> ByteString -> IO ByteString, Int)
mfunc <- Context
-> IO (Maybe (ByteString -> ByteString -> IO ByteString, Int))
getTLS13HPKE Context
ctx
    case Maybe (ByteString -> ByteString -> IO ByteString, Int)
mfunc of
        Maybe (ByteString -> ByteString -> IO ByteString, Int)
Nothing -> do
            let encodedConfig :: ByteString
encodedConfig = ECHConfig -> ByteString
encodeECHConfig ECHConfig
conf
                info :: ByteString
info = ByteString
"tls ech\x00" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
encodedConfig
            (EncodedPublicKey
pkSm, ContextS
ctxS) <- KEM_ID
-> KDF_ID
-> AEAD_ID
-> Maybe EncodedSecretKey
-> Maybe EncodedSecretKey
-> EncodedPublicKey
-> ByteString
-> IO (EncodedPublicKey, ContextS)
setupBaseS KEM_ID
kemid KDF_ID
kdfid AEAD_ID
aeadid Maybe EncodedSecretKey
forall a. Maybe a
Nothing Maybe EncodedSecretKey
forall a. Maybe a
Nothing EncodedPublicKey
mpkR ByteString
info
            let func :: ByteString -> ByteString -> IO ByteString
func = ContextS -> ByteString -> ByteString -> IO ByteString
seal ContextS
ctxS
            Context
-> (ByteString -> ByteString -> IO ByteString) -> Int -> IO ()
setTLS13HPKE Context
ctx ByteString -> ByteString -> IO ByteString
func Int
0
            Maybe
  (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
 -> IO
      (Maybe
         (ByteString -> ByteString -> IO ByteString, EncodedPublicKey,
          Int)))
-> Maybe
     (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> Maybe
     (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
forall a. a -> Maybe a
Just (ByteString -> ByteString -> IO ByteString
func, EncodedPublicKey
pkSm, Int
nT)
        Just (ByteString -> ByteString -> IO ByteString
func, Int
_) -> Maybe
  (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
 -> IO
      (Maybe
         (ByteString -> ByteString -> IO ByteString, EncodedPublicKey,
          Int)))
-> Maybe
     (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> IO
     (Maybe
        (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
-> Maybe
     (ByteString -> ByteString -> IO ByteString, EncodedPublicKey, Int)
forall a. a -> Maybe a
Just (ByteString -> ByteString -> IO ByteString
func, ByteString -> EncodedPublicKey
EncodedPublicKey ByteString
"", Int
nT)
  where
    mpkR :: EncodedPublicKey
mpkR = ECHConfig -> EncodedPublicKey
cnfEncodedPublicKey ECHConfig
conf
    kemid :: KEM_ID
kemid = ECHConfig -> KEM_ID
cnfKemId ECHConfig
conf
    nT :: Int
nT = AEAD_ID -> Int
nTag AEAD_ID
aeadid

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

lookupECHConfigList
    :: [(KEM_ID, KDF_ID, AEAD_ID)]
    -> ECHConfigList
    -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList :: [(KEM_ID, KDF_ID, AEAD_ID)]
-> ECHConfigList -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList [] ECHConfigList
_ = Maybe (KDF_ID, AEAD_ID, ECHConfig)
forall a. Maybe a
Nothing
lookupECHConfigList ((KEM_ID
kemid, KDF_ID
kdfid, AEAD_ID
aeadid) : [(KEM_ID, KDF_ID, AEAD_ID)]
xs) ECHConfigList
cnfs =
    case (ECHConfig -> Bool) -> ECHConfigList -> Maybe ECHConfig
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ECHConfig
cnf -> ECHConfig -> KEM_ID
cnfKemId ECHConfig
cnf KEM_ID -> KEM_ID -> Bool
forall a. Eq a => a -> a -> Bool
== KEM_ID
kemid) ECHConfigList
cnfs of
        Maybe ECHConfig
Nothing -> [(KEM_ID, KDF_ID, AEAD_ID)]
-> ECHConfigList -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList [(KEM_ID, KDF_ID, AEAD_ID)]
xs ECHConfigList
cnfs
        Just ECHConfig
cnf
            | (KDF_ID
kdfid, AEAD_ID
aeadid) (KDF_ID, AEAD_ID) -> [(KDF_ID, AEAD_ID)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ECHConfig -> [(KDF_ID, AEAD_ID)]
cnfCipherSuite ECHConfig
cnf ->
                (KDF_ID, AEAD_ID, ECHConfig) -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
forall a. a -> Maybe a
Just (KDF_ID
kdfid, AEAD_ID
aeadid, ECHConfig
cnf)
            | Bool
otherwise -> [(KEM_ID, KDF_ID, AEAD_ID)]
-> ECHConfigList -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList [(KEM_ID, KDF_ID, AEAD_ID)]
xs ECHConfigList
cnfs

cnfKemId :: ECHConfig -> KEM_ID
cnfKemId :: ECHConfig -> KEM_ID
cnfKemId ECHConfig{ECHConfigContents
contents :: ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
..} = Word16 -> KEM_ID
KEM_ID (Word16 -> KEM_ID) -> Word16 -> KEM_ID
forall a b. (a -> b) -> a -> b
$ HpkeKeyConfig -> Word16
kem_id (HpkeKeyConfig -> Word16) -> HpkeKeyConfig -> Word16
forall a b. (a -> b) -> a -> b
$ ECHConfigContents -> HpkeKeyConfig
key_config (ECHConfigContents -> HpkeKeyConfig)
-> ECHConfigContents -> HpkeKeyConfig
forall a b. (a -> b) -> a -> b
$ ECHConfigContents
contents

cnfCipherSuite :: ECHConfig -> [(KDF_ID, AEAD_ID)]
cnfCipherSuite :: ECHConfig -> [(KDF_ID, AEAD_ID)]
cnfCipherSuite ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = (HpkeSymmetricCipherSuite -> (KDF_ID, AEAD_ID))
-> [HpkeSymmetricCipherSuite] -> [(KDF_ID, AEAD_ID)]
forall a b. (a -> b) -> [a] -> [b]
map HpkeSymmetricCipherSuite -> (KDF_ID, AEAD_ID)
conv ([HpkeSymmetricCipherSuite] -> [(KDF_ID, AEAD_ID)])
-> [HpkeSymmetricCipherSuite] -> [(KDF_ID, AEAD_ID)]
forall a b. (a -> b) -> a -> b
$ HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
cipher_suites (HpkeKeyConfig -> [HpkeSymmetricCipherSuite])
-> HpkeKeyConfig -> [HpkeSymmetricCipherSuite]
forall a b. (a -> b) -> a -> b
$ ECHConfigContents -> HpkeKeyConfig
key_config (ECHConfigContents -> HpkeKeyConfig)
-> ECHConfigContents -> HpkeKeyConfig
forall a b. (a -> b) -> a -> b
$ ECHConfigContents
contents
  where
    conv :: HpkeSymmetricCipherSuite -> (KDF_ID, AEAD_ID)
conv HpkeSymmetricCipherSuite{Word16
kdf_id :: Word16
aead_id :: Word16
kdf_id :: HpkeSymmetricCipherSuite -> Word16
aead_id :: HpkeSymmetricCipherSuite -> Word16
..} = (Word16 -> KDF_ID
KDF_ID Word16
kdf_id, Word16 -> AEAD_ID
AEAD_ID Word16
aead_id)

cnfEncodedPublicKey :: ECHConfig -> EncodedPublicKey
cnfEncodedPublicKey :: ECHConfig -> EncodedPublicKey
cnfEncodedPublicKey ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = ByteString -> EncodedPublicKey
EncodedPublicKey ByteString
pk
  where
    EncodedServerPublicKey ByteString
pk = HpkeKeyConfig -> EncodedServerPublicKey
public_key (HpkeKeyConfig -> EncodedServerPublicKey)
-> HpkeKeyConfig -> EncodedServerPublicKey
forall a b. (a -> b) -> a -> b
$ ECHConfigContents -> HpkeKeyConfig
key_config ECHConfigContents
contents

cnfPublicName :: ECHConfig -> HostName
cnfPublicName :: ECHConfig -> String
cnfPublicName ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = ECHConfigContents -> String
public_name ECHConfigContents
contents

cnfConfigId :: ECHConfig -> ConfigId
cnfConfigId :: ECHConfig -> CompressionID
cnfConfigId ECHConfig{ECHConfigContents
contents :: ECHConfig -> ECHConfigContents
contents :: ECHConfigContents
..} = HpkeKeyConfig -> CompressionID
config_id (HpkeKeyConfig -> CompressionID) -> HpkeKeyConfig -> CompressionID
forall a b. (a -> b) -> a -> b
$ ECHConfigContents -> HpkeKeyConfig
key_config ECHConfigContents
contents

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

-- Pretending X25519 is used because it is the de-facto and
-- its public key is easily created.
greasingEchExt :: IO ExtensionRaw
greasingEchExt :: IO ExtensionRaw
greasingEchExt = do
    CompressionID
cid <- (StdGen -> (CompressionID, StdGen)) -> IO CompressionID
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (CompressionID, StdGen)
forall g. RandomGen g => g -> (CompressionID, g)
genWord8
    ByteString
enc <- (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (ByteString, StdGen)) -> IO ByteString)
-> (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
uniformByteString Int
32
    Int
n <- (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (Int, StdGen)) -> IO Int)
-> (StdGen -> (Int, StdGen)) -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> StdGen -> (Int, StdGen)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
4, Int
6)
    ByteString
payload <- (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (ByteString, StdGen)) -> IO ByteString)
-> (StdGen -> (ByteString, StdGen)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
uniformByteString (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16)
    let outer :: EncryptedClientHello
outer =
            ECHClientHelloOuter
                { echCipherSuite :: (KDF_ID, AEAD_ID)
echCipherSuite = (KDF_ID
HKDF_SHA256, AEAD_ID
AES_128_GCM)
                , echConfigId :: CompressionID
echConfigId = CompressionID
cid
                , echEnc :: EncodedPublicKey
echEnc = ByteString -> EncodedPublicKey
EncodedPublicKey ByteString
enc
                , echPayload :: ByteString
echPayload = ByteString
payload
                }
    ExtensionRaw -> IO ExtensionRaw
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionRaw -> IO ExtensionRaw)
-> ExtensionRaw -> IO ExtensionRaw
forall a b. (a -> b) -> a -> b
$ EncryptedClientHello -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw EncryptedClientHello
outer