{-# LANGUAGE OverloadedStrings #-}

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

import Network.TLS.Cipher
import Network.TLS.Compression
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.Process
import Network.TLS.Handshake.Random
import Network.TLS.Handshake.State
import Network.TLS.Handshake.State13
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
    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 -> Maybe (SessionID, SessionData)
clientWantSessionResume ClientParams
cparams of
                Maybe (SessionID, SessionData)
Nothing -> Maybe SessionID -> Session
Session Maybe SessionID
forall a. Maybe a
Nothing
                Just (SessionID
sidOrTkt, SessionData
sdata)
                    | SessionData -> Version
sessionVersion SessionData
sdata Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13 -> Maybe SessionID -> Session
Session Maybe SessionID
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 SessionID -> Session
Session Maybe SessionID
forall a. Maybe a
Nothing
                    | SessionID -> Bool
isTicket SessionID
sidOrTkt -> Maybe SessionID -> Session
Session (Maybe SessionID -> Session) -> Maybe SessionID -> Session
forall a b. (a -> b) -> a -> b
$ SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just (SessionID -> Maybe SessionID) -> SessionID -> Maybe SessionID
forall a b. (a -> b) -> a -> b
$ SessionID -> SessionID
toSessionID SessionID
sidOrTkt
                    | Bool
otherwise -> Maybe SessionID -> Session
Session (SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
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 SessionID -> Session
Session Maybe SessionID
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
    -> PreSharedKeyInfo
    -> IO ()
sendClientHello' :: ClientParams
-> Context -> [Group] -> ClientRandom -> PreSharedKeyInfo -> IO ()
sendClientHello' ClientParams
cparams Context
ctx [Group]
groups ClientRandom
crand (Maybe (SessionID, SessionData, CipherChoice, Second)
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 Cipher -> CipherID
cipherID [Cipher]
ciphers
        compIds :: [CompressionID]
compIds = (Compression -> CompressionID) -> [Compression] -> [CompressionID]
forall a b. (a -> b) -> [a] -> [b]
map Compression -> CompressionID
compressionID [Compression]
compressions
        mkClientHello :: [ExtensionRaw] -> Handshake
mkClientHello [ExtensionRaw]
exts = Version -> ClientRandom -> [CompressionID] -> CH -> Handshake
ClientHello Version
ver ClientRandom
crand [CompressionID]
compIds (CH -> Handshake) -> CH -> Handshake
forall a b. (a -> b) -> a -> b
$ Session -> [CipherID] -> [ExtensionRaw] -> CH
CH Session
clientSession [CipherID]
cipherIds [ExtensionRaw]
exts
    [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] -> Handshake -> IO [ExtensionRaw]
adjustExtentions [ExtensionRaw]
extensions1 (Handshake -> IO [ExtensionRaw]) -> Handshake -> IO [ExtensionRaw]
forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> Handshake
mkClientHello [ExtensionRaw]
extensions1
    Context -> Packet -> IO ()
sendPacket12 Context
ctx (Packet -> IO ()) -> Packet -> IO ()
forall a b. (a -> b) -> a -> b
$ [Handshake] -> Packet
Handshake [[ExtensionRaw] -> Handshake
mkClientHello [ExtensionRaw]
extensions]
    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 SessionID
_) -> 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
    compressions :: [Compression]
compressions = Supported -> [Compression]
supportedCompressions (Supported -> [Compression]) -> Supported -> [Compression]
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
            [ IO (Maybe ExtensionRaw)
sniExtension
            , IO (Maybe ExtensionRaw)
secureReneg
            , IO (Maybe ExtensionRaw)
alpnExtension
            , IO (Maybe ExtensionRaw)
emsExtension
            , IO (Maybe ExtensionRaw)
groupExtension
            , IO (Maybe ExtensionRaw)
ecPointExtension
            , IO (Maybe ExtensionRaw)
sessionTicketExtension
            , IO (Maybe ExtensionRaw)
signatureAlgExtension
            , -- , heartbeatExtension
              IO (Maybe ExtensionRaw)
versionExtension
            , IO (Maybe ExtensionRaw)
earlyDataExtension
            , IO (Maybe ExtensionRaw)
keyshareExtension
            , IO (Maybe ExtensionRaw)
cookieExtension
            , IO (Maybe ExtensionRaw)
postHandshakeAuthExtension
            , IO (Maybe ExtensionRaw)
pskExchangeModeExtension
            , IO (Maybe ExtensionRaw)
preSharedKeyExtension -- MUST be last (RFC 8446)
            ]

    toExtensionRaw :: Extension e => e -> ExtensionRaw
    toExtensionRaw :: forall e. Extension e => e -> ExtensionRaw
toExtensionRaw e
ext = ExtensionID -> SessionID -> ExtensionRaw
ExtensionRaw (e -> ExtensionID
forall a. Extension a => a -> ExtensionID
extensionID e
ext) (e -> SessionID
forall a. Extension a => a -> SessionID
extensionEncode e
ext)

    secureReneg :: IO (Maybe ExtensionRaw)
secureReneg =
        if Supported -> Bool
supportedSecureRenegotiation (Supported -> Bool) -> Supported -> Bool
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
            then do
                SessionID
cvd <- Context -> TLSSt SessionID -> IO SessionID
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt SessionID -> IO SessionID)
-> TLSSt SessionID -> IO SessionID
forall a b. (a -> b) -> a -> b
$ Role -> TLSSt SessionID
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
$ SessionID -> SessionID -> SecureRenegotiation
SecureRenegotiation SessionID
cvd SessionID
""
            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
    alpnExtension :: IO (Maybe ExtensionRaw)
alpnExtension = do
        Maybe [SessionID]
mprotos <- ClientHooks -> IO (Maybe [SessionID])
onSuggestALPN (ClientHooks -> IO (Maybe [SessionID]))
-> ClientHooks -> IO (Maybe [SessionID])
forall a b. (a -> b) -> a -> b
$ ClientParams -> ClientHooks
clientHooks ClientParams
cparams
        case Maybe [SessionID]
mprotos of
            Maybe [SessionID]
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 [SessionID]
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
$ [SessionID] -> TLSSt ()
setClientALPNSuggest [SessionID]
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
$ [SessionID] -> ApplicationLayerProtocolNegotiation
ApplicationLayerProtocolNegotiation [SessionID]
protos
    emsExtension :: IO (Maybe ExtensionRaw)
emsExtension =
        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
    sniExtension :: IO (Maybe ExtensionRaw)
sniExtension =
        if ClientParams -> Bool
clientUseServerNameIndication ClientParams
cparams
            then do
                let sni :: HostName
sni = (HostName, SessionID) -> HostName
forall a b. (a, b) -> a
fst ((HostName, SessionID) -> HostName)
-> (HostName, SessionID) -> HostName
forall a b. (a -> b) -> a -> b
$ ClientParams -> (HostName, SessionID)
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
$ HostName -> TLSSt ()
setClientSNI HostName
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 [HostName -> ServerNameType
ServerNameHostName HostName
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

    groupExtension :: IO (Maybe ExtensionRaw)
groupExtension =
        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)
    ecPointExtension :: IO (Maybe ExtensionRaw)
ecPointExtension =
        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]
    -- [EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2]
    -- heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend

    sessionTicketExtension :: IO (Maybe ExtensionRaw)
