{-# 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
    crand <- Maybe (ClientRandom, Session, Version) -> IO ClientRandom
forall {c}. Maybe (ClientRandom, Session, c) -> IO ClientRandom
generateClientHelloParams Maybe (ClientRandom, Session, Version)
mparams
    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 -> [(SessionID, SessionData)]
clientSessions ClientParams
cparams of
                [] -> Maybe SessionID -> Session
Session Maybe SessionID
forall a. Maybe a
Nothing
                (SessionID
sidOrTkt, SessionData
sdata) : [(SessionID, SessionData)]
_
                    | 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 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
    -> 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
    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 Cipher -> CipherID
cipherID [Cipher]
ciphers
        compIds = (Compression -> CompressionID) -> [Compression] -> [CompressionID]
forall a b. (a -> b) -> [a] -> [b]
map Compression -> CompressionID
compressionID [Compression]
compressions
        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
    extensions0 <- catMaybes <$> getExtensions
    let extensions1 = Shared -> [ExtensionRaw]
sharedHelloExtensions (ClientParams -> Shared
clientShared ClientParams
cparams) [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
forall a. [a] -> [a] -> [a]
++ [ExtensionRaw]
extensions0
    extensions <- adjustExtentions extensions1 $ mkClientHello extensions1
    sendPacket12 ctx $ Handshake [mkClientHello extensions]
    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 SessionID
_) -> 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
    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
                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
                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
    alpnExtension :: IO (Maybe ExtensionRaw)
alpnExtension = do
        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 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 :: String
sni = (String, SessionID) -> String
forall a b. (a, b) -> a
fst ((String, SessionID) -> String) -> (String, SessionID) -> String
forall a b. (a -> b) -> a -> b
$ ClientParams -> (String, 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
$ 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

    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 -> [(SessionID, SessionData)]
clientSessions ClientParams
cparams of
            (SessionID
sidOrTkt, SessionData
_) : [(SessionID, 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
            [(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
                (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

    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]
identities, SessionData
_, CipherChoice
choice, Second
obfAge) ->
                let zero :: SessionID
zero = CipherChoice -> SessionID
cZero CipherChoice
choice
                    pskIdentities :: [PskIdentity]
pskIdentities = (SessionID -> PskIdentity) -> [SessionID] -> [PskIdentity]
forall a b. (a -> b) -> [a] -> [b]
map (\SessionID
x -> SessionID -> Second -> PskIdentity
PskIdentity SessionID
x Second
obfAge) [SessionID]
identities
                    -- [zero] is a place holds.
                    -- adjustExtentions will replace them.
                    binders :: [SessionID]
binders = Int -> SessionID -> [SessionID]
forall a. Int -> a -> [a]
replicate ([PskIdentity] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PskIdentity]
pskIdentities) SessionID
zero
                    offeredPsks :: PreSharedKey
offeredPsks = [PskIdentity] -> [SessionID] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity]
pskIdentities [SessionID]
binders
                 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
        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

    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]
identities, 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [SessionID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SessionID]
identities Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                binder <- Context
-> BaseSecret EarlySecret
-> Hash
-> Int
-> Maybe SessionID
-> IO SessionID
makePSKBinder Context
ctx BaseSecret EarlySecret
earlySecret Hash
h Int
siz (SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
ech)
                -- PSK is shared by the previous TLS session.
                -- So, PSK is unique for identities.
                let binders = Int -> SessionID -> [SessionID]
forall a. Int -> a -> [a]
replicate ([SessionID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SessionID]
identities) SessionID
binder
                let 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 ExtensionID
eid SessionID
withoutBinders) = ExtensionID -> SessionID -> ExtensionRaw
ExtensionRaw ExtensionID
eid SessionID
withBinders
                      where
                        withBinders :: SessionID
withBinders = SessionID -> [SessionID] -> SessionID
replacePSKBinder SessionID
withoutBinders [SessionID]
binders
                return 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
        -- Client hello is stored in hstHandshakeDigest
        -- But HandshakeDigestContext is not created yet.
        earlyKey <- calculateEarlySecret ctx choice (Right earlySecret) False
        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 ([SessionID], SessionData, CipherChoice, Second))
getPskInfo
    let 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 = 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 ([SessionID], SessionData, Cipher)
sessions = case ClientParams -> [(SessionID, SessionData)]
clientSessions ClientParams
cparams of
        [] -> Maybe ([SessionID], SessionData, Cipher)
forall a. Maybe a
Nothing
        (SessionID
sid, SessionData
sdata) : [(SessionID, 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 :: CipherID
cid = SessionData -> CipherID
sessionCipher SessionData
sdata
                sids :: [SessionID]
sids = ((SessionID, SessionData) -> SessionID)
-> [(SessionID, SessionData)] -> [SessionID]
forall a b. (a -> b) -> [a] -> [b]
map (SessionID, SessionData) -> SessionID
forall a b. (a, b) -> a
fst [(SessionID, SessionData)]
xs
            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
            Just (sid : sids, sdata, sCipher)

    getPskInfo :: IO (Maybe ([SessionID], SessionData, CipherChoice, Second))
getPskInfo = case Maybe ([SessionID], SessionData, Cipher)
sessions 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
            age <- TLS13TicketInfo -> IO Second
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