{-# LANGUAGE CPP #-}
{-# 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

#if !MIN_VERSION_random(1,3,0)
import Data.ByteString.Internal (unsafeCreate)
import Foreign.Ptr
import Foreign.Storable
#endif

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
    crand <- Maybe (ClientRandom, Session, Version) -> IO ClientRandom
forall {c}. Maybe (ClientRandom, Session, c) -> IO ClientRandom
generateClientHelloParams Maybe (ClientRandom, Session, Version)
mparams -- Inner for ECH
    sendClientHello' cparams ctx groups crand pskinfo
    return 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
        crand <- Context -> IO ClientRandom
clientRandom Context
ctx
        let 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 tls13 && paramSession == Session Nothing && not (ctxQUICMode ctx)
            then do
                randomSession <- newSession ctx
                modifyTLS13State ctx $ \TLS13State
st -> TLS13State
st{tls13stSession = randomSession}
                return crand
            else do
                modifyTLS13State ctx $ \TLS13State
st -> TLS13State
st{tls13stSession = paramSession}
                return 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
    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
    hrr <- usingState_ ctx getTLS13HRR
    unless hrr $ startHandshake ctx ver crand
    usingState_ ctx $ setVersionIfUnset highestVer
    let 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]
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
                }
    setMyRecordLimit ctx $ limitRecordSize $ sharedLimit $ ctxShared ctx
    extensions0 <- catMaybes <$> getExtensions
    let extensions1 = Shared -> [ExtensionRaw]
sharedHelloExtensions (ClientParams -> Shared
clientShared ClientParams
cparams) [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
forall a. [a] -> [a] -> [a]
++ [ExtensionRaw]
extensions0
    extensions <- adjustPreSharedKeyExt extensions1 $ mkClientHello extensions1
    let ch0 = [ExtensionRaw] -> ClientHello
mkClientHello [ExtensionRaw]
extensions
    updateTranscriptHashI ctx "ClientHelloI" $ encodeHandshake $ ClientHello ch0
    let 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 = Shared -> ECHConfigList
sharedECHConfigList (Shared -> ECHConfigList) -> Shared -> ECHConfigList
forall a b. (a -> b) -> a -> b
$ ClientParams -> Shared
clientShared ClientParams
cparams
        mEchParams = [(KEM_ID, KDF_ID, AEAD_ID)]
-> ECHConfigList -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
lookupECHConfigList [(KEM_ID, KDF_ID, AEAD_ID)]
nhpks ECHConfigList
echcnfs
    ch <-
        if clientUseECH cparams
            then case mEchParams of
                Maybe (KDF_ID, AEAD_ID, ECHConfig)
Nothing -> do
                    if Bool
hrr
                        then do
                            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{chExtensions = take 1 (chExtensions chI) ++ drop 1 (chExtensions ch0)}
                            usingHState ctx $ setClientHello ch0'
                            return ch0'
                        else do
                            gEchExt <- IO ExtensionRaw
greasingEchExt
                            let ch0' = ClientHello
ch0{chExtensions = gEchExt : drop 1 (chExtensions ch0)}
                            usingHState ctx $ setClientHello ch0'
                            return 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
                    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
                    crandO <- case 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
                    usingHState ctx $ do
                        setClientRandom crandO
                        setOuterClientRandom $ Just crandO
                    mpskExt <- randomPreSharedKeyExt
                    createEncryptedClientHello ctx ch0 echParams crandO mpskExt
            else do
                usingHState ctx $ setClientHello ch0
                return ch0
    sendPacket12 ctx $ Handshake [ClientHello ch]
    mEarlySecInfo <- case 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
    unless hrr $ contextSync ctx $ SendClientHello mEarlySecInfo
    let sentExtensions = (ExtensionRaw -> ExtensionID) -> [ExtensionRaw] -> [ExtensionID]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExtensionRaw ExtensionID
i ByteString
_) -> ExtensionID
i) [ExtensionRaw]
extensions
    modifyTLS13State ctx $ \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
        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 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
        mcookie <- Context -> TLSSt (Maybe Cookie) -> IO (Maybe Cookie)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe Cookie)
getTLS13Cookie
        case 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
                (cpri, ent) <- Context -> Group -> IO (GroupPrivate, KeyShareEntry)
makeClientKeyShare Context
ctx Group
grp
                usingHState ctx $ setGroupPrivate cpri
                return $ Just $ toExtensionRaw $ KeyShareClientHello [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 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
                return $ Just $ toExtensionRaw $ SecureRenegotiation cvd ""
            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
                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
                obfAgeR <- getStdRandom genWord32
                let genPskId ByteString
x = do
                        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
                        return $ PskIdentity xR obfAgeR
                pskIdentitiesR <- mapM genPskId identities
                let 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 = [PskIdentity] -> [ByteString] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity]