sessionTicketExtension = do
        case ClientParams -> Maybe (SessionID, SessionData)
clientWantSessionResume ClientParams
cparams of
            Just (SessionID
sidOrTkt, SessionData
_)
                | SessionID -> Bool
isTicket SessionID
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
$ SessionID -> SessionTicket
SessionTicket SessionID
sidOrTkt
            Maybe (SessionID, 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
$ SessionID -> SessionTicket
SessionTicket SessionID
""

    signatureAlgExtension :: IO (Maybe ExtensionRaw)
signatureAlgExtension =
        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

    versionExtension :: IO (Maybe ExtensionRaw)
versionExtension
        | 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

    -- FIXME
    keyshareExtension :: IO (Maybe ExtensionRaw)
keyshareExtension
        | 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

    preSharedKeyExtension :: IO (Maybe ExtensionRaw)
preSharedKeyExtension =
        case Maybe (SessionID, SessionData, CipherChoice, Second)
pskInfo of
            Maybe (SessionID, SessionData, CipherChoice, Second)
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 (SessionID
identity, SessionData
_, CipherChoice
choice, Second
obfAge) ->
                let zero :: SessionID
zero = CipherChoice -> SessionID
cZero CipherChoice
choice
                    pskIdentity :: PskIdentity
pskIdentity = SessionID -> Second -> PskIdentity
PskIdentity SessionID
identity Second
obfAge
                    offeredPsks :: PreSharedKey
offeredPsks = [PskIdentity] -> [SessionID] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity
pskIdentity] [SessionID
zero]
                 in 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

    pskExchangeModeExtension :: IO (Maybe ExtensionRaw)
