{-# 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
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
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 (Word16 -> CipherId
CipherId (Word16 -> CipherId) -> (Cipher -> Word16) -> Cipher -> CipherId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cipher -> Word16
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
setMyRecordLimit ctx $ limitRecordSize $ sharedLimit $ clientShared cparams
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
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)
sniExt
, IO (Maybe ExtensionRaw)
groupExt
, IO (Maybe ExtensionRaw)
ecPointExt
, IO (Maybe ExtensionRaw)
signatureAlgExt
, IO (Maybe ExtensionRaw)
alpnExt
, IO (Maybe ExtensionRaw)
emsExt
, IO (Maybe ExtensionRaw)
compCertExt
, IO (Maybe ExtensionRaw)
recordSizeLimitExt
, IO (Maybe ExtensionRaw)
sessionTicketExt
, IO (Maybe ExtensionRaw)
earlyDataExt
, IO (Maybe ExtensionRaw)
versionExt
, IO (Maybe ExtensionRaw)
cookieExt
, IO (Maybe ExtensionRaw)
pskExchangeModeExt
, IO (Maybe ExtensionRaw)
postHandshakeAuthExt
, IO (Maybe ExtensionRaw)
keyShareExt
, IO (Maybe ExtensionRaw)
secureRenegExt
, IO (Maybe ExtensionRaw)
preSharedKeyExt
]
sniExt :: IO (Maybe ExtensionRaw)
sniExt =
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
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 [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
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
$ ClientParams -> Shared
clientShared ClientParams
cparams 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 -> [(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
""
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 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
versionExt :: IO (Maybe ExtensionRaw)
versionExt
| 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
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
preSharedKeyExt :: IO (Maybe ExtensionRaw)
preSharedKeyExt =
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
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
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)
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
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
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 :: Word16
cid = SessionData -> Word16
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 <- Word16 -> [Cipher] -> Maybe Cipher
findCipher Word16
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