pskIdentitiesR [ByteString]
bindersR
                return $ Just $ toExtensionRaw 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 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
        earlyKey <- calculateEarlySecret ctx choice (Right earlySecret)
        let clientEarlySecret = SecretPair EarlySecret -> ClientTrafficSecret EarlySecret
forall a. SecretPair a -> ClientTrafficSecret a
pairClient SecretPair EarlySecret
earlyKey
        unless (ctxQUICMode ctx) $ do
            runPacketFlight ctx $ sendChangeCipherSpec13 ctx
            setTxRecordState ctx usedHash usedCipher clientEarlySecret
            setEstablished ctx EarlyDataSending
        -- We set RTT0Sent even in quicMode
        usingHState ctx $ setTLS13RTT0Status RTT0Sent
        return $ EarlySecretInfo usedCipher 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
    pskInfo <- IO (Maybe ([ByteString], SessionData, CipherChoice, Word32))
getPskInfo
    let 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 = Maybe CipherChoice -> Bool
forall a. Maybe a -> Bool
isJust Maybe CipherChoice
rtt0info
    return (pskInfo, rtt0info, 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
            sCipher <- Word16 -> [Cipher] -> Maybe Cipher
findCipher Word16
cid [Cipher]
ciphers
            Just (sid : sids, sdata, 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
            age <- TLS13TicketInfo -> IO Word32
getAge TLS13TicketInfo
tinfo
            return $
                if isAgeValid age tinfo
                    then
                        Just
                            ( identity
                            , sdata
                            , makeCipherChoice TLS13 sCipher
                            , ageToObfuscatedAge age tinfo
                            )
                    else 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
ClientRandom
Session
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 (func, enc, 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 = Handshake -> ByteString
encodeHandshake' (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
chI
        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 -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> CompressionID -> ByteString
B.replicate Int
padLen CompressionID
0
    let 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 = EncryptedClientHello -> ByteString
forall a. Extension a => a -> ByteString
extensionEncode EncryptedClientHello
outerZ
        chExtsOTail = Int -> [ExtensionRaw] -> [ExtensionRaw]
forall a. Int -> [a] -> [a]
drop Int
1 [ExtensionRaw]
chExtsO
        chOZ =
            ClientHello
ch0
                { chRandom = crO
                , chExtensions =
                    ExtensionRaw EID_EncryptedClientHello echOZ : chExtsOTail
                }
        aad = Handshake -> ByteString
encodeHandshake' (Handshake -> ByteString) -> Handshake -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientHello -> Handshake
ClientHello ClientHello
chOZ
    bsO <- func aad bsI'
    let 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 = EncryptedClientHello -> ByteString
forall a. Extension a => a -> ByteString
extensionEncode EncryptedClientHello
outer
        chO =
            ClientHello
chOZ
                { chExtensions =
                    ExtensionRaw EID_EncryptedClientHello echO : chExtsOTail
                }
    return 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
    mfunc <- Context
-> IO (Maybe (ByteString -> ByteString -> IO ByteString, Int))
getTLS13HPKE Context
ctx
    case 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
            (pkSm, 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 = ContextS -> ByteString -> ByteString -> IO ByteString
seal ContextS
ctxS
            setTLS13HPKE ctx func 0
            return $ Just (func, pkSm, 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
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
contents
  where
    conv :: HpkeSymmetricCipherSuite -> (KDF_ID, AEAD_ID)
conv HpkeSymmetricCipherSuite{Word16
kdf_id :: Word16
aead_id :: Word16
aead_id :: HpkeSymmetricCipherSuite -> Word16
kdf_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
    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
    enc <- getStdRandom $ uniformByteString 32
    n <- getStdRandom $ randomR (4, 6)
    payload <- getStdRandom $ uniformByteString (n * 32 + 16)
    let 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
                }
    return $ toExtensionRaw outer

#if !MIN_VERSION_random(1,3,0)
uniformByteString :: RandomGen g => Int -> g -> (ByteString, g)
uniformByteString l g0 = (bs, g2)
  where
    (g1, g2) = split g0
    bs = unsafeCreate l $ go 0 g1
    go n g ptr
        | n == l = return ()
        | otherwise = do
            let (w, g') = genWord8 g
            poke ptr w
            go (n + 1) g' (plusPtr ptr 1)
#endif