pskExchangeModeExtension
        | 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

    earlyDataExtension :: IO (Maybe ExtensionRaw)
earlyDataExtension
        | 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 Second -> EarlyDataIndication
EarlyDataIndication Maybe Second
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

    cookieExtension :: IO (Maybe ExtensionRaw)
cookieExtension = 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

    postHandshakeAuthExtension :: IO (Maybe ExtensionRaw)
postHandshakeAuthExtension
        | 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

    adjustExtentions :: [ExtensionRaw] -> Handshake -> IO [ExtensionRaw]
adjustExtentions [ExtensionRaw]
exts Handshake
ch =
        case Maybe (SessionID, SessionData, CipherChoice, Second)
pskInfo of
            Maybe (SessionID, SessionData, CipherChoice, Second)
Nothing -> [ExtensionRaw] -> IO [ExtensionRaw]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ExtensionRaw]
exts
            Just (SessionID
_, SessionData
sdata, CipherChoice
choice, Second
_) -> do
                let psk :: SessionID
psk = SessionData -> SessionID
sessionSecret SessionData
sdata
                    earlySecret :: BaseSecret EarlySecret
earlySecret = CipherChoice -> Maybe SessionID -> BaseSecret EarlySecret
initEarlySecret CipherChoice
choice (SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
psk)
                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
$ BaseSecret EarlySecret -> HandshakeM ()
setTLS13EarlySecret BaseSecret EarlySecret
earlySecret
                let ech :: SessionID
ech = Handshake -> SessionID
encodeHandshake Handshake
ch
                    h :: Hash
h = CipherChoice -> Hash
cHash CipherChoice
choice
                    siz :: Int
siz = Hash -> Int
hashDigestSize Hash
h
                SessionID
binder <- Context
-> BaseSecret EarlySecret
-> Hash
-> Int
-> Maybe SessionID
-> IO SessionID
makePSKBinder Context
ctx BaseSecret EarlySecret
earlySecret Hash
h (Int
siz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
ech)
                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 SessionID
withoutBinders) = ExtensionID -> SessionID -> ExtensionRaw
ExtensionRaw ExtensionID
eid SessionID
withBinders
                      where
                        withBinders :: SessionID
withBinders = SessionID -> SessionID -> SessionID
replacePSKBinder SessionID
withoutBinders SessionID
binder
                [ExtensionRaw] -> IO [ExtensionRaw]
forall a. a -> IO 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
        -- Client hello is stored in hstHandshakeDigest
        -- But HandshakeDigestContext is not created yet.
        SecretPair EarlySecret
earlyKey <- Context
-> CipherChoice
-> Either SessionID (BaseSecret EarlySecret)
-> Bool
-> IO (SecretPair EarlySecret)
calculateEarlySecret Context
ctx CipherChoice
choice (BaseSecret EarlySecret -> Either SessionID (BaseSecret EarlySecret)
forall a b. b -> Either a b
Right BaseSecret EarlySecret
earlySecret) Bool
False
        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 (SessionID, SessionData, CipherChoice, Second), Maybe CipherChoice, Bool)

getPreSharedKeyInfo
    :: ClientParams
    -> Context
    -> IO PreSharedKeyInfo
getPreSharedKeyInfo :: ClientParams -> Context -> IO PreSharedKeyInfo
getPreSharedKeyInfo ClientParams
cparams Context
ctx = do
    Maybe (SessionID, SessionData, CipherChoice, Second)
pskInfo <- IO (Maybe (SessionID, SessionData, CipherChoice, Second))
getPskInfo
    let rtt0info :: Maybe CipherChoice
rtt0info = Maybe (SessionID, SessionData, CipherChoice, Second)
pskInfo Maybe (SessionID, SessionData, CipherChoice, Second)
-> ((SessionID, SessionData, CipherChoice, Second)
    -> 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
>>= (SessionID, SessionData, CipherChoice, Second)
-> 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 (SessionID, SessionData, CipherChoice, Second)
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
    sessionAndCipherToResume13 :: Maybe (SessionID, SessionData, Cipher)
sessionAndCipherToResume13 = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
tls13
        (SessionID
sid, SessionData
sdata) <- ClientParams -> Maybe (SessionID, SessionData)
clientWantSessionResume ClientParams
cparams
        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 :: CipherID
cid = SessionData -> CipherID
sessionCipher SessionData
sdata
        Cipher
sCipher <- (Cipher -> Bool) -> [Cipher] -> Maybe Cipher
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Cipher
c -> Cipher -> CipherID
cipherID Cipher
c CipherID -> CipherID -> Bool
forall a. Eq a => a -> a -> Bool
== CipherID
cid) [Cipher]
ciphers
        (SessionID, SessionData, Cipher)
-> Maybe (SessionID, SessionData, Cipher)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionID
sid, SessionData
sdata, Cipher
sCipher)

    getPskInfo :: IO (Maybe (SessionID, SessionData, CipherChoice, Second))
getPskInfo =
        case Maybe (SessionID, SessionData, Cipher)
sessionAndCipherToResume13 of
            Maybe (SessionID, SessionData, Cipher)
Nothing -> Maybe (SessionID, SessionData, CipherChoice, Second)
-> IO (Maybe (SessionID, SessionData, CipherChoice, Second))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SessionID, SessionData, CipherChoice, Second)
forall a. Maybe a
Nothing
            Just (SessionID
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
                Second
age <- TLS13TicketInfo -> IO Second
getAge TLS13TicketInfo
tinfo
                Maybe (SessionID, SessionData, CipherChoice, Second)
-> IO (Maybe (SessionID, SessionData, CipherChoice, Second))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SessionID, SessionData, CipherChoice, Second)
 -> IO (Maybe (SessionID, SessionData, CipherChoice, Second)))
-> Maybe (SessionID, SessionData, CipherChoice, Second)
-> IO (Maybe (SessionID, SessionData, CipherChoice, Second))
forall a b. (a -> b) -> a -> b
$
                    if Second -> TLS13TicketInfo -> Bool
isAgeValid Second
age TLS13TicketInfo
tinfo
                        then
                            (SessionID, SessionData, CipherChoice, Second)
-> Maybe (SessionID, SessionData, CipherChoice, Second)
forall a. a -> Maybe a
Just
                                ( SessionID
identity
                                , SessionData
sdata
                                , Version -> Cipher -> CipherChoice
makeCipherChoice Version
TLS13 Cipher
sCipher
                                , Second -> TLS13TicketInfo -> Second
ageToObfuscatedAge Second
age TLS13TicketInfo
tinfo
                                )
                        else Maybe (SessionID, SessionData, CipherChoice, Second)
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