    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- |
    -- Module      : Network.TLS.Handshake.Client
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.Handshake.Client
        ( handshakeClient
        , handshakeClientWith
        , postHandshakeAuthClientWith
        ) where

    import Network.TLS.Crypto
    import Network.TLS.Context.Internal
    import Network.TLS.Parameters
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.Cipher
    import Network.TLS.Compression
    import Network.TLS.Credentials
    import Network.TLS.Packet hiding (getExtensions)
    import Network.TLS.ErrT
    import Network.TLS.Extension
    import Network.TLS.IO
    import Network.TLS.Imports
    import Network.TLS.State
    import Network.TLS.Measurement
    import Network.TLS.Util (bytesEq, catchException, fromJust, mapChunks_)
    import Network.TLS.Types
    import Network.TLS.X509
    import qualified Data.ByteString as B
    import Data.X509 (ExtKeyUsageFlag(..))

    import Control.Monad.State.Strict
    import Control.Exception (SomeException, bracket)

    import Network.TLS.Handshake.Certificate
    import Network.TLS.Handshake.Common
    import Network.TLS.Handshake.Common13
    import Network.TLS.Handshake.Control
    import Network.TLS.Handshake.Key
    import Network.TLS.Handshake.Process
    import Network.TLS.Handshake.Random
    import Network.TLS.Handshake.Signature
    import Network.TLS.Handshake.State
    import Network.TLS.Handshake.State13
    import Network.TLS.Wire

    handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
    handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
    handshakeClientWith ClientParams
    cparams Context
    ctx Handshake
    HelloRequest = ClientParams -> Context -> IO ()
    handshakeClient ClientParams
    cparams Context
    ctx
    handshakeClientWith ClientParams
    _       Context
    _   Handshake
    _            = TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unexpected handshake message received in handshakeClientWith", Bool
    True, AlertDescription
    HandshakeFailure)

    -- client part of handshake. send a bunch of handshake of client
    -- values intertwined with response from the server.
    handshakeClient :: ClientParams -> Context -> IO ()
    handshakeClient :: ClientParams -> Context -> IO ()
    handshakeClient ClientParams
    cparams Context
    ctx = do
        let groups :: [Group]
    groups = case ClientParams -> Maybe (ByteString, SessionData)
    clientWantSessionResume ClientParams
    cparams of
                  Maybe (ByteString, SessionData)
    Nothing         -> [Group]
    groupsSupported
                  Just (ByteString
    _, SessionData
    sdata) -> case SessionData -> Maybe Group
    sessionGroup SessionData
    sdata of
                      Maybe Group
    Nothing  -> [] -- TLS 1.2 or earlier
                      Just Group
    grp -> Group
    grp Group -> [Group] -> [Group]
    forall a. a -> [a] -> [a]
    : (Group -> Bool) -> [Group] -> [Group]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Group -> Group -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Group
    grp) [Group]
    groupsSupported
            groupsSupported :: [Group]
    groupsSupported = Supported -> [Group]
    supportedGroups (Context -> Supported
    ctxSupported Context
    ctx)
        ClientParams
    -> Context
    -> [Group]
    -> Maybe (ClientRandom, Session, Version)
    -> IO ()
    handshakeClient' ClientParams
    cparams Context
    ctx [Group]
    groups Maybe (ClientRandom, Session, Version)
    forall a. Maybe a
    Nothing

    -- https://tools.ietf.org/html/rfc8446#section-4.1.2 says:
    -- "The client will also send a
    --  ClientHello when the server has responded to its ClientHello with a
    --  HelloRetryRequest.  In that case, the client MUST send the same
    --  ClientHello without modification, except as follows:"
    --
    -- So, the ClientRandom in the first client hello is necessary.
    handshakeClient' :: ClientParams -> Context -> [Group] -> Maybe (ClientRandom, Session, Version) -> IO ()
    handshakeClient' :: ClientParams
    -> Context
    -> [Group]
    -> Maybe (ClientRandom, Session, Version)
    -> IO ()
    handshakeClient' ClientParams
    cparams Context
    ctx [Group]
    groups Maybe (ClientRandom, Session, Version)
    mparams = do
        Context -> (Measurement -> Measurement) -> IO ()
    updateMeasure Context
    ctx Measurement -> Measurement
    incrementNbHandshakes
        (ClientRandom
    crand, Session
    clientSession) <- IO (ClientRandom, Session)
    generateClientHelloParams
        (Bool
    rtt0, [ExtensionID]
    sentExtensions) <- Session -> ClientRandom -> IO (Bool, [ExtensionID])
    sendClientHello Session
    clientSession ClientRandom
    crand
        Session -> [ExtensionID] -> IO ()
    recvServerHello Session
    clientSession [ExtensionID]
    sentExtensions
        Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    -> ((ClientRandom, Session, Version) -> Bool)
    -> Maybe (ClientRandom, Session, Version)
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (\(ClientRandom
    _, Session
    _, Version
    v) -> Version
    v Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    ver) Maybe (ClientRandom, Session, Version)
    mparams) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "version changed after hello retry", Bool
    True, AlertDescription
    IllegalParameter)
        -- recvServerHello sets TLS13HRR according to the server random.
        -- For 1st server hello, getTLS13HR returns True if it is HRR and False otherwise.
        -- For 2nd server hello, getTLS13HR returns False since it is NOT HRR.
        Bool
    hrr <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS13HRR
        if Version
    ver Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    TLS13 then
            if Bool
    hrr then case Int -> [Group] -> [Group]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Group]
    groups of
                []      -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "group is exhausted in the client side", Bool
    True, AlertDescription
    IllegalParameter)
                [Group]
    groups' -> do
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe (ClientRandom, Session, Version) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (ClientRandom, Session, Version)
    mparams) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server sent too many hello retries", Bool
    True, AlertDescription
    UnexpectedMessage)
                    Maybe KeyShare
    mks <- Context -> TLSSt (Maybe KeyShare) -> IO (Maybe KeyShare)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe KeyShare)
    getTLS13KeyShare
                    case Maybe KeyShare
    mks of
                      Just (KeyShareHRR Group
    selectedGroup)
                        | Group
    selectedGroup Group -> [Group] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Group]
    groups' -> do
                              Context -> HandshakeM () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ HandshakeMode13 -> HandshakeM ()
    setTLS13HandshakeMode HandshakeMode13
    HelloRetryRequest
                              Context -> IO ()
    clearTxState Context
    ctx
                              let cparams' :: ClientParams
    cparams' = ClientParams
    cparams { clientEarlyData :: Maybe ByteString
    clientEarlyData = Maybe ByteString
    forall a. Maybe a
    Nothing }
                              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
                              ClientParams
    -> Context
    -> [Group]
    -> Maybe (ClientRandom, Session, Version)
    -> IO ()
    handshakeClient' ClientParams
    cparams' Context
    ctx [Group
    selectedGroup] ((ClientRandom, Session, Version)
    -> Maybe (ClientRandom, Session, Version)
    forall a. a -> Maybe a
    Just (ClientRandom
    crand, Session
    clientSession, Version
    ver))
                        | Bool
    otherwise -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server-selected group is not supported", Bool
    True, AlertDescription
    IllegalParameter)
                      Just KeyShare
    _  -> String -> IO ()
    forall a. HasCallStack => String -> a
    error String
    "handshakeClient': invalid KeyShare value"
                      Maybe KeyShare
    Nothing -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "key exchange not implemented in HRR, expected key_share extension", Bool
    True, AlertDescription
    HandshakeFailure)
              else
                ClientParams -> Context -> Maybe Group -> IO ()
    handshakeClient13 ClientParams
    cparams Context
    ctx Maybe Group
    groupToSend
          else do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    rtt0 (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server denied TLS 1.3 when connecting with early data", Bool
    True, AlertDescription
    HandshakeFailure)
            Bool
    sessionResuming <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    isSessionResuming
            if Bool
    sessionResuming
                then Context -> Role -> IO ()
    sendChangeCipherAndFinish Context
    ctx Role
    ClientRole
                else do ClientParams -> Context -> IO ()
    sendClientData ClientParams
    cparams Context
    ctx
                        Context -> Role -> IO ()
    sendChangeCipherAndFinish Context
    ctx Role
    ClientRole
                        Context -> IO ()
    recvChangeCipherAndFinish Context
    ctx
            Context -> IO ()
    handshakeTerminate Context
    ctx
      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
    supportedExtendedMasterSec (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 :: Maybe (ByteString, b, CipherChoice, Word32)
    -> Bool -> IO [Maybe ExtensionRaw]
    getExtensions Maybe (ByteString, b, CipherChoice, Word32)
    pskInfo Bool
    rtt0 = [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
                --, sessionTicketExtension
                , IO (Maybe ExtensionRaw)
    signatureAlgExtension
                --, heartbeatExtension
                , IO (Maybe ExtensionRaw)
    versionExtension
                , Bool -> IO (Maybe ExtensionRaw)
    forall {m :: * -> *}. Monad m => Bool -> m (Maybe ExtensionRaw)
    earlyDataExtension Bool
    rtt0
                , IO (Maybe ExtensionRaw)
    keyshareExtension
                , IO (Maybe ExtensionRaw)
    cookieExtension
                , IO (Maybe ExtensionRaw)
    postHandshakeAuthExtension
                , IO (Maybe ExtensionRaw)
    pskExchangeModeExtension
                , Maybe (ByteString, b, CipherChoice, Word32)
    -> IO (Maybe ExtensionRaw)
    forall {m :: * -> *} {b}.
    Monad m =>
    Maybe (ByteString, b, CipherChoice, Word32)
    -> m (Maybe ExtensionRaw)
    preSharedKeyExtension Maybe (ByteString, b, CipherChoice, Word32)
    pskInfo -- MUST be last (RFC 8446)
                ]

            toExtensionRaw :: Extension e => e -> ExtensionRaw
            toExtensionRaw :: forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw e
    ext = ExtensionID -> ByteString -> ExtensionRaw
    ExtensionRaw (e -> ExtensionID
    forall a. Extension a => a -> ExtensionID
    extensionID e
    ext) (e -> ByteString
    forall a. Extension a => a -> ByteString
    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 Context -> TLSSt ByteString -> IO ByteString
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (Role -> TLSSt ByteString
    getVerifiedData Role
    ClientRole) IO ByteString
    -> (ByteString -> IO (Maybe ExtensionRaw))
    -> IO (Maybe ExtensionRaw)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ByteString
    vd -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
    -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a b. (a -> b) -> a -> b
    $ ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ SecureRenegotiation -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (SecureRenegotiation -> ExtensionRaw)
    -> SecureRenegotiation -> ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> SecureRenegotiation
    SecureRenegotiation ByteString
    vd Maybe ByteString
    forall a. Maybe a
    Nothing
                    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 [ByteString]
    mprotos <- ClientHooks -> IO (Maybe [ByteString])
    onSuggestALPN (ClientHooks -> IO (Maybe [ByteString]))
    -> ClientHooks -> IO (Maybe [ByteString])
    forall a b. (a -> b) -> a -> b
    $ ClientParams -> ClientHooks
    clientHooks ClientParams
    cparams
                case Maybe [ByteString]
    mprotos of
                    Maybe [ByteString]
    Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ExtensionRaw
    forall a. Maybe a
    Nothing
                    Just [ByteString]
    protos -> do
                        Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> TLSSt ()
    setClientALPNSuggest [ByteString]
    protos
                        Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
    -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a b. (a -> b) -> a -> b
    $ ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ ApplicationLayerProtocolNegotiation -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (ApplicationLayerProtocolNegotiation -> ExtensionRaw)
    -> ApplicationLayerProtocolNegotiation -> ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ApplicationLayerProtocolNegotiation
    ApplicationLayerProtocolNegotiation [ByteString]
    protos
            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
    $ ExtendedMasterSecret -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw ExtendedMasterSecret
    ExtendedMasterSecret
            sniExtension :: IO (Maybe ExtensionRaw)
    sniExtension = if ClientParams -> Bool
    clientUseServerNameIndication ClientParams
    cparams
                             then do let sni :: String
    sni = (String, ByteString) -> String
    forall a b. (a, b) -> a
    fst ((String, ByteString) -> String) -> (String, ByteString) -> String
    forall a b. (a -> b) -> a -> b
    $ ClientParams -> (String, ByteString)
    clientServerIdentification ClientParams
    cparams
                                     Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> TLSSt ()
    setClientSNI String
    sni
                                     Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
    -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a b. (a -> b) -> a -> b
    $ ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ ServerName -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (ServerName -> ExtensionRaw) -> ServerName -> ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ [ServerNameType] -> ServerName
    ServerName [String -> ServerNameType
    ServerNameHostName String
    sni]
                             else Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ExtensionRaw
    forall a. Maybe a
    Nothing

            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
    $ NegotiatedGroups -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (NegotiatedGroups -> ExtensionRaw)
    -> NegotiatedGroups -> ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ [Group] -> NegotiatedGroups
    NegotiatedGroups (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 = return $ Just $ toExtensionRaw $ SessionTicket

            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
    TLS10) ([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

            sessionAndCipherToResume13 :: Maybe (ByteString, SessionData, Cipher)
    sessionAndCipherToResume13 = do
                Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard Bool
    tls13
                (ByteString
    sid, SessionData
    sdata) <- ClientParams -> Maybe (ByteString, 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)
                Cipher
    sCipher <- (Cipher -> Bool) -> [Cipher] -> Maybe Cipher
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\Cipher
    c -> Cipher -> ExtensionID
    cipherID Cipher
    c ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == SessionData -> ExtensionID
    sessionCipher SessionData
    sdata) [Cipher]
    ciphers
                (ByteString, SessionData, Cipher)
    -> Maybe (ByteString, SessionData, Cipher)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString
    sid, SessionData
    sdata, Cipher
    sCipher)

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

            preSharedKeyExtension :: Maybe (ByteString, b, CipherChoice, Word32)
    -> m (Maybe ExtensionRaw)
    preSharedKeyExtension Maybe (ByteString, b, CipherChoice, Word32)
    pskInfo =
                case Maybe (ByteString, b, CipherChoice, Word32)
    pskInfo of
                    Maybe (ByteString, b, CipherChoice, Word32)
    Nothing -> Maybe ExtensionRaw -> m (Maybe ExtensionRaw)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ExtensionRaw
    forall a. Maybe a
    Nothing
                    Just (ByteString
    sid, b
    _, CipherChoice
    choice, Word32
    obfAge) ->
                        let zero :: ByteString
    zero = CipherChoice -> ByteString
    cZero CipherChoice
    choice
                            identity :: PskIdentity
    identity = ByteString -> Word32 -> PskIdentity
    PskIdentity ByteString
    sid Word32
    obfAge
                            offeredPsks :: PreSharedKey
    offeredPsks = [PskIdentity] -> [ByteString] -> PreSharedKey
    PreSharedKeyClientHello [PskIdentity
    identity] [ByteString
    zero]
                         in Maybe ExtensionRaw -> m (Maybe ExtensionRaw)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ExtensionRaw -> m (Maybe ExtensionRaw))
    -> Maybe ExtensionRaw -> m (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 :: Bool -> m (Maybe ExtensionRaw)
    earlyDataExtension Bool
    rtt0
              | Bool
    rtt0 = Maybe ExtensionRaw -> m (Maybe ExtensionRaw)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ExtensionRaw -> m (Maybe ExtensionRaw))
    -> Maybe ExtensionRaw -> m (Maybe ExtensionRaw)
    forall a b. (a -> b) -> a -> b
    $ ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ EarlyDataIndication -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (Maybe Word32 -> EarlyDataIndication
    EarlyDataIndication Maybe Word32
    forall a. Maybe a
    Nothing)
              | Bool
    otherwise = Maybe ExtensionRaw -> m (Maybe ExtensionRaw)
    forall a. a -> m 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 :: Maybe (a, SessionData, CipherChoice, d)
    -> [ExtensionRaw] -> Handshake -> IO [ExtensionRaw]
    adjustExtentions Maybe (a, SessionData, CipherChoice, d)
    pskInfo [ExtensionRaw]
    exts Handshake
    ch =
                case Maybe (a, SessionData, CipherChoice, d)
    pskInfo of
                    Maybe (a, SessionData, CipherChoice, d)
    Nothing -> [ExtensionRaw] -> IO [ExtensionRaw]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ExtensionRaw]
    exts
                    Just (a
    _, SessionData
    sdata, CipherChoice
    choice, d
    _) -> do
                          let psk :: ByteString
    psk = SessionData -> ByteString
    sessionSecret SessionData
    sdata
                              earlySecret :: BaseSecret EarlySecret
    earlySecret = CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
    initEarlySecret CipherChoice
    choice (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    psk)
                          Context -> HandshakeM () -> 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 :: ByteString
    ech = Handshake -> ByteString
    encodeHandshake Handshake
    ch
                              h :: Hash
    h = CipherChoice -> Hash
    cHash CipherChoice
    choice
                              siz :: Int
    siz = Hash -> Int
    hashDigestSize Hash
    h
                          ByteString
    binder <- Context
    -> BaseSecret EarlySecret
    -> Hash
    -> Int
    -> Maybe ByteString
    -> IO ByteString
    makePSKBinder Context
    ctx BaseSecret EarlySecret
    earlySecret Hash
    h (Int
    siz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    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 ByteString
    withoutBinders) = ExtensionID -> ByteString -> ExtensionRaw
    ExtensionRaw ExtensionID
    eid ByteString
    withBinders
                                where
                                  withBinders :: ByteString
    withBinders = ByteString -> ByteString -> ByteString
    replacePSKBinder ByteString
    withoutBinders ByteString
    binder
                          [ExtensionRaw] -> IO [ExtensionRaw]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ExtensionRaw]
    exts'

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

            sendClientHello :: Session -> ClientRandom -> IO (Bool, [ExtensionID])
    sendClientHello Session
    clientSession ClientRandom
    crand = do
                let ver :: Version
    ver = if Bool
    tls13 then Version
    TLS12 else Version
    highestVer
                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 :: [ExtensionID]
    cipherIds = (Cipher -> ExtensionID) -> [Cipher] -> [ExtensionID]
    forall a b. (a -> b) -> [a] -> [b]
    map Cipher -> ExtensionID
    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
    -> Session
    -> [ExtensionID]
    -> [CompressionID]
    -> [ExtensionRaw]
    -> Maybe ByteString
    -> Handshake
    ClientHello Version
    ver ClientRandom
    crand Session
    clientSession [ExtensionID]
    cipherIds [CompressionID]
    compIds [ExtensionRaw]
    exts Maybe ByteString
    forall a. Maybe a
    Nothing
                Maybe (ByteString, SessionData, CipherChoice, Word32)
    pskInfo <- IO (Maybe (ByteString, SessionData, CipherChoice, Word32))
    getPskInfo
                let rtt0info :: Maybe (CipherChoice, ByteString)
    rtt0info = Maybe (ByteString, SessionData, CipherChoice, Word32)
    pskInfo Maybe (ByteString, SessionData, CipherChoice, Word32)
    -> ((ByteString, SessionData, CipherChoice, Word32)
        -> Maybe (CipherChoice, ByteString))
    -> Maybe (CipherChoice, ByteString)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (ByteString, SessionData, CipherChoice, Word32)
    -> Maybe (CipherChoice, ByteString)
    forall {a} {a} {d}. (a, SessionData, a, d) -> Maybe (a, ByteString)
    get0RTTinfo
                    rtt0 :: Bool
    rtt0 = Maybe (CipherChoice, ByteString) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (CipherChoice, ByteString)
    rtt0info
                [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
    <$> Maybe (ByteString, SessionData, CipherChoice, Word32)
    -> Bool -> IO [Maybe ExtensionRaw]
    forall {b}.
    Maybe (ByteString, b, CipherChoice, Word32)
    -> Bool -> IO [Maybe ExtensionRaw]
    getExtensions Maybe (ByteString, SessionData, CipherChoice, Word32)
    pskInfo Bool
    rtt0
                let extensions1 :: [ExtensionRaw]
    extensions1 = Shared -> [ExtensionRaw]
    sharedHelloExtensions (ClientParams -> Shared
    clientShared ClientParams
    cparams) [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
    forall a. [a] -> [a] -> [a]
    ++ [ExtensionRaw]
    extensions0
                [ExtensionRaw]
    extensions <- Maybe (ByteString, SessionData, CipherChoice, Word32)
    -> [ExtensionRaw] -> Handshake -> IO [ExtensionRaw]
    forall {a} {d}.
    Maybe (a, SessionData, CipherChoice, d)
    -> [ExtensionRaw] -> Handshake -> IO [ExtensionRaw]
    adjustExtentions Maybe (ByteString, SessionData, CipherChoice, Word32)
    pskInfo [ExtensionRaw]
    extensions1 (Handshake -> IO [ExtensionRaw]) -> Handshake -> IO [ExtensionRaw]
    forall a b. (a -> b) -> a -> b
    $ [ExtensionRaw] -> Handshake
    mkClientHello [ExtensionRaw]
    extensions1
                Context -> Packet -> IO ()
    sendPacket 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, ByteString)
    rtt0info of
                   Maybe (CipherChoice, ByteString)
    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, ByteString)
    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, ByteString) -> IO EarlySecretInfo
    send0RTT (CipherChoice, ByteString)
    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
                (Bool, [ExtensionID]) -> IO (Bool, [ExtensionID])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    rtt0, (ExtensionRaw -> ExtensionID) -> [ExtensionRaw] -> [ExtensionID]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ExtensionRaw ExtensionID
    i ByteString
    _) -> ExtensionID
    i) [ExtensionRaw]
    extensions)

            get0RTTinfo :: (a, SessionData, a, d) -> Maybe (a, ByteString)
    get0RTTinfo (a
    _, SessionData
    sdata, a
    choice, d
    _) = do
                ByteString
    earlyData <- ClientParams -> Maybe ByteString
    clientEarlyData ClientParams
    cparams
                Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (ByteString -> Int
    B.length ByteString
    earlyData Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= SessionData -> Int
    sessionMaxEarlyDataSize SessionData
    sdata)
                (a, ByteString) -> Maybe (a, ByteString)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    choice, ByteString
    earlyData)

            send0RTT :: (CipherChoice, ByteString) -> IO EarlySecretInfo
    send0RTT (CipherChoice
    choice, ByteString
    earlyData) = 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 ByteString (BaseSecret EarlySecret)
    -> Bool
    -> IO (SecretPair EarlySecret)
    calculateEarlySecret Context
    ctx CipherChoice
    choice (BaseSecret EarlySecret
    -> Either ByteString (BaseSecret EarlySecret)
    forall a b. b -> Either a b
    Right BaseSecret EarlySecret
    earlySecret) 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 ()
    setTxState Context
    ctx Hash
    usedHash Cipher
    usedCipher ClientTrafficSecret EarlySecret
    clientEarlySecret
                        let len :: Maybe Int
    len = Context -> Maybe Int
    ctxFragmentSize Context
    ctx
                        Maybe Int -> (ByteString -> IO ()) -> ByteString -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    Maybe Int -> (ByteString -> m a) -> ByteString -> m ()
    mapChunks_ Maybe Int
    len (Context -> Packet13 -> IO ()
    sendPacket13 Context
    ctx (Packet13 -> IO ())
    -> (ByteString -> Packet13) -> ByteString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Packet13
    AppData13) ByteString
    earlyData
                    -- 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

            recvServerHello :: Session -> [ExtensionID] -> IO ()
    recvServerHello Session
    clientSession [ExtensionID]
    sentExts = Context -> RecvState IO -> IO ()
    runRecvState Context
    ctx RecvState IO
    recvState
              where recvState :: RecvState IO
    recvState = (Packet -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Packet -> m (RecvState m)) -> RecvState m
    RecvStateNext ((Packet -> IO (RecvState IO)) -> RecvState IO)
    -> (Packet -> IO (RecvState IO)) -> RecvState IO
    forall a b. (a -> b) -> a -> b
    $ \Packet
    p ->
                        case Packet
    p of
                            Handshake [Handshake]
    hs -> Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
    onRecvStateHandshake Context
    ctx ((Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake ((Handshake -> IO (RecvState IO)) -> RecvState IO)
    -> (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall a b. (a -> b) -> a -> b
    $ Context
    -> ClientParams
    -> Session
    -> [ExtensionID]
    -> Handshake
    -> IO (RecvState IO)
    onServerHello Context
    ctx ClientParams
    cparams Session
    clientSession [ExtensionID]
    sentExts) [Handshake]
    hs -- this adds SH to hstHandshakeMessages
                            Alert [(AlertLevel, AlertDescription)]
    a      ->
                                case [(AlertLevel, AlertDescription)]
    a of
                                    [(AlertLevel
    AlertLevel_Warning, AlertDescription
    UnrecognizedName)] ->
                                        if ClientParams -> Bool
    clientUseServerNameIndication ClientParams
    cparams
                                            then RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecvState IO
    recvState
                                            else [(AlertLevel, AlertDescription)] -> IO (RecvState IO)
    forall {m :: * -> *} {a} {a}. (MonadIO m, Show a) => a -> m a
    throwAlert [(AlertLevel, AlertDescription)]
    a
                                    [(AlertLevel, AlertDescription)]
    _ -> [(AlertLevel, AlertDescription)] -> IO (RecvState IO)
    forall {m :: * -> *} {a} {a}. (MonadIO m, Show a) => a -> m a
    throwAlert [(AlertLevel, AlertDescription)]
    a
                            Packet
    _ -> String -> Maybe String -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Packet -> String
    forall a. Show a => a -> String
    show Packet
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "handshake")
                    throwAlert :: a -> m a
    throwAlert a
    a = TLSError -> m a
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m a) -> TLSError -> m a
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "expecting server hello, got alert : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    a, Bool
    True, AlertDescription
    HandshakeFailure)

    -- | Store the keypair and check that it is compatible with the current protocol
    -- version and a list of 'CertificateType' values.
    storePrivInfoClient :: Context
                        -> [CertificateType]
                        -> Credential
                        -> IO ()
    storePrivInfoClient :: Context -> [CertificateType] -> Credential -> IO ()
    storePrivInfoClient Context
    ctx [CertificateType]
    cTypes (CertificateChain
    cc, PrivKey
    privkey) = do
        PubKey
    pubkey <- Context -> CertificateChain -> PrivKey -> IO PubKey
    forall (m :: * -> *).
    MonadIO m =>
    Context -> CertificateChain -> PrivKey -> m PubKey
    storePrivInfo Context
    ctx CertificateChain
    cc PrivKey
    privkey
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (PubKey -> [CertificateType] -> Bool
    certificateCompatible PubKey
    pubkey [CertificateType]
    cTypes) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                ( PubKey -> String
    pubkeyType PubKey
    pubkey String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " credential does not match allowed certificate types"
                , Bool
    True
                , AlertDescription
    InternalError )
        Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (PubKey
    pubkey PubKey -> Version -> Bool
    `versionCompatible` Version
    ver) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                ( PubKey -> String
    pubkeyType PubKey
    pubkey String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " credential is not supported at version " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Show a => a -> String
    show Version
    ver
                , Bool
    True
                , AlertDescription
    InternalError )

    -- | When the server requests a client certificate, we try to
    -- obtain a suitable certificate chain and private key via the
    -- callback in the client parameters.  It is OK for the callback
    -- to return an empty chain, in many cases the client certificate
    -- is optional.  If the client wishes to abort the handshake for
    -- lack of a suitable certificate, it can throw an exception in
    -- the callback.
    --
    -- The return value is 'Nothing' when no @CertificateRequest@ was
    -- received and no @Certificate@ message needs to be sent. An empty
    -- chain means that an empty @Certificate@ message needs to be sent
    -- to the server, naturally without a @CertificateVerify@.  A non-empty
    -- 'CertificateChain' is the chain to send to the server along with
    -- a corresponding 'CertificateVerify'.
    --
    -- With TLS < 1.2 the server's @CertificateRequest@ does not carry
    -- a signature algorithm list.  It has a list of supported public
    -- key signing algorithms in the @certificate_types@ field.  The
    -- hash is implicit.  It is 'SHA1' for DSS and 'SHA1_MD5' for RSA.
    --
    -- With TLS == 1.2 the server's @CertificateRequest@ always has a
    -- @supported_signature_algorithms@ list, as a fixed component of
    -- the structure.  This list is (wrongly) overloaded to also limit
    -- X.509 signatures in the client's certificate chain.  The BCP
    -- strategy is to find a compatible chain if possible, but else
    -- ignore the constraint, and let the server verify the chain as it
    -- sees fit.  The @supported_signature_algorithms@ field is only
    -- obligatory with respect to signatures on TLS messages, in this
    -- case the @CertificateVerify@ message.  The @certificate_types@
    -- field is still included.
    --
    -- With TLS 1.3 the server's @CertificateRequest@ has a mandatory
    -- @signature_algorithms@ extension, the @signature_algorithms_cert@
    -- extension, which is optional, carries a list of algorithms the
    -- server promises to support in verifying the certificate chain.
    -- As with TLS 1.2, the client's makes a /best-effort/ to deliver
    -- a compatible certificate chain where all the CA signatures are
    -- known to be supported, but it should not abort the connection
    -- just because the chain might not work out, just send the best
    -- chain you have and let the server worry about the rest.  The
    -- supported public key algorithms are now inferred from the
    -- @signature_algorithms@ extension and @certificate_types@ is
    -- gone.
    --
    -- With TLS 1.3, we synthesize and store a @certificate_types@
    -- field at the time that the server's @CertificateRequest@
    -- message is received.  This is then present across all the
    -- protocol versions, and can be used to determine whether
    -- a @CertificateRequest@ was received or not.
    --
    -- If @signature_algorithms@ is 'Nothing', then we're doing
    -- TLS 1.0 or 1.1.  The @signature_algorithms_cert@ extension
    -- is optional in TLS 1.3, and so the application callback
    -- will not be able to distinguish between TLS 1.[01] and
    -- TLS 1.3 with no certificate algorithm hints, but this
    -- just simplifies the chain selection process, all CA
    -- signatures are OK.
    --
    clientChain :: ClientParams -> Context -> IO (Maybe CertificateChain)
    clientChain :: ClientParams -> Context -> IO (Maybe CertificateChain)
    clientChain ClientParams
    cparams Context
    ctx =
        Context
    -> HandshakeM (Maybe CertReqCBdata) -> IO (Maybe CertReqCBdata)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM (Maybe CertReqCBdata)
    getCertReqCBdata IO (Maybe CertReqCBdata)
    -> (Maybe CertReqCBdata -> IO (Maybe CertificateChain))
    -> IO (Maybe CertificateChain)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Maybe CertReqCBdata
    Nothing     -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CertificateChain
    forall a. Maybe a
    Nothing
            Just CertReqCBdata
    cbdata -> do
                let callback :: OnCertificateRequest
    callback = ClientHooks -> OnCertificateRequest
    onCertificateRequest (ClientHooks -> OnCertificateRequest)
    -> ClientHooks -> OnCertificateRequest
    forall a b. (a -> b) -> a -> b
    $ ClientParams -> ClientHooks
    clientHooks ClientParams
    cparams
                Maybe Credential
    chain <- IO (Maybe Credential) -> IO (Maybe Credential)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Credential) -> IO (Maybe Credential))
    -> IO (Maybe Credential) -> IO (Maybe Credential)
    forall a b. (a -> b) -> a -> b
    $ OnCertificateRequest
    callback CertReqCBdata
    cbdata IO (Maybe Credential)
    -> (SomeException -> IO (Maybe Credential))
    -> IO (Maybe Credential)
    forall a. IO a -> (SomeException -> IO a) -> IO a
    `catchException`
                    String -> SomeException -> IO (Maybe Credential)
    forall a. String -> SomeException -> IO a
    throwMiscErrorOnException String
    "certificate request callback failed"
                case Maybe Credential
    chain of
                    Maybe Credential
    Nothing
                        -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CertificateChain -> IO (Maybe CertificateChain))
    -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a b. (a -> b) -> a -> b
    $ CertificateChain -> Maybe CertificateChain
    forall a. a -> Maybe a
    Just (CertificateChain -> Maybe CertificateChain)
    -> CertificateChain -> Maybe CertificateChain
    forall a b. (a -> b) -> a -> b
    $ [SignedExact Certificate] -> CertificateChain
    CertificateChain []
                    Just (CertificateChain [], PrivKey
    _)
                        -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CertificateChain -> IO (Maybe CertificateChain))
    -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a b. (a -> b) -> a -> b
    $ CertificateChain -> Maybe CertificateChain
    forall a. a -> Maybe a
    Just (CertificateChain -> Maybe CertificateChain)
    -> CertificateChain -> Maybe CertificateChain
    forall a b. (a -> b) -> a -> b
    $ [SignedExact Certificate] -> CertificateChain
    CertificateChain []
                    Just cred :: Credential
    cred@(CertificateChain
    cc, PrivKey
    _)
                        -> do
                           let ([CertificateType]
    cTypes, Maybe [HashAndSignatureAlgorithm]
    _, [DistinguishedName]
    _) = CertReqCBdata
    cbdata
                           Context -> [CertificateType] -> Credential -> IO ()
    storePrivInfoClient Context
    ctx [CertificateType]
    cTypes Credential
    cred
                           Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe CertificateChain -> IO (Maybe CertificateChain))
    -> Maybe CertificateChain -> IO (Maybe CertificateChain)
    forall a b. (a -> b) -> a -> b
    $ CertificateChain -> Maybe CertificateChain
    forall a. a -> Maybe a
    Just CertificateChain
    cc

    -- | Return a most preferred 'HandAndSignatureAlgorithm' that is compatible with
    -- the local key and server's signature algorithms (both already saved).  Must
    -- only be called for TLS versions 1.2 and up, with compatibility function
    -- 'signatureCompatible' or 'signatureCompatible13' based on version.
    --
    -- The values in the server's @signature_algorithms@ extension are
    -- in descending order of preference.  However here the algorithms
    -- are selected by client preference in @cHashSigs@.
    --
    getLocalHashSigAlg :: Context
                       -> (PubKey -> HashAndSignatureAlgorithm -> Bool)
                       -> [HashAndSignatureAlgorithm]
                       -> PubKey
                       -> IO HashAndSignatureAlgorithm
    getLocalHashSigAlg :: Context
    -> (PubKey -> HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm]
    -> PubKey
    -> IO HashAndSignatureAlgorithm
    getLocalHashSigAlg Context
    ctx PubKey -> HashAndSignatureAlgorithm -> Bool
    isCompatible [HashAndSignatureAlgorithm]
    cHashSigs PubKey
    pubKey = do
        -- Must be present with TLS 1.2 and up.
        (Just ([CertificateType]
    _, Just [HashAndSignatureAlgorithm]
    hashSigs, [DistinguishedName]
    _)) <- Context
    -> HandshakeM (Maybe CertReqCBdata) -> IO (Maybe CertReqCBdata)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM (Maybe CertReqCBdata)
    getCertReqCBdata
        let want :: HashAndSignatureAlgorithm -> Bool
    want = Bool -> Bool -> Bool
    (&&) (Bool -> Bool -> Bool)
    -> (HashAndSignatureAlgorithm -> Bool)
    -> HashAndSignatureAlgorithm
    -> Bool
    -> Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PubKey -> HashAndSignatureAlgorithm -> Bool
    isCompatible PubKey
    pubKey
                        (HashAndSignatureAlgorithm -> Bool -> Bool)
    -> (HashAndSignatureAlgorithm -> Bool)
    -> HashAndSignatureAlgorithm
    -> Bool
    forall a b.
    (HashAndSignatureAlgorithm -> a -> b)
    -> (HashAndSignatureAlgorithm -> a)
    -> HashAndSignatureAlgorithm
    -> b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (HashAndSignatureAlgorithm -> [HashAndSignatureAlgorithm] -> Bool)
    -> [HashAndSignatureAlgorithm] -> HashAndSignatureAlgorithm -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip HashAndSignatureAlgorithm -> [HashAndSignatureAlgorithm] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem [HashAndSignatureAlgorithm]
    hashSigs
        case (HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm] -> Maybe HashAndSignatureAlgorithm
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find HashAndSignatureAlgorithm -> Bool
    want [HashAndSignatureAlgorithm]
    cHashSigs of
            Just HashAndSignatureAlgorithm
    best -> HashAndSignatureAlgorithm -> IO HashAndSignatureAlgorithm
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashAndSignatureAlgorithm
    best
            Maybe HashAndSignatureAlgorithm
    Nothing   -> TLSError -> IO HashAndSignatureAlgorithm
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO HashAndSignatureAlgorithm)
    -> TLSError -> IO HashAndSignatureAlgorithm
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                             ( PubKey -> String
    keyerr PubKey
    pubKey
                             , Bool
    True
                             , AlertDescription
    HandshakeFailure
                             )
      where
        keyerr :: PubKey -> String
    keyerr PubKey
    k = String
    "no " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " hash algorithm in common with the server"

    -- | Return the supported 'CertificateType' values that are
    -- compatible with at least one supported signature algorithm.
    --
    supportedCtypes :: [HashAndSignatureAlgorithm]
                    -> [CertificateType]
    supportedCtypes :: [HashAndSignatureAlgorithm] -> [CertificateType]
    supportedCtypes [HashAndSignatureAlgorithm]
    hashAlgs =
        [CertificateType] -> [CertificateType]
    forall a. Eq a => [a] -> [a]
    nub ([CertificateType] -> [CertificateType])
    -> [CertificateType] -> [CertificateType]
    forall a b. (a -> b) -> a -> b
    $ (HashAndSignatureAlgorithm
     -> [CertificateType] -> [CertificateType])
    -> [CertificateType]
    -> [HashAndSignatureAlgorithm]
    -> [CertificateType]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr HashAndSignatureAlgorithm -> [CertificateType] -> [CertificateType]
    ctfilter [] [HashAndSignatureAlgorithm]
    hashAlgs
      where
        ctfilter :: HashAndSignatureAlgorithm -> [CertificateType] -> [CertificateType]
    ctfilter HashAndSignatureAlgorithm
    x [CertificateType]
    acc = case HashAndSignatureAlgorithm -> Maybe CertificateType
    hashSigToCertType HashAndSignatureAlgorithm
    x of
           Just CertificateType
    cType | CertificateType
    cType CertificateType -> CertificateType -> Bool
    forall a. Ord a => a -> a -> Bool
    <= CertificateType
    lastSupportedCertificateType
                     -> CertificateType
    cType CertificateType -> [CertificateType] -> [CertificateType]
    forall a. a -> [a] -> [a]
    : [CertificateType]
    acc
           Maybe CertificateType
    _         -> [CertificateType]
    acc
    --
    clientSupportedCtypes :: Context
                          -> [CertificateType]
    clientSupportedCtypes :: Context -> [CertificateType]
    clientSupportedCtypes Context
    ctx =
        [HashAndSignatureAlgorithm] -> [CertificateType]
    supportedCtypes ([HashAndSignatureAlgorithm] -> [CertificateType])
    -> [HashAndSignatureAlgorithm] -> [CertificateType]
    forall a b. (a -> b) -> a -> b
    $ Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
    -> Supported -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx
    --
    sigAlgsToCertTypes :: Context
                       -> [HashAndSignatureAlgorithm]
                       -> [CertificateType]
    sigAlgsToCertTypes :: Context -> [HashAndSignatureAlgorithm] -> [CertificateType]
    sigAlgsToCertTypes Context
    ctx [HashAndSignatureAlgorithm]
    hashSigs =
        (CertificateType -> Bool) -> [CertificateType] -> [CertificateType]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (CertificateType -> [CertificateType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [HashAndSignatureAlgorithm] -> [CertificateType]
    supportedCtypes [HashAndSignatureAlgorithm]
    hashSigs) ([CertificateType] -> [CertificateType])
    -> [CertificateType] -> [CertificateType]
    forall a b. (a -> b) -> a -> b
    $ Context -> [CertificateType]
    clientSupportedCtypes Context
    ctx

    -- | TLS 1.2 and below.  Send the client handshake messages that
    -- follow the @ServerHello@, etc. except for @CCS@ and @Finished@.
    --
    -- XXX: Is any buffering done here to combined these messages into
    -- a single TCP packet?  Otherwise we're prone to Nagle delays, or
    -- in any case needlessly generate multiple small packets, where
    -- a single larger packet will do.  The TLS 1.3 code path seems
    -- to separating record generation and transmission and sending
    -- multiple records in a single packet.
    --
    --       -> [certificate]
    --       -> client key exchange
    --       -> [cert verify]
    sendClientData :: ClientParams -> Context -> IO ()
    sendClientData :: ClientParams -> Context -> IO ()
    sendClientData ClientParams
    cparams Context
    ctx = IO ()
    sendCertificate IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    sendClientKeyXchg IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    sendCertificateVerify
      where
            sendCertificate :: IO ()
    sendCertificate = do
                Context -> HandshakeM () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> HandshakeM ()
    setClientCertSent Bool
    False
                ClientParams -> Context -> IO (Maybe CertificateChain)
    clientChain ClientParams
    cparams Context
    ctx IO (Maybe CertificateChain)
    -> (Maybe CertificateChain -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    Maybe CertificateChain
    Nothing                    -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    Just cc :: CertificateChain
    cc@(CertificateChain [SignedExact Certificate]
    certs) -> do
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([SignedExact Certificate] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SignedExact Certificate]
    certs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                            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
    $ Bool -> HandshakeM ()
    setClientCertSent Bool
    True
                        Context -> Packet -> IO ()
    sendPacket Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake] -> Packet
    Handshake [CertificateChain -> Handshake
    Certificates CertificateChain
    cc]

            sendClientKeyXchg :: IO ()
    sendClientKeyXchg = do
                Cipher
    cipher <- Context -> HandshakeM Cipher -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Cipher
    getPendingCipher
                (ClientKeyXchgAlgorithmData
    ckx, HandshakeM ByteString
    setMasterSec) <- case Cipher -> CipherKeyExchangeType
    cipherKeyExchange Cipher
    cipher of
                    CipherKeyExchangeType
    CipherKeyExchange_RSA -> do
                        Version
    clientVersion <- Context -> HandshakeM Version -> IO Version
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM Version -> IO Version)
    -> HandshakeM Version -> IO Version
    forall a b. (a -> b) -> a -> b
    $ (HandshakeState -> Version) -> HandshakeM Version
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets HandshakeState -> Version
    hstClientVersion
                        (Version
    xver, ByteString
    prerand) <- Context -> TLSSt (Version, ByteString) -> IO (Version, ByteString)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt (Version, ByteString) -> IO (Version, ByteString))
    -> TLSSt (Version, ByteString) -> IO (Version, ByteString)
    forall a b. (a -> b) -> a -> b
    $ (,) (Version -> ByteString -> (Version, ByteString))
    -> TLSSt Version -> TLSSt (ByteString -> (Version, ByteString))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TLSSt Version
    getVersion TLSSt (ByteString -> (Version, ByteString))
    -> TLSSt ByteString -> TLSSt (Version, ByteString)
    forall a b. TLSSt (a -> b) -> TLSSt a -> TLSSt b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> TLSSt ByteString
    genRandom Int
    46

                        let premaster :: ByteString
    premaster = Version -> ByteString -> ByteString
    encodePreMasterSecret Version
    clientVersion ByteString
    prerand
                            setMasterSec :: HandshakeM ByteString
    setMasterSec = Version -> Role -> ByteString -> HandshakeM ByteString
    forall preMaster.
    ByteArrayAccess preMaster =>
    Version -> Role -> preMaster -> HandshakeM ByteString
    setMasterSecretFromPre Version
    xver Role
    ClientRole ByteString
    premaster
                        ByteString
    encryptedPreMaster <- do
                            -- SSL3 implementation generally forget this length field since it's redundant,
                            -- however TLS10 make it clear that the length field need to be present.
                            ByteString
    e <- Context -> ByteString -> IO ByteString
    encryptRSA Context
    ctx ByteString
    premaster
                            let extra :: ByteString
    extra = if Version
    xver Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    < Version
    TLS10
                                            then ByteString
    B.empty
                                            else ExtensionID -> ByteString
    encodeWord16 (ExtensionID -> ByteString) -> ExtensionID -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ExtensionID
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> ExtensionID) -> Int -> ExtensionID
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    e
                            ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    extra ByteString -> ByteString -> ByteString
    `B.append` ByteString
    e
                        (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ClientKeyXchgAlgorithmData
    CKX_RSA ByteString
    encryptedPreMaster, HandshakeM ByteString
    setMasterSec)
                    CipherKeyExchangeType
    CipherKeyExchange_DHE_RSA -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_DHE
                    CipherKeyExchangeType
    CipherKeyExchange_DHE_DSS -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_DHE
                    CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_ECDHE
                    CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_ECDHE
                    CipherKeyExchangeType
    _ -> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError
     -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString))
    -> TLSError
    -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "client key exchange unsupported type", Bool
    True, AlertDescription
    HandshakeFailure)
                Context -> Packet -> IO ()
    sendPacket Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake] -> Packet
    Handshake [ClientKeyXchgAlgorithmData -> Handshake
    ClientKeyXchg ClientKeyXchgAlgorithmData
    ckx]
                ByteString
    masterSecret <- Context -> HandshakeM ByteString -> IO ByteString
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM ByteString
    setMasterSec
                Context -> MasterSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx (ByteString -> MasterSecret
    MasterSecret ByteString
    masterSecret)
              where getCKX_DHE :: IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_DHE = do
                        Version
    xver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
                        ServerDHParams
    serverParams <- Context -> HandshakeM ServerDHParams -> IO ServerDHParams
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM ServerDHParams
    getServerDHParams

                        let params :: DHParams
    params  = ServerDHParams -> DHParams
    serverDHParamsToParams ServerDHParams
    serverParams
                            ffGroup :: Maybe Group
    ffGroup = DHParams -> Maybe Group
    findFiniteFieldGroup DHParams
    params
                            srvpub :: DHPublic
    srvpub  = ServerDHParams -> DHPublic
    serverDHParamsToPublic ServerDHParams
    serverParams

                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool -> (Group -> Bool) -> Maybe Group -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Context -> Group -> Bool
    isSupportedGroup Context
    ctx) Maybe Group
    ffGroup) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                            GroupUsage
    groupUsage <- ClientHooks -> DHParams -> DHPublic -> IO GroupUsage
    onCustomFFDHEGroup (ClientParams -> ClientHooks
    clientHooks ClientParams
    cparams) DHParams
    params DHPublic
    srvpub IO GroupUsage -> (SomeException -> IO GroupUsage) -> IO GroupUsage
    forall a. IO a -> (SomeException -> IO a) -> IO a
    `catchException`
                                              String -> SomeException -> IO GroupUsage
    forall a. String -> SomeException -> IO a
    throwMiscErrorOnException String
    "custom group callback failed"
                            case GroupUsage
    groupUsage of
                                GroupUsage
    GroupUsageInsecure           -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "FFDHE group is not secure enough", Bool
    True, AlertDescription
    InsufficientSecurity)
                                GroupUsageUnsupported String
    reason -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unsupported FFDHE group: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    reason, Bool
    True, AlertDescription
    HandshakeFailure)
                                GroupUsage
    GroupUsageInvalidPublic      -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "invalid server public key", Bool
    True, AlertDescription
    IllegalParameter)
                                GroupUsage
    GroupUsageValid              -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

                        -- When grp is known but not in the supported list we use it
                        -- anyway.  This provides additional validation and a more
                        -- efficient implementation.
                        (DHPublic
    clientDHPub, DHKey
    premaster) <-
                            case Maybe Group
    ffGroup of
                                 Maybe Group
    Nothing  -> do
                                     (DHPrivate
    clientDHPriv, DHPublic
    clientDHPub) <- Context -> DHParams -> IO (DHPrivate, DHPublic)
    generateDHE Context
    ctx DHParams
    params
                                     let premaster :: DHKey
    premaster = DHParams -> DHPrivate -> DHPublic -> DHKey
    dhGetShared DHParams
    params DHPrivate
    clientDHPriv DHPublic
    srvpub
                                     (DHPublic, DHKey) -> IO (DHPublic, DHKey)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DHPublic
    clientDHPub, DHKey
    premaster)
                                 Just Group
    grp -> do
                                     Context -> HandshakeM () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Group -> HandshakeM ()
    setNegotiatedGroup Group
    grp
                                     Maybe (DHPublic, DHKey)
    dhePair <- Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
    generateFFDHEShared Context
    ctx Group
    grp DHPublic
    srvpub
                                     case Maybe (DHPublic, DHKey)
    dhePair of
                                         Maybe (DHPublic, DHKey)
    Nothing   -> TLSError -> IO (DHPublic, DHKey)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (DHPublic, DHKey))
    -> TLSError -> IO (DHPublic, DHKey)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "invalid server " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Group -> String
    forall a. Show a => a -> String
    show Group
    grp String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " public key", Bool
    True, AlertDescription
    IllegalParameter)
                                         Just (DHPublic, DHKey)
    pair -> (DHPublic, DHKey) -> IO (DHPublic, DHKey)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DHPublic, DHKey)
    pair

                        let setMasterSec :: HandshakeM ByteString
    setMasterSec = Version -> Role -> DHKey -> HandshakeM ByteString
    forall preMaster.
    ByteArrayAccess preMaster =>
    Version -> Role -> preMaster -> HandshakeM ByteString
    setMasterSecretFromPre Version
    xver Role
    ClientRole DHKey
    premaster
                        (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DHPublic -> ClientKeyXchgAlgorithmData
    CKX_DH DHPublic
    clientDHPub, HandshakeM ByteString
    setMasterSec)

                    getCKX_ECDHE :: IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_ECDHE = do
                        ServerECDHParams Group
    grp GroupPublic
    srvpub <- Context -> HandshakeM ServerECDHParams -> IO ServerECDHParams
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM ServerECDHParams
    getServerECDHParams
                        Context -> Group -> IO ()
    checkSupportedGroup 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
    $ Group -> HandshakeM ()
    setNegotiatedGroup Group
    grp
                        Maybe (GroupPublic, GroupKey)
    ecdhePair <- Context -> GroupPublic -> IO (Maybe (GroupPublic, GroupKey))
    generateECDHEShared Context
    ctx GroupPublic
    srvpub
                        case Maybe (GroupPublic, GroupKey)
    ecdhePair of
                            Maybe (GroupPublic, GroupKey)
    Nothing                  -> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError
     -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString))
    -> TLSError
    -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "invalid server " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Group -> String
    forall a. Show a => a -> String
    show Group
    grp String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " public key", Bool
    True, AlertDescription
    IllegalParameter)
                            Just (GroupPublic
    clipub, GroupKey
    premaster) -> do
                                Version
    xver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
                                let setMasterSec :: HandshakeM ByteString
    setMasterSec = Version -> Role -> GroupKey -> HandshakeM ByteString
    forall preMaster.
    ByteArrayAccess preMaster =>
    Version -> Role -> preMaster -> HandshakeM ByteString
    setMasterSecretFromPre Version
    xver Role
    ClientRole GroupKey
    premaster
                                (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ClientKeyXchgAlgorithmData
    CKX_ECDH (ByteString -> ClientKeyXchgAlgorithmData)
    -> ByteString -> ClientKeyXchgAlgorithmData
    forall a b. (a -> b) -> a -> b
    $ GroupPublic -> ByteString
    encodeGroupPublic GroupPublic
    clipub, HandshakeM ByteString
    setMasterSec)

            -- In order to send a proper certificate verify message,
            -- we have to do the following:
            --
            -- 1. Determine which signing algorithm(s) the server supports
            --    (we currently only support RSA).
            -- 2. Get the current handshake hash from the handshake state.
            -- 3. Sign the handshake hash
            -- 4. Send it to the server.
            --
            sendCertificateVerify :: IO ()
    sendCertificateVerify = do
                Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion

                -- Only send a certificate verify message when we
                -- have sent a non-empty list of certificates.
                --
                Bool
    certSent <- Context -> HandshakeM Bool -> IO Bool
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Bool
    getClientCertSent
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    certSent (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    PubKey
    pubKey      <- Context -> IO PubKey
    forall (m :: * -> *). MonadIO m => Context -> m PubKey
    getLocalPublicKey Context
    ctx
                    Maybe HashAndSignatureAlgorithm
    mhashSig    <- case Version
    ver of
                        Version
    TLS12 ->
                            let cHashSigs :: [HashAndSignatureAlgorithm]
    cHashSigs = Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
    -> Supported -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx
                             in HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
    forall a. a -> Maybe a
    Just (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm)
    -> IO HashAndSignatureAlgorithm
    -> IO (Maybe HashAndSignatureAlgorithm)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context
    -> (PubKey -> HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm]
    -> PubKey
    -> IO HashAndSignatureAlgorithm
    getLocalHashSigAlg Context
    ctx PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible [HashAndSignatureAlgorithm]
    cHashSigs PubKey
    pubKey
                        Version
    _     -> Maybe HashAndSignatureAlgorithm
    -> IO (Maybe HashAndSignatureAlgorithm)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe HashAndSignatureAlgorithm
    forall a. Maybe a
    Nothing

                    -- Fetch all handshake messages up to now.
                    ByteString
    msgs   <- Context -> HandshakeM ByteString -> IO ByteString
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM ByteString -> IO ByteString)
    -> HandshakeM ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> HandshakeM [ByteString] -> HandshakeM ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HandshakeM [ByteString]
    getHandshakeMessages
                    DigitallySigned
    sigDig <- Context
    -> Version
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> ByteString
    -> IO DigitallySigned
    createCertificateVerify Context
    ctx Version
    ver PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    mhashSig ByteString
    msgs
                    Context -> Packet -> IO ()
    sendPacket Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake] -> Packet
    Handshake [DigitallySigned -> Handshake
    CertVerify DigitallySigned
    sigDig]

    processServerExtension :: ExtensionRaw -> TLSSt ()
    processServerExtension :: ExtensionRaw -> TLSSt ()
    processServerExtension (ExtensionRaw ExtensionID
    extID ByteString
    content)
      | ExtensionID
    extID ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExtensionID
    extensionID_SecureRenegotiation = do
            ByteString
    cv <- Role -> TLSSt ByteString
    getVerifiedData Role
    ClientRole
            ByteString
    sv <- Role -> TLSSt ByteString
    getVerifiedData Role
    ServerRole
            let bs :: ByteString
    bs = SecureRenegotiation -> ByteString
    forall a. Extension a => a -> ByteString
    extensionEncode (ByteString -> Maybe ByteString -> SecureRenegotiation
    SecureRenegotiation ByteString
    cv (Maybe ByteString -> SecureRenegotiation)
    -> Maybe ByteString -> SecureRenegotiation
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    sv)
            Bool -> TLSSt () -> TLSSt ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString
    bs ByteString -> ByteString -> Bool
    `bytesEq` ByteString
    content) (TLSSt () -> TLSSt ()) -> TLSSt () -> TLSSt ()
    forall a b. (a -> b) -> a -> b
    $ TLSError -> TLSSt ()
    forall a. TLSError -> TLSSt a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (TLSError -> TLSSt ()) -> TLSError -> TLSSt ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server secure renegotiation data not matching", Bool
    True, AlertDescription
    HandshakeFailure)
      | ExtensionID
    extID ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExtensionID
    extensionID_SupportedVersions = case MessageType -> ByteString -> Maybe SupportedVersions
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTServerHello ByteString
    content of
          Just (SupportedVersionsServerHello Version
    ver) -> Version -> TLSSt ()
    setVersion Version
    ver
          Maybe SupportedVersions
    _                                       -> () -> TLSSt ()
    forall a. a -> TLSSt a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | ExtensionID
    extID ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExtensionID
    extensionID_KeyShare = do
            Bool
    hrr <- TLSSt Bool
    getTLS13HRR
            let msgt :: MessageType
    msgt = if Bool
    hrr then MessageType
    MsgTHelloRetryRequest else MessageType
    MsgTServerHello
            Maybe KeyShare -> TLSSt ()
    setTLS13KeyShare (Maybe KeyShare -> TLSSt ()) -> Maybe KeyShare -> TLSSt ()
    forall a b. (a -> b) -> a -> b
    $ MessageType -> ByteString -> Maybe KeyShare
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    msgt ByteString
    content
      | ExtensionID
    extID ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExtensionID
    extensionID_PreSharedKey =
            Maybe PreSharedKey -> TLSSt ()
    setTLS13PreSharedKey (Maybe PreSharedKey -> TLSSt ()) -> Maybe PreSharedKey -> TLSSt ()
    forall a b. (a -> b) -> a -> b
    $ MessageType -> ByteString -> Maybe PreSharedKey
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTServerHello ByteString
    content
    processServerExtension ExtensionRaw
    _ = () -> TLSSt ()
    forall a. a -> TLSSt a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    throwMiscErrorOnException :: String -> SomeException -> IO a
    throwMiscErrorOnException :: forall a. String -> SomeException -> IO a
    throwMiscErrorOnException String
    msg SomeException
    e =
        TLSError -> IO a
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO a) -> TLSError -> IO a
    forall a b. (a -> b) -> a -> b
    $ String -> TLSError
    Error_Misc (String -> TLSError) -> String -> TLSError
    forall a b. (a -> b) -> a -> b
    $ String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e

    -- | onServerHello process the ServerHello message on the client.
    --
    -- 1) check the version chosen by the server is one allowed by parameters.
    -- 2) check that our compression and cipher algorithms are part of the list we sent
    -- 3) check extensions received are part of the one we sent
    -- 4) process the session parameter to see if the server want to start a new session or can resume
    -- 5) if no resume switch to processCertificate SM or in resume switch to expectChangeCipher
    --
    onServerHello :: Context -> ClientParams -> Session -> [ExtensionID] -> Handshake -> IO (RecvState IO)
    onServerHello :: Context
    -> ClientParams
    -> Session
    -> [ExtensionID]
    -> Handshake
    -> IO (RecvState IO)
    onServerHello Context
    ctx ClientParams
    cparams Session
    clientSession [ExtensionID]
    sentExts (ServerHello Version
    rver ServerRandom
    serverRan Session
    serverSession ExtensionID
    cipher CompressionID
    compression [ExtensionRaw]
    exts) = do
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Version
    rver Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    SSL2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "SSL2 is not supported", Bool
    True, AlertDescription
    ProtocolVersion)
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Version
    rver Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    SSL3) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "SSL3 is not supported", Bool
    True, AlertDescription
    ProtocolVersion)
        -- find the compression and cipher methods that the server want to use.
        Cipher
    cipherAlg <- case (Cipher -> Bool) -> [Cipher] -> Maybe Cipher
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ExtensionID
    cipher (ExtensionID -> Bool) -> (Cipher -> ExtensionID) -> Cipher -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cipher -> ExtensionID
    cipherID) (Supported -> [Cipher]
    supportedCiphers (Supported -> [Cipher]) -> Supported -> [Cipher]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx) of
                         Maybe Cipher
    Nothing  -> TLSError -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO Cipher) -> TLSError -> IO Cipher
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server choose unknown cipher", Bool
    True, AlertDescription
    IllegalParameter)
                         Just Cipher
    alg -> Cipher -> IO Cipher
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cipher
    alg
        Compression
    compressAlg <- case (Compression -> Bool) -> [Compression] -> Maybe Compression
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (CompressionID -> CompressionID -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) CompressionID
    compression (CompressionID -> Bool)
    -> (Compression -> CompressionID) -> Compression -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Compression -> CompressionID
    compressionID) (Supported -> [Compression]
    supportedCompressions (Supported -> [Compression]) -> Supported -> [Compression]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx) of
                           Maybe Compression
    Nothing  -> TLSError -> IO Compression
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO Compression) -> TLSError -> IO Compression
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server choose unknown compression", Bool
    True, AlertDescription
    IllegalParameter)
                           Just Compression
    alg -> Compression -> IO Compression
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Compression
    alg

        -- intersect sent extensions in client and the received extensions from server.
        -- if server returns extensions that we didn't request, fail.
        let checkExt :: ExtensionRaw -> Bool
    checkExt (ExtensionRaw ExtensionID
    i ByteString
    _)
              | ExtensionID
    i ExtensionID -> ExtensionID -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExtensionID
    extensionID_Cookie = Bool
    False -- for HRR
              | Bool
    otherwise               = ExtensionID
    i ExtensionID -> [ExtensionID] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [ExtensionID]
    sentExts
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((ExtensionRaw -> Bool) -> [ExtensionRaw] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ExtensionRaw -> Bool
    checkExt [ExtensionRaw]
    exts) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "spurious extensions received", Bool
    True, AlertDescription
    UnsupportedExtension)

        let resumingSession :: Maybe SessionData
    resumingSession =
                case ClientParams -> Maybe (ByteString, SessionData)
    clientWantSessionResume ClientParams
    cparams of
                    Just (ByteString
    sessionId, SessionData
    sessionData) -> if Session
    serverSession Session -> Session -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe ByteString -> Session
    Session (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    sessionId) then SessionData -> Maybe SessionData
    forall a. a -> Maybe a
    Just SessionData
    sessionData else Maybe SessionData
    forall a. Maybe a
    Nothing
                    Maybe (ByteString, SessionData)
    Nothing                       -> Maybe SessionData
    forall a. Maybe a
    Nothing
            isHRR :: Bool
    isHRR = ServerRandom -> Bool
    isHelloRetryRequest ServerRandom
    serverRan
        Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Bool -> TLSSt ()
    setTLS13HRR Bool
    isHRR
            Maybe Cookie -> TLSSt ()
    setTLS13Cookie (Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard Bool
    isHRR Maybe () -> Maybe ByteString -> Maybe ByteString
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    extensionID_Cookie [ExtensionRaw]
    exts Maybe ByteString -> (ByteString -> Maybe Cookie) -> Maybe Cookie
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MessageType -> ByteString -> Maybe Cookie
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTServerHello)
            Session -> Bool -> TLSSt ()
    setSession Session
    serverSession (Maybe SessionData -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe SessionData
    resumingSession)
            Version -> TLSSt ()
    setVersion Version
    rver -- must be before processing supportedVersions ext
            (ExtensionRaw -> TLSSt ()) -> [ExtensionRaw] -> TLSSt ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ExtensionRaw -> TLSSt ()
    processServerExtension [ExtensionRaw]
    exts

        Context -> MessageType -> [ExtensionRaw] -> IO ()
    setALPN Context
    ctx MessageType
    MsgTServerHello [ExtensionRaw]
    exts

        Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion

        -- Some servers set TLS 1.2 as the legacy server hello version, and TLS 1.3
        -- in the supported_versions extension, *AND ALSO* set the TLS 1.2
        -- downgrade signal in the server random.  If we support TLS 1.3 and
        -- actually negotiate TLS 1.3, we must ignore the server random downgrade
        -- signal.  Therefore, 'isDowngraded' needs to take into account the
        -- negotiated version and the server random, as well as the list of
        -- client-side enabled protocol versions.
        --
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Version -> [Version] -> ServerRandom -> Bool
    isDowngraded Version
    ver (Supported -> [Version]
    supportedVersions (Supported -> [Version]) -> Supported -> [Version]
    forall a b. (a -> b) -> a -> b
    $ ClientParams -> Supported
    clientSupported ClientParams
    cparams) ServerRandom
    serverRan) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "version downgrade detected", Bool
    True, AlertDescription
    IllegalParameter)

        case (Version -> Bool) -> [Version] -> Maybe Version
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    ver) (Supported -> [Version]
    supportedVersions (Supported -> [Version]) -> Supported -> [Version]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx) of
            Maybe Version
    Nothing -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server version " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Show a => a -> String
    show Version
    ver String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is not supported", Bool
    True, AlertDescription
    ProtocolVersion)
            Just Version
    _  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        if Version
    ver Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    > Version
    TLS12 then do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Session
    serverSession Session -> Session -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Session
    clientSession) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "received mismatched legacy session", Bool
    True, AlertDescription
    IllegalParameter)
            Established
    established <- Context -> IO Established
    ctxEstablished Context
    ctx
            Bool
    eof <- Context -> IO Bool
    ctxEOF Context
    ctx
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Established
    established Established -> Established -> Bool
    forall a. Eq a => a -> a -> Bool
    == Established
    Established Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    eof) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "renegotiation to TLS 1.3 or later is not allowed", Bool
    True, AlertDescription
    ProtocolVersion)
            CompressionID -> IO ()
    forall (m :: * -> *). MonadIO m => CompressionID -> m ()
    ensureNullCompression CompressionID
    compression
            IO (Either TLSError ()) -> IO ()
    forall (m :: * -> *) a. MonadIO m => m (Either TLSError a) -> m a
    failOnEitherError (IO (Either TLSError ()) -> IO ())
    -> IO (Either TLSError ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context
    -> HandshakeM (Either TLSError ()) -> IO (Either TLSError ())
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM (Either TLSError ()) -> IO (Either TLSError ()))
    -> HandshakeM (Either TLSError ()) -> IO (Either TLSError ())
    forall a b. (a -> b) -> a -> b
    $ Cipher -> HandshakeM (Either TLSError ())
    setHelloParameters13 Cipher
    cipherAlg
            RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecvState IO
    forall (m :: * -> *). RecvState m
    RecvStateDone
          else do
            Bool
    ems <- Context -> Version -> MessageType -> [ExtensionRaw] -> IO Bool
    forall (m :: * -> *).
    MonadIO m =>
    Context -> Version -> MessageType -> [ExtensionRaw] -> m Bool
    processExtendedMasterSec Context
    ctx Version
    ver MessageType
    MsgTServerHello [ExtensionRaw]
    exts
            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
    $ Version -> ServerRandom -> Cipher -> Compression -> HandshakeM ()
    setServerHelloParameters Version
    rver ServerRandom
    serverRan Cipher
    cipherAlg Compression
    compressAlg
            case Maybe SessionData
    resumingSession of
                Maybe SessionData
    Nothing          -> RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake (ClientParams -> Context -> Handshake -> IO (RecvState IO)
    processCertificate ClientParams
    cparams Context
    ctx)
                Just SessionData
    sessionData -> do
                    let emsSession :: Bool
    emsSession = SessionFlag
    SessionEMS SessionFlag -> [SessionFlag] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` SessionData -> [SessionFlag]
    sessionFlags SessionData
    sessionData
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    ems Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Bool
    emsSession) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        let err :: String
    err = String
    "server resumes a session which is not EMS consistent"
                         in TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    err, Bool
    True, AlertDescription
    HandshakeFailure)
                    let masterSecret :: ByteString
    masterSecret = SessionData -> ByteString
    sessionSecret SessionData
    sessionData
                    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
    $ Version -> Role -> ByteString -> HandshakeM ()
    setMasterSecret Version
    rver Role
    ClientRole ByteString
    masterSecret
                    Context -> MasterSecret -> IO ()
    forall a. LogLabel a => Context -> a -> IO ()
    logKey Context
    ctx (ByteString -> MasterSecret
    MasterSecret ByteString
    masterSecret)
                    RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Packet -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Packet -> m (RecvState m)) -> RecvState m
    RecvStateNext Packet -> IO (RecvState IO)
    expectChangeCipher
    onServerHello Context
    _ ClientParams
    _ Session
    _ [ExtensionID]
    _ Handshake
    p = String -> Maybe String -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake -> String
    forall a. Show a => a -> String
    show Handshake
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "server hello")

    processCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
    processCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
    processCertificate ClientParams
    cparams Context
    ctx (Certificates CertificateChain
    certs) = do
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CertificateChain -> Bool
    isNullCertificateChain CertificateChain
    certs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server certificate missing", Bool
    True, AlertDescription
    DecodeError)
        -- run certificate recv hook
        Context -> (Hooks -> IO ()) -> IO ()
    forall a. Context -> (Hooks -> IO a) -> IO a
    ctxWithHooks Context
    ctx (Hooks -> CertificateChain -> IO ()
    `hookRecvCertificates` CertificateChain
    certs)
        -- then run certificate validation
        CertificateUsage
    usage <- IO CertificateUsage
    -> (SomeException -> IO CertificateUsage) -> IO CertificateUsage
    forall a. IO a -> (SomeException -> IO a) -> IO a
    catchException ([FailedReason] -> CertificateUsage
    wrapCertificateChecks ([FailedReason] -> CertificateUsage)
    -> IO [FailedReason] -> IO CertificateUsage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [FailedReason]
    checkCert) SomeException -> IO CertificateUsage
    rejectOnException
        case CertificateUsage
    usage of
            CertificateUsage
    CertificateUsageAccept        -> IO ()
    checkLeafCertificateKeyUsage
            CertificateUsageReject CertificateRejectReason
    reason -> CertificateRejectReason -> IO ()
    forall (m :: * -> *) a. MonadIO m => CertificateRejectReason -> m a
    certificateRejected CertificateRejectReason
    reason
        RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
    processServerKeyExchange Context
    ctx)
      where shared :: Shared
    shared = ClientParams -> Shared
    clientShared ClientParams
    cparams
            checkCert :: IO [FailedReason]
    checkCert = ClientHooks -> OnServerCertificate
    onServerCertificate (ClientParams -> ClientHooks
    clientHooks ClientParams
    cparams) (Shared -> CertificateStore
    sharedCAStore Shared
    shared)
                                                                  (Shared -> ValidationCache
    sharedValidationCache Shared
    shared)
                                                                  (ClientParams -> (String, ByteString)
    clientServerIdentification ClientParams
    cparams)
                                                                  CertificateChain
    certs
            -- also verify that the certificate optional key usage is compatible
            -- with the intended key-exchange.  This check is not delegated to
            -- x509-validation 'checkLeafKeyUsage' because it depends on negotiated
            -- cipher, which is not available from onServerCertificate parameters.
            -- Additionally, with only one shared ValidationCache, x509-validation
            -- would cache validation result based on a key usage and reuse it with
            -- another key usage.
            checkLeafCertificateKeyUsage :: IO ()
    checkLeafCertificateKeyUsage = do
                Cipher
    cipher <- Context -> HandshakeM Cipher -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Cipher
    getPendingCipher
                case Cipher -> [ExtKeyUsageFlag]
    requiredCertKeyUsage Cipher
    cipher of
                    []    -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    [ExtKeyUsageFlag]
    flags -> [ExtKeyUsageFlag] -> CertificateChain -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    [ExtKeyUsageFlag] -> CertificateChain -> m ()
    verifyLeafKeyUsage [ExtKeyUsageFlag]
    flags CertificateChain
    certs

    processCertificate ClientParams
    _ Context
    ctx Handshake
    p = Context -> Handshake -> IO (RecvState IO)
    processServerKeyExchange Context
    ctx Handshake
    p

    expectChangeCipher :: Packet -> IO (RecvState IO)
    expectChangeCipher :: Packet -> IO (RecvState IO)
    expectChangeCipher Packet
    ChangeCipherSpec = RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake Handshake -> IO (RecvState IO)
    expectFinish
    expectChangeCipher Packet
    p                = String -> Maybe String -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Packet -> String
    forall a. Show a => a -> String
    show Packet
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "change cipher")

    expectFinish :: Handshake -> IO (RecvState IO)
    expectFinish :: Handshake -> IO (RecvState IO)
    expectFinish (Finished ByteString
    _) = RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecvState IO
    forall (m :: * -> *). RecvState m
    RecvStateDone
    expectFinish Handshake
    p            = String -> Maybe String -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake -> String
    forall a. Show a => a -> String
    show Handshake
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "Handshake Finished")

    processServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
    processServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
    processServerKeyExchange Context
    ctx (ServerKeyXchg ServerKeyXchgAlgorithmData
    origSkx) = do
        Cipher
    cipher <- Context -> HandshakeM Cipher -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Cipher
    getPendingCipher
        Cipher -> ServerKeyXchgAlgorithmData -> IO ()
    processWithCipher Cipher
    cipher ServerKeyXchgAlgorithmData
    origSkx
        RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
    processCertificateRequest Context
    ctx)
      where processWithCipher :: Cipher -> ServerKeyXchgAlgorithmData -> IO ()
    processWithCipher Cipher
    cipher ServerKeyXchgAlgorithmData
    skx =
                case (Cipher -> CipherKeyExchangeType
    cipherKeyExchange Cipher
    cipher, ServerKeyXchgAlgorithmData
    skx) of
                    (CipherKeyExchangeType
    CipherKeyExchange_DHE_RSA, SKX_DHE_RSA ServerDHParams
    dhparams DigitallySigned
    signature) ->
                        ServerDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doDHESignature ServerDHParams
    dhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    KX_RSA
                    (CipherKeyExchangeType
    CipherKeyExchange_DHE_DSS, SKX_DHE_DSS ServerDHParams
    dhparams DigitallySigned
    signature) ->
                        ServerDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doDHESignature ServerDHParams
    dhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    KX_DSS
                    (CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA, SKX_ECDHE_RSA ServerECDHParams
    ecdhparams DigitallySigned
    signature) ->
                        ServerECDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doECDHESignature ServerECDHParams
    ecdhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    KX_RSA
                    (CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA, SKX_ECDHE_ECDSA ServerECDHParams
    ecdhparams DigitallySigned
    signature) ->
                        ServerECDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doECDHESignature ServerECDHParams
    ecdhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    KX_ECDSA
                    (CipherKeyExchangeType
    cke, SKX_Unparsed ByteString
    bytes) -> do
                        Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
                        case Version
    -> CipherKeyExchangeType
    -> ByteString
    -> Either TLSError ServerKeyXchgAlgorithmData
    decodeReallyServerKeyXchgAlgorithmData Version
    ver CipherKeyExchangeType
    cke ByteString
    bytes of
                            Left TLSError
    _        -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unknown server key exchange received, expecting: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CipherKeyExchangeType -> String
    forall a. Show a => a -> String
    show CipherKeyExchangeType
    cke, Bool
    True, AlertDescription
    HandshakeFailure)
                            Right ServerKeyXchgAlgorithmData
    realSkx -> Cipher -> ServerKeyXchgAlgorithmData -> IO ()
    processWithCipher Cipher
    cipher ServerKeyXchgAlgorithmData
    realSkx
                        -- we need to resolve the result. and recall processWithCipher ..
                    (CipherKeyExchangeType
    c,ServerKeyXchgAlgorithmData
    _)           -> TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unknown server key exchange received, expecting: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CipherKeyExchangeType -> String
    forall a. Show a => a -> String
    show CipherKeyExchangeType
    c, Bool
    True, AlertDescription
    HandshakeFailure)
            doDHESignature :: ServerDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doDHESignature ServerDHParams
    dhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    kxsAlg = do
                -- FF group selected by the server is verified when generating CKX
                PubKey
    publicKey <- KeyExchangeSignatureAlg -> IO PubKey
    getSignaturePublicKey KeyExchangeSignatureAlg
    kxsAlg
                Bool
    verified <- Context -> ServerDHParams -> PubKey -> DigitallySigned -> IO Bool
    digitallySignDHParamsVerify Context
    ctx ServerDHParams
    dhparams PubKey
    publicKey DigitallySigned
    signature
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    verified (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    decryptError (String
    "bad " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    publicKey String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " signature for dhparams " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ServerDHParams -> String
    forall a. Show a => a -> String
    show ServerDHParams
    dhparams)
                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
    $ ServerDHParams -> HandshakeM ()
    setServerDHParams ServerDHParams
    dhparams

            doECDHESignature :: ServerECDHParams
    -> DigitallySigned -> KeyExchangeSignatureAlg -> IO ()
    doECDHESignature ServerECDHParams
    ecdhparams DigitallySigned
    signature KeyExchangeSignatureAlg
    kxsAlg = do
                -- EC group selected by the server is verified when generating CKX
                PubKey
    publicKey <- KeyExchangeSignatureAlg -> IO PubKey
    getSignaturePublicKey KeyExchangeSignatureAlg
    kxsAlg
                Bool
    verified <- Context -> ServerECDHParams -> PubKey -> DigitallySigned -> IO Bool
    digitallySignECDHParamsVerify Context
    ctx ServerECDHParams
    ecdhparams PubKey
    publicKey DigitallySigned
    signature
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    verified (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    decryptError (String
    "bad " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    publicKey String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " signature for ecdhparams")
                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
    $ ServerECDHParams -> HandshakeM ()
    setServerECDHParams ServerECDHParams
    ecdhparams

            getSignaturePublicKey :: KeyExchangeSignatureAlg -> IO PubKey
    getSignaturePublicKey KeyExchangeSignatureAlg
    kxsAlg = do
                PubKey
    publicKey <- Context -> HandshakeM PubKey -> IO PubKey
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM PubKey
    getRemotePublicKey
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (KeyExchangeSignatureAlg -> PubKey -> Bool
    isKeyExchangeSignatureKey KeyExchangeSignatureAlg
    kxsAlg PubKey
    publicKey) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server public key algorithm is incompatible with " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ KeyExchangeSignatureAlg -> String
    forall a. Show a => a -> String
    show KeyExchangeSignatureAlg
    kxsAlg, Bool
    True, AlertDescription
    HandshakeFailure)
                Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (PubKey
    publicKey PubKey -> Version -> Bool
    `versionCompatible` Version
    ver) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (Version -> String
    forall a. Show a => a -> String
    show Version
    ver String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " has no support for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    publicKey, Bool
    True, AlertDescription
    IllegalParameter)
                let groups :: [Group]
    groups = Supported -> [Group]
    supportedGroups (Context -> Supported
    ctxSupported Context
    ctx)
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((Group -> Bool) -> PubKey -> Bool
    satisfiesEcPredicate (Group -> [Group] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Group]
    groups) PubKey
    publicKey) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "server public key has unsupported elliptic curve", Bool
    True, AlertDescription
    IllegalParameter)
                PubKey -> IO PubKey
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PubKey
    publicKey

    processServerKeyExchange Context
    ctx Handshake
    p = Context -> Handshake -> IO (RecvState IO)
    processCertificateRequest Context
    ctx Handshake
    p

    processCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
    processCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
    processCertificateRequest Context
    ctx (CertRequest [CertificateType]
    cTypesSent Maybe [HashAndSignatureAlgorithm]
    sigAlgs [DistinguishedName]
    dNames) = do
        Version
    ver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Version
    ver Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    TLS12 Bool -> Bool -> Bool
    && Maybe [HashAndSignatureAlgorithm] -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe [HashAndSignatureAlgorithm]
    sigAlgs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                ( String
    "missing TLS 1.2 certificate request signature algorithms"
                , Bool
    True
                , AlertDescription
    InternalError
                )
        let cTypes :: [CertificateType]
    cTypes = (CertificateType -> Bool) -> [CertificateType] -> [CertificateType]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (CertificateType -> CertificateType -> Bool
    forall a. Ord a => a -> a -> Bool
    <= CertificateType
    lastSupportedCertificateType) [CertificateType]
    cTypesSent
        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
    $ Maybe CertReqCBdata -> HandshakeM ()
    setCertReqCBdata (Maybe CertReqCBdata -> HandshakeM ())
    -> Maybe CertReqCBdata -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ CertReqCBdata -> Maybe CertReqCBdata
    forall a. a -> Maybe a
    Just ([CertificateType]
    cTypes, Maybe [HashAndSignatureAlgorithm]
    sigAlgs, [DistinguishedName]
    dNames)
        RecvState IO -> IO (RecvState IO)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecvState IO -> IO (RecvState IO))
    -> RecvState IO -> IO (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
    forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
    processServerHelloDone Context
    ctx)
    processCertificateRequest Context
    ctx Handshake
    p = do
        Context -> HandshakeM () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Maybe CertReqCBdata -> HandshakeM ()
    setCertReqCBdata Maybe CertReqCBdata
    forall a. Maybe a
    Nothing
        Context -> Handshake -> IO (RecvState IO)
    forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
    processServerHelloDone Context
    ctx Handshake
    p

    processServerHelloDone :: Context -> Handshake -> IO (RecvState m)
    processServerHelloDone :: forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
    processServerHelloDone Context
    _ Handshake
    ServerHelloDone = RecvState m -> IO (RecvState m)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecvState m
    forall (m :: * -> *). RecvState m
    RecvStateDone
    processServerHelloDone Context
    _ Handshake
    p = String -> Maybe String -> IO (RecvState m)
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake -> String
    forall a. Show a => a -> String
    show Handshake
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "server hello data")

    -- Unless result is empty, server certificate must be allowed for at least one
    -- of the returned values.  Constraints for RSA-based key exchange are relaxed
    -- to avoid rejecting certificates having incomplete extension.
    requiredCertKeyUsage :: Cipher -> [ExtKeyUsageFlag]
    requiredCertKeyUsage :: Cipher -> [ExtKeyUsageFlag]
    requiredCertKeyUsage Cipher
    cipher =
        case Cipher -> CipherKeyExchangeType
    cipherKeyExchange Cipher
    cipher of
            CipherKeyExchangeType
    CipherKeyExchange_RSA         -> [ExtKeyUsageFlag]
    rsaCompatibility
            CipherKeyExchangeType
    CipherKeyExchange_DH_Anon     -> [] -- unrestricted
            CipherKeyExchangeType
    CipherKeyExchange_DHE_RSA     -> [ExtKeyUsageFlag]
    rsaCompatibility
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA   -> [ExtKeyUsageFlag]
    rsaCompatibility
            CipherKeyExchangeType
    CipherKeyExchange_DHE_DSS     -> [ ExtKeyUsageFlag
    KeyUsage_digitalSignature ]
            CipherKeyExchangeType
    CipherKeyExchange_DH_DSS      -> [ ExtKeyUsageFlag
    KeyUsage_keyAgreement ]
            CipherKeyExchangeType
    CipherKeyExchange_DH_RSA      -> [ExtKeyUsageFlag]
    rsaCompatibility
            CipherKeyExchangeType
    CipherKeyExchange_ECDH_ECDSA  -> [ ExtKeyUsageFlag
    KeyUsage_keyAgreement ]
            CipherKeyExchangeType
    CipherKeyExchange_ECDH_RSA    -> [ExtKeyUsageFlag]
    rsaCompatibility
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA -> [ ExtKeyUsageFlag
    KeyUsage_digitalSignature ]
            CipherKeyExchangeType
    CipherKeyExchange_TLS13       -> [ ExtKeyUsageFlag
    KeyUsage_digitalSignature ]
      where rsaCompatibility :: [ExtKeyUsageFlag]
    rsaCompatibility = [ ExtKeyUsageFlag
    KeyUsage_digitalSignature
                               , ExtKeyUsageFlag
    KeyUsage_keyEncipherment
                               , ExtKeyUsageFlag
    KeyUsage_keyAgreement
                               ]

    handshakeClient13 :: ClientParams -> Context -> Maybe Group -> IO ()
    handshakeClient13 :: ClientParams -> Context -> Maybe Group -> IO ()
    handshakeClient13 ClientParams
    cparams Context
    ctx Maybe Group
    groupSent = do
        CipherChoice
    choice <- Version -> Cipher -> CipherChoice
    makeCipherChoice Version
    TLS13 (Cipher -> CipherChoice) -> IO Cipher -> IO CipherChoice
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> HandshakeM Cipher -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Cipher
    getPendingCipher
        ClientParams -> Context -> Maybe Group -> CipherChoice -> IO ()
    handshakeClient13' ClientParams
    cparams Context
    ctx Maybe Group
    groupSent CipherChoice
    choice

    handshakeClient13' :: ClientParams -> Context -> Maybe Group -> CipherChoice -> IO ()
    handshakeClient13' :: ClientParams -> Context -> Maybe Group -> CipherChoice -> IO ()
    handshakeClient13' ClientParams
    cparams Context
    ctx Maybe Group
    groupSent CipherChoice
    choice = do
        (Cipher
    _, SecretTriple HandshakeSecret
    hkey, Bool
    resuming) <- IO (Cipher, SecretTriple HandshakeSecret, Bool)
    switchToHandshakeSecret
        let handshakeSecret :: BaseSecret HandshakeSecret
    handshakeSecret = SecretTriple HandshakeSecret -> BaseSecret HandshakeSecret
    forall a. SecretTriple a -> BaseSecret a
    triBase SecretTriple HandshakeSecret
    hkey
            clientHandshakeSecret :: ClientTrafficSecret HandshakeSecret
    clientHandshakeSecret = SecretTriple HandshakeSecret -> ClientTrafficSecret HandshakeSecret
    forall a. SecretTriple a -> ClientTrafficSecret a
    triClient SecretTriple HandshakeSecret
    hkey
            serverHandshakeSecret :: ServerTrafficSecret HandshakeSecret
    serverHandshakeSecret = SecretTriple HandshakeSecret -> ServerTrafficSecret HandshakeSecret
    forall a. SecretTriple a -> ServerTrafficSecret a
    triServer SecretTriple HandshakeSecret
    hkey
            handSecInfo :: HandshakeSecretInfo
    handSecInfo = Cipher -> TrafficSecrets HandshakeSecret -> HandshakeSecretInfo
    HandshakeSecretInfo Cipher
    usedCipher (ClientTrafficSecret HandshakeSecret
    clientHandshakeSecret,ServerTrafficSecret HandshakeSecret
    serverHandshakeSecret)
        Context -> ClientState -> IO ()
    contextSync Context
    ctx (ClientState -> IO ()) -> ClientState -> IO ()
    forall a b. (a -> b) -> a -> b
    $ HandshakeSecretInfo -> ClientState
    RecvServerHello HandshakeSecretInfo
    handSecInfo
        (Bool
    rtt0accepted,[ExtensionRaw]
    eexts) <- RecvHandshake13M IO (Bool, [ExtensionRaw])
    -> IO (Bool, [ExtensionRaw])
    forall (m :: * -> *) a. MonadIO m => RecvHandshake13M m a -> m a
    runRecvHandshake13 (RecvHandshake13M IO (Bool, [ExtensionRaw])
     -> IO (Bool, [ExtensionRaw]))
    -> RecvHandshake13M IO (Bool, [ExtensionRaw])
    -> IO (Bool, [ExtensionRaw])
    forall a b. (a -> b) -> a -> b
    $ do
            (Bool, [ExtensionRaw])
    accext <- Context
    -> (Handshake13 -> RecvHandshake13M IO (Bool, [ExtensionRaw]))
    -> RecvHandshake13M IO (Bool, [ExtensionRaw])
    forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    recvHandshake13 Context
    ctx Handshake13 -> RecvHandshake13M IO (Bool, [ExtensionRaw])
    forall {m :: * -> *}.
    MonadIO m =>
    Handshake13 -> m (Bool, [ExtensionRaw])
    expectEncryptedExtensions
            Bool -> RecvHandshake13M IO () -> RecvHandshake13M IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    resuming (RecvHandshake13M IO () -> RecvHandshake13M IO ())
    -> RecvHandshake13M IO () -> RecvHandshake13M IO ()
    forall a b. (a -> b) -> a -> b
    $ Context
    -> (Handshake13 -> RecvHandshake13M IO ())
    -> RecvHandshake13M IO ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    recvHandshake13 Context
    ctx Handshake13 -> RecvHandshake13M IO ()
    forall {m :: * -> *}.
    MonadIO m =>
    Handshake13 -> RecvHandshake13M m ()
    expectCertRequest
            Context
    -> (ByteString -> Handshake13 -> RecvHandshake13M IO ())
    -> RecvHandshake13M IO ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (ByteString -> Handshake13 -> RecvHandshake13M m a)
    -> RecvHandshake13M m a
    recvHandshake13hash Context
    ctx ((ByteString -> Handshake13 -> RecvHandshake13M IO ())
     -> RecvHandshake13M IO ())
    -> (ByteString -> Handshake13 -> RecvHandshake13M IO ())
    -> RecvHandshake13M IO ()
    forall a b. (a -> b) -> a -> b
    $ ServerTrafficSecret HandshakeSecret
    -> ByteString -> Handshake13 -> RecvHandshake13M IO ()
    forall {m :: * -> *} {a}.
    MonadIO m =>
    ServerTrafficSecret a -> ByteString -> Handshake13 -> m ()
    expectFinished ServerTrafficSecret HandshakeSecret
    serverHandshakeSecret
            (Bool, [ExtensionRaw])
    -> RecvHandshake13M IO (Bool, [ExtensionRaw])
    forall a. a -> RecvHandshake13M IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool, [ExtensionRaw])
    accext
        ByteString
    hChSf <- Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
        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
    $
            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
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    rtt0accepted Bool -> Bool -> Bool
    && Bool -> Bool
    not (Context -> Bool
    ctxQUICMode Context
    ctx)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Context -> Packet13 -> IO ()
    sendPacket13 Context
    ctx ([Handshake13] -> Packet13
    Handshake13 [Handshake13
    EndOfEarlyData13])
        Context
    -> Hash -> Cipher -> ClientTrafficSecret HandshakeSecret -> IO ()
    forall ty.
    TrafficSecret ty =>
    Context -> Hash -> Cipher -> ty -> IO ()
    setTxState Context
    ctx Hash
    usedHash Cipher
    usedCipher ClientTrafficSecret HandshakeSecret
    clientHandshakeSecret
        ClientParams
    -> Context -> Hash -> ClientTrafficSecret HandshakeSecret -> IO ()
    forall a.
    ClientParams -> Context -> Hash -> ClientTrafficSecret a -> IO ()
    sendClientFlight13 ClientParams
    cparams Context
    ctx Hash
    usedHash ClientTrafficSecret HandshakeSecret
    clientHandshakeSecret
        SecretTriple ApplicationSecret
    appKey <- BaseSecret HandshakeSecret
    -> ByteString -> IO (SecretTriple ApplicationSecret)
    switchToApplicationSecret BaseSecret HandshakeSecret
    handshakeSecret ByteString
    hChSf
        let applicationSecret :: BaseSecret ApplicationSecret
    applicationSecret = SecretTriple ApplicationSecret -> BaseSecret ApplicationSecret
    forall a. SecretTriple a -> BaseSecret a
    triBase SecretTriple ApplicationSecret
    appKey
        BaseSecret ApplicationSecret -> IO ()
    setResumptionSecret BaseSecret ApplicationSecret
    applicationSecret
        let appSecInfo :: ApplicationSecretInfo
    appSecInfo = TrafficSecrets ApplicationSecret -> ApplicationSecretInfo
    ApplicationSecretInfo (SecretTriple ApplicationSecret
    -> ClientTrafficSecret ApplicationSecret
    forall a. SecretTriple a -> ClientTrafficSecret a
    triClient SecretTriple ApplicationSecret
    appKey, SecretTriple ApplicationSecret
    -> ServerTrafficSecret ApplicationSecret
    forall a. SecretTriple a -> ServerTrafficSecret a
    triServer SecretTriple ApplicationSecret
    appKey)
        Context -> ClientState -> IO ()
    contextSync Context
    ctx (ClientState -> IO ()) -> ClientState -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ExtensionRaw] -> ApplicationSecretInfo -> ClientState
    SendClientFinished [ExtensionRaw]
    eexts ApplicationSecretInfo
    appSecInfo
        Context -> IO ()
    handshakeTerminate13 Context
    ctx
      where
        usedCipher :: Cipher
    usedCipher = CipherChoice -> Cipher
    cCipher CipherChoice
    choice
        usedHash :: Hash
    usedHash   = CipherChoice -> Hash
    cHash CipherChoice
    choice

        hashSize :: Int
    hashSize = Hash -> Int
    hashDigestSize Hash
    usedHash

        switchToHandshakeSecret :: IO (Cipher, SecretTriple HandshakeSecret, Bool)
    switchToHandshakeSecret = do
            Context -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    ensureRecvComplete Context
    ctx
            ByteString
    ecdhe <- IO ByteString
    calcSharedKey
            (BaseSecret EarlySecret
    earlySecret, Bool
    resuming) <- IO (BaseSecret EarlySecret, Bool)
    makeEarlySecret
            SecretTriple HandshakeSecret
    handKey <- Context
    -> CipherChoice
    -> BaseSecret EarlySecret
    -> ByteString
    -> IO (SecretTriple HandshakeSecret)
    calculateHandshakeSecret Context
    ctx CipherChoice
    choice BaseSecret EarlySecret
    earlySecret ByteString
    ecdhe
            let serverHandshakeSecret :: ServerTrafficSecret HandshakeSecret
    serverHandshakeSecret = SecretTriple HandshakeSecret -> ServerTrafficSecret HandshakeSecret
    forall a. SecretTriple a -> ServerTrafficSecret a
    triServer SecretTriple HandshakeSecret
    handKey
            Context
    -> Hash -> Cipher -> ServerTrafficSecret HandshakeSecret -> IO ()
    forall ty.
    TrafficSecret ty =>
    Context -> Hash -> Cipher -> ty -> IO ()
    setRxState Context
    ctx Hash
    usedHash Cipher
    usedCipher ServerTrafficSecret HandshakeSecret
    serverHandshakeSecret
            (Cipher, SecretTriple HandshakeSecret, Bool)
    -> IO (Cipher, SecretTriple HandshakeSecret, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Cipher
    usedCipher, SecretTriple HandshakeSecret
    handKey, Bool
    resuming)

        switchToApplicationSecret :: BaseSecret HandshakeSecret
    -> ByteString -> IO (SecretTriple ApplicationSecret)
    switchToApplicationSecret BaseSecret HandshakeSecret
    handshakeSecret ByteString
    hChSf = do
            Context -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    ensureRecvComplete Context
    ctx
            SecretTriple ApplicationSecret
    appKey <- Context
    -> CipherChoice
    -> BaseSecret HandshakeSecret
    -> ByteString
    -> IO (SecretTriple ApplicationSecret)
    calculateApplicationSecret Context
    ctx CipherChoice
    choice BaseSecret HandshakeSecret
    handshakeSecret ByteString
    hChSf
            let serverApplicationSecret0 :: ServerTrafficSecret ApplicationSecret
    serverApplicationSecret0 = SecretTriple ApplicationSecret
    -> ServerTrafficSecret ApplicationSecret
    forall a. SecretTriple a -> ServerTrafficSecret a
    triServer SecretTriple ApplicationSecret
    appKey
            let clientApplicationSecret0 :: ClientTrafficSecret ApplicationSecret
    clientApplicationSecret0 = SecretTriple ApplicationSecret
    -> ClientTrafficSecret ApplicationSecret
    forall a. SecretTriple a -> ClientTrafficSecret a
    triClient SecretTriple ApplicationSecret
    appKey
            Context
    -> Hash -> Cipher -> ClientTrafficSecret ApplicationSecret -> IO ()
    forall ty.
    TrafficSecret ty =>
    Context -> Hash -> Cipher -> ty -> IO ()
    setTxState Context
    ctx Hash
    usedHash Cipher
    usedCipher ClientTrafficSecret ApplicationSecret
    clientApplicationSecret0
            Context
    -> Hash -> Cipher -> ServerTrafficSecret ApplicationSecret -> IO ()
    forall ty.
    TrafficSecret ty =>
    Context -> Hash -> Cipher -> ty -> IO ()
    setRxState Context
    ctx Hash
    usedHash Cipher
    usedCipher ServerTrafficSecret ApplicationSecret
    serverApplicationSecret0
            SecretTriple ApplicationSecret
    -> IO (SecretTriple ApplicationSecret)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SecretTriple ApplicationSecret
    appKey

        calcSharedKey :: IO ByteString
    calcSharedKey = do
            KeyShareEntry
    serverKeyShare <- do
                Maybe KeyShare
    mks <- Context -> TLSSt (Maybe KeyShare) -> IO (Maybe KeyShare)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe KeyShare)
    getTLS13KeyShare
                case Maybe KeyShare
    mks of
                  Just (KeyShareServerHello KeyShareEntry
    ks) -> KeyShareEntry -> IO KeyShareEntry
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return KeyShareEntry
    ks
                  Just KeyShare
    _                        -> TLSError -> IO KeyShareEntry
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO KeyShareEntry) -> TLSError -> IO KeyShareEntry
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "invalid key_share value", Bool
    True, AlertDescription
    IllegalParameter)
                  Maybe KeyShare
    Nothing                       -> TLSError -> IO KeyShareEntry
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO KeyShareEntry) -> TLSError -> IO KeyShareEntry
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "key exchange not implemented, expected key_share extension", Bool
    True, AlertDescription
    HandshakeFailure)
            let grp :: Group
    grp = KeyShareEntry -> Group
    keyShareEntryGroup KeyShareEntry
    serverKeyShare
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (KeyShareEntry -> Bool
    checkKeyShareKeyLength KeyShareEntry
    serverKeyShare) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "broken key_share", Bool
    True, AlertDescription
    IllegalParameter)
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe Group
    groupSent Maybe Group -> Maybe Group -> Bool
    forall a. Eq a => a -> a -> Bool
    == Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    grp) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "received incompatible group for (EC)DHE", Bool
    True, AlertDescription
    IllegalParameter)
            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
    $ Group -> HandshakeM ()
    setNegotiatedGroup Group
    grp
            Context -> HandshakeM GroupPrivate -> IO GroupPrivate
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM GroupPrivate
    getGroupPrivate IO GroupPrivate -> (GroupPrivate -> IO ByteString) -> IO ByteString
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= KeyShareEntry -> GroupPrivate -> IO ByteString
    fromServerKeyShare KeyShareEntry
    serverKeyShare

        makeEarlySecret :: IO (BaseSecret EarlySecret, Bool)
    makeEarlySecret = do
             Maybe (BaseSecret EarlySecret)
    mEarlySecretPSK <- 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
             case Maybe (BaseSecret EarlySecret)
    mEarlySecretPSK of
               Maybe (BaseSecret EarlySecret)
    Nothing -> (BaseSecret EarlySecret, Bool) -> IO (BaseSecret EarlySecret, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
    initEarlySecret CipherChoice
    choice Maybe ByteString
    forall a. Maybe a
    Nothing, Bool
    False)
               Just earlySecretPSK :: BaseSecret EarlySecret
    earlySecretPSK@(BaseSecret ByteString
    sec) -> do
                   Maybe PreSharedKey
    mSelectedIdentity <- Context -> TLSSt (Maybe PreSharedKey) -> IO (Maybe PreSharedKey)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe PreSharedKey)
    getTLS13PreSharedKey
                   case Maybe PreSharedKey
    mSelectedIdentity of
                     Maybe PreSharedKey
    Nothing                          ->
                         (BaseSecret EarlySecret, Bool) -> IO (BaseSecret EarlySecret, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
    initEarlySecret CipherChoice
    choice Maybe ByteString
    forall a. Maybe a
    Nothing, Bool
    False)
                     Just (PreSharedKeyServerHello Int
    0) -> do
                         Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Int
    B.length ByteString
    sec Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    hashSize) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                             TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "selected cipher is incompatible with selected PSK", Bool
    True, AlertDescription
    IllegalParameter)
                         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
    $ HandshakeMode13 -> HandshakeM ()
    setTLS13HandshakeMode HandshakeMode13
    PreSharedKey
                         (BaseSecret EarlySecret, Bool) -> IO (BaseSecret EarlySecret, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BaseSecret EarlySecret
    earlySecretPSK, Bool
    True)
                     Just PreSharedKey
    _                           -> TLSError -> IO (BaseSecret EarlySecret, Bool)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (BaseSecret EarlySecret, Bool))
    -> TLSError -> IO (BaseSecret EarlySecret, Bool)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "selected identity out of range", Bool
    True, AlertDescription
    IllegalParameter)

        expectEncryptedExtensions :: Handshake13 -> m (Bool, [ExtensionRaw])
    expectEncryptedExtensions (EncryptedExtensions13 [ExtensionRaw]
    eexts) = do
            IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Context -> MessageType -> [ExtensionRaw] -> IO ()
    setALPN Context
    ctx MessageType
    MsgTEncryptedExtensions [ExtensionRaw]
    eexts
            RTT0Status
    st <- Context -> HandshakeM RTT0Status -> m RTT0Status
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM RTT0Status
    getTLS13RTT0Status
            if RTT0Status
    st RTT0Status -> RTT0Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == RTT0Status
    RTT0Sent then
                case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    extensionID_EarlyData [ExtensionRaw]
    eexts of
                  Just ByteString
    _  -> do
                      Context -> HandshakeM () -> m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ HandshakeMode13 -> HandshakeM ()
    setTLS13HandshakeMode HandshakeMode13
    RTT0
                      Context -> HandshakeM () -> m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ RTT0Status -> HandshakeM ()
    setTLS13RTT0Status RTT0Status
    RTT0Accepted
                      (Bool, [ExtensionRaw]) -> m (Bool, [ExtensionRaw])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True,[ExtensionRaw]
    eexts)
                  Maybe ByteString
    Nothing -> do
                      Context -> HandshakeM () -> m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ HandshakeMode13 -> HandshakeM ()
    setTLS13HandshakeMode HandshakeMode13
    RTT0
                      Context -> HandshakeM () -> m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ RTT0Status -> HandshakeM ()
    setTLS13RTT0Status RTT0Status
    RTT0Rejected
                      (Bool, [ExtensionRaw]) -> m (Bool, [ExtensionRaw])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False,[ExtensionRaw]
    eexts)
              else
                (Bool, [ExtensionRaw]) -> m (Bool, [ExtensionRaw])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False,[ExtensionRaw]
    eexts)
        expectEncryptedExtensions Handshake13
    p = String -> Maybe String -> m (Bool, [ExtensionRaw])
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake13 -> String
    forall a. Show a => a -> String
    show Handshake13
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "encrypted extensions")

        expectCertRequest :: Handshake13 -> RecvHandshake13M m ()
    expectCertRequest (CertRequest13 ByteString
    token [ExtensionRaw]
    exts) = do
            Context -> ByteString -> [ExtensionRaw] -> RecvHandshake13M m ()
    forall (m :: * -> *).
    MonadIO m =>
    Context -> ByteString -> [ExtensionRaw] -> m ()
    processCertRequest13 Context
    ctx ByteString
    token [ExtensionRaw]
    exts
            Context
    -> (Handshake13 -> RecvHandshake13M m ()) -> RecvHandshake13M m ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (Handshake13 -> RecvHandshake13M m a) -> RecvHandshake13M m a
    recvHandshake13 Context
    ctx Handshake13 -> RecvHandshake13M m ()
    forall {m :: * -> *}.
    MonadIO m =>
    Handshake13 -> RecvHandshake13M m ()
    expectCertAndVerify

        expectCertRequest Handshake13
    other = do
            Context -> HandshakeM () -> RecvHandshake13M m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> RecvHandshake13M m ())
    -> HandshakeM () -> RecvHandshake13M m ()
    forall a b. (a -> b) -> a -> b
    $ do
                Maybe ByteString -> HandshakeM ()
    setCertReqToken   Maybe ByteString
    forall a. Maybe a
    Nothing
                Maybe CertReqCBdata -> HandshakeM ()
    setCertReqCBdata  Maybe CertReqCBdata
    forall a. Maybe a
    Nothing
                -- setCertReqSigAlgsCert Nothing
            Handshake13 -> RecvHandshake13M m ()
    forall {m :: * -> *}.
    MonadIO m =>
    Handshake13 -> RecvHandshake13M m ()
    expectCertAndVerify Handshake13
    other

        expectCertAndVerify :: Handshake13 -> RecvHandshake13M m ()
    expectCertAndVerify (Certificate13 ByteString
    _ CertificateChain
    cc [[ExtensionRaw]]
    _) = do
            RecvState IO
    _ <- IO (RecvState IO) -> RecvHandshake13M m (RecvState IO)
    forall a. IO a -> RecvHandshake13M m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (RecvState IO) -> RecvHandshake13M m (RecvState IO))
    -> IO (RecvState IO) -> RecvHandshake13M m (RecvState IO)
    forall a b. (a -> b) -> a -> b
    $ ClientParams -> Context -> Handshake -> IO (RecvState IO)
    processCertificate ClientParams
    cparams Context
    ctx (CertificateChain -> Handshake
    Certificates CertificateChain
    cc)
            let pubkey :: PubKey
    pubkey = Certificate -> PubKey
    certPubKey (Certificate -> PubKey) -> Certificate -> PubKey
    forall a b. (a -> b) -> a -> b
    $ SignedExact Certificate -> Certificate
    getCertificate (SignedExact Certificate -> Certificate)
    -> SignedExact Certificate -> Certificate
    forall a b. (a -> b) -> a -> b
    $ CertificateChain -> SignedExact Certificate
    getCertificateChainLeaf CertificateChain
    cc
            Version
    ver <- IO Version -> RecvHandshake13M m Version
    forall a. IO a -> RecvHandshake13M m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Version -> RecvHandshake13M m Version)
    -> IO Version -> RecvHandshake13M m Version
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
            Version -> PubKey -> RecvHandshake13M m ()
    forall (m :: * -> *). MonadIO m => Version -> PubKey -> m ()
    checkDigitalSignatureKey Version
    ver PubKey
    pubkey
            Context -> HandshakeM () -> RecvHandshake13M m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> RecvHandshake13M m ())
    -> HandshakeM () -> RecvHandshake13M m ()
    forall a b. (a -> b) -> a -> b
    $ PubKey -> HandshakeM ()
    setPublicKey PubKey
    pubkey
            Context
    -> (ByteString -> Handshake13 -> RecvHandshake13M m ())
    -> RecvHandshake13M m ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Context
    -> (ByteString -> Handshake13 -> RecvHandshake13M m a)
    -> RecvHandshake13M m a
    recvHandshake13hash Context
    ctx ((ByteString -> Handshake13 -> RecvHandshake13M m ())
     -> RecvHandshake13M m ())
    -> (ByteString -> Handshake13 -> RecvHandshake13M m ())
    -> RecvHandshake13M m ()
    forall a b. (a -> b) -> a -> b
    $ PubKey -> ByteString -> Handshake13 -> RecvHandshake13M m ()
    forall {m :: * -> *}.
    MonadIO m =>
    PubKey -> ByteString -> Handshake13 -> m ()
    expectCertVerify PubKey
    pubkey
        expectCertAndVerify Handshake13
    p = String -> Maybe String -> RecvHandshake13M m ()
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake13 -> String
    forall a. Show a => a -> String
    show Handshake13
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "server certificate")

        expectCertVerify :: PubKey -> ByteString -> Handshake13 -> m ()
    expectCertVerify PubKey
    pubkey ByteString
    hChSc (CertVerify13 HashAndSignatureAlgorithm
    sigAlg ByteString
    sig) = do
            Bool
    ok <- Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> ByteString
    -> m Bool
    forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> ByteString
    -> m Bool
    checkCertVerify Context
    ctx PubKey
    pubkey HashAndSignatureAlgorithm
    sigAlg ByteString
    sig ByteString
    hChSc
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    ok (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> m ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    decryptError String
    "cannot verify CertificateVerify"
        expectCertVerify PubKey
    _ ByteString
    _ Handshake13
    p = String -> Maybe String -> m ()
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake13 -> String
    forall a. Show a => a -> String
    show Handshake13
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "certificate verify")

        expectFinished :: ServerTrafficSecret a -> ByteString -> Handshake13 -> m ()
    expectFinished (ServerTrafficSecret ByteString
    baseKey) ByteString
    hashValue (Finished13 ByteString
    verifyData) =
            Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()
    checkFinished Context
    ctx Hash
    usedHash ByteString
    baseKey ByteString
    hashValue ByteString
    verifyData
        expectFinished ServerTrafficSecret a
    _ ByteString
    _ Handshake13
    p = String -> Maybe String -> m ()
    forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
    unexpected (Handshake13 -> String
    forall a. Show a => a -> String
    show Handshake13
    p) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "server finished")

        setResumptionSecret :: BaseSecret ApplicationSecret -> IO ()
    setResumptionSecret BaseSecret ApplicationSecret
    applicationSecret = do
            BaseSecret ResumptionSecret
    resumptionSecret <- Context
    -> CipherChoice
    -> BaseSecret ApplicationSecret
    -> IO (BaseSecret ResumptionSecret)
    calculateResumptionSecret Context
    ctx CipherChoice
    choice BaseSecret ApplicationSecret
    applicationSecret
            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 ResumptionSecret -> HandshakeM ()
    setTLS13ResumptionSecret BaseSecret ResumptionSecret
    resumptionSecret

    processCertRequest13 :: MonadIO m => Context -> CertReqContext -> [ExtensionRaw] -> m ()
    processCertRequest13 :: forall (m :: * -> *).
    MonadIO m =>
    Context -> ByteString -> [ExtensionRaw] -> m ()
    processCertRequest13 Context
    ctx ByteString
    token [ExtensionRaw]
    exts = do
        let hsextID :: ExtensionID
    hsextID = ExtensionID
    extensionID_SignatureAlgorithms
            -- caextID = extensionID_SignatureAlgorithmsCert
        [DistinguishedName]
    dNames <- m [DistinguishedName]
    canames
        -- The @signature_algorithms@ extension is mandatory.
        Maybe [HashAndSignatureAlgorithm]
    hsAlgs <- ExtensionID
    -> (SignatureAlgorithms -> Maybe [HashAndSignatureAlgorithm])
    -> m (Maybe [HashAndSignatureAlgorithm])
    forall {m :: * -> *} {t} {a}.
    (Extension t, MonadIO m) =>
    ExtensionID -> (t -> Maybe a) -> m (Maybe a)
    extalgs ExtensionID
    hsextID SignatureAlgorithms -> Maybe [HashAndSignatureAlgorithm]
    unsighash
        [CertificateType]
    cTypes <- case Maybe [HashAndSignatureAlgorithm]
    hsAlgs of
            Just [HashAndSignatureAlgorithm]
    as ->
                let validAs :: [HashAndSignatureAlgorithm]
    validAs = (HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm]
    forall a. (a -> Bool) -> [a] -> [a]
    filter HashAndSignatureAlgorithm -> Bool
    isHashSignatureValid13 [HashAndSignatureAlgorithm]
    as
                 in [CertificateType] -> m [CertificateType]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CertificateType] -> m [CertificateType])
    -> [CertificateType] -> m [CertificateType]
    forall a b. (a -> b) -> a -> b
    $ Context -> [HashAndSignatureAlgorithm] -> [CertificateType]
    sigAlgsToCertTypes Context
    ctx [HashAndSignatureAlgorithm]
    validAs
            Maybe [HashAndSignatureAlgorithm]
    Nothing -> TLSError -> m [CertificateType]
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m [CertificateType])
    -> TLSError -> m [CertificateType]
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                            ( String
    "invalid certificate request"
                            , Bool
    True
                            , AlertDescription
    HandshakeFailure )
        -- Unused:
        -- caAlgs <- extalgs caextID uncertsig
        Context -> HandshakeM () -> m ()
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM () -> m ()) -> HandshakeM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe ByteString -> HandshakeM ()
    setCertReqToken  (Maybe ByteString -> HandshakeM ())
    -> Maybe ByteString -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    token
            Maybe CertReqCBdata -> HandshakeM ()
    setCertReqCBdata (Maybe CertReqCBdata -> HandshakeM ())
    -> Maybe CertReqCBdata -> HandshakeM ()
    forall a b. (a -> b) -> a -> b
    $ CertReqCBdata -> Maybe CertReqCBdata
    forall a. a -> Maybe a
    Just ([CertificateType]
    cTypes, Maybe [HashAndSignatureAlgorithm]
    hsAlgs, [DistinguishedName]
    dNames)
            -- setCertReqSigAlgsCert caAlgs
      where
        canames :: m [DistinguishedName]
    canames = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup
                       ExtensionID
    extensionID_CertificateAuthorities [ExtensionRaw]
    exts of
            Maybe ByteString
    Nothing   -> [DistinguishedName] -> m [DistinguishedName]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            Just  ByteString
    ext -> case MessageType -> ByteString -> Maybe CertificateAuthorities
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTCertificateRequest ByteString
    ext of
                             Just (CertificateAuthorities [DistinguishedName]
    names) -> [DistinguishedName] -> m [DistinguishedName]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DistinguishedName]
    names
                             Maybe CertificateAuthorities
    _ -> TLSError -> m [DistinguishedName]
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m [DistinguishedName])
    -> TLSError -> m [DistinguishedName]
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                                      ( String
    "invalid certificate request"
                                      , Bool
    True
                                      , AlertDescription
    HandshakeFailure )
        extalgs :: ExtensionID -> (t -> Maybe a) -> m (Maybe a)
    extalgs ExtensionID
    extID t -> Maybe a
    decons = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    extID [ExtensionRaw]
    exts of
            Maybe ByteString
    Nothing   -> Maybe a -> m (Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
            Just  ByteString
    ext -> case MessageType -> ByteString -> Maybe t
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    MsgTCertificateRequest ByteString
    ext of
                             Just t
    e
                               -> Maybe a -> m (Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return    (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ t -> Maybe a
    decons t
    e
                             Maybe t
    _ -> TLSError -> m (Maybe a)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> m (Maybe a)) -> TLSError -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                                      ( String
    "invalid certificate request"
                                      , Bool
    True
                                      , AlertDescription
    HandshakeFailure )
        unsighash :: SignatureAlgorithms
                  -> Maybe [HashAndSignatureAlgorithm]
        unsighash :: SignatureAlgorithms -> Maybe [HashAndSignatureAlgorithm]
    unsighash (SignatureAlgorithms [HashAndSignatureAlgorithm]
    a) = [HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm]
    forall a. a -> Maybe a
    Just [HashAndSignatureAlgorithm]
    a
        {- Unused for now
        uncertsig :: SignatureAlgorithmsCert
                  -> Maybe [HashAndSignatureAlgorithm]
        uncertsig (SignatureAlgorithmsCert a) = Just a
        -}

    sendClientFlight13 :: ClientParams -> Context -> Hash -> ClientTrafficSecret a -> IO ()
    sendClientFlight13 :: forall a.
    ClientParams -> Context -> Hash -> ClientTrafficSecret a -> IO ()
    sendClientFlight13 ClientParams
    cparams Context
    ctx Hash
    usedHash (ClientTrafficSecret ByteString
    baseKey) = do
        Maybe CertificateChain
    chain <- ClientParams -> Context -> IO (Maybe CertificateChain)
    clientChain ClientParams
    cparams Context
    ctx
        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
    $ do
            case Maybe CertificateChain
    chain of
                Maybe CertificateChain
    Nothing -> () -> PacketFlightM b ()
    forall a. a -> PacketFlightM b a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just CertificateChain
    cc -> Context
    -> HandshakeM (Maybe ByteString)
    -> PacketFlightM b (Maybe ByteString)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM (Maybe ByteString)
    getCertReqToken PacketFlightM b (Maybe ByteString)
    -> (Maybe ByteString -> PacketFlightM b ()) -> PacketFlightM b ()
    forall a b.
    PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CertificateChain -> Maybe ByteString -> PacketFlightM b ()
    forall {b}.
    Monoid b =>
    CertificateChain -> Maybe ByteString -> PacketFlightM b ()
    sendClientData13 CertificateChain
    cc
            Handshake13
    rawFinished <- Context -> Hash -> ByteString -> PacketFlightM b Handshake13
    forall (m :: * -> *).
    MonadIO m =>
    Context -> Hash -> ByteString -> m Handshake13
    makeFinished Context
    ctx Hash
    usedHash ByteString
    baseKey
            Context -> Packet13 -> PacketFlightM b ()
    forall b. Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 Context
    ctx (Packet13 -> PacketFlightM b ()) -> Packet13 -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> Packet13
    Handshake13 [Handshake13
    rawFinished]
      where
        sendClientData13 :: CertificateChain -> Maybe ByteString -> PacketFlightM b ()
    sendClientData13 CertificateChain
    chain (Just ByteString
    token) = do
            let (CertificateChain [SignedExact Certificate]
    certs) = CertificateChain
    chain
                certExts :: [[a]]
    certExts = Int -> [a] -> [[a]]
    forall a. Int -> a -> [a]
    replicate ([SignedExact Certificate] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SignedExact Certificate]
    certs) []
                cHashSigs :: [HashAndSignatureAlgorithm]
    cHashSigs = (HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm]
    forall a. (a -> Bool) -> [a] -> [a]
    filter HashAndSignatureAlgorithm -> Bool
    isHashSignatureValid13 ([HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm])
    -> [HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
    -> Supported -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx
            Context -> Packet13 -> PacketFlightM b ()
    forall b. Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 Context
    ctx (Packet13 -> PacketFlightM b ()) -> Packet13 -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> Packet13
    Handshake13 [ByteString -> CertificateChain -> [[ExtensionRaw]] -> Handshake13
    Certificate13 ByteString
    token CertificateChain
    chain [[ExtensionRaw]]
    forall {a}. [[a]]
    certExts]
            case [SignedExact Certificate]
    certs of
                [] -> () -> PacketFlightM b ()
    forall a. a -> PacketFlightM b a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                [SignedExact Certificate]
    _  -> do
                      ByteString
    hChSc      <- Context -> PacketFlightM b ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
                      PubKey
    pubKey     <- Context -> PacketFlightM b PubKey
    forall (m :: * -> *). MonadIO m => Context -> m PubKey
    getLocalPublicKey Context
    ctx
                      HashAndSignatureAlgorithm
    sigAlg     <- IO HashAndSignatureAlgorithm
    -> PacketFlightM b HashAndSignatureAlgorithm
    forall a. IO a -> PacketFlightM b a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO HashAndSignatureAlgorithm
     -> PacketFlightM b HashAndSignatureAlgorithm)
    -> IO HashAndSignatureAlgorithm
    -> PacketFlightM b HashAndSignatureAlgorithm
    forall a b. (a -> b) -> a -> b
    $ Context
    -> (PubKey -> HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm]
    -> PubKey
    -> IO HashAndSignatureAlgorithm
    getLocalHashSigAlg Context
    ctx PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible13 [HashAndSignatureAlgorithm]
    cHashSigs PubKey
    pubKey
                      Handshake13
    vfy        <- Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> PacketFlightM b Handshake13
    forall (m :: * -> *).
    MonadIO m =>
    Context
    -> PubKey
    -> HashAndSignatureAlgorithm
    -> ByteString
    -> m Handshake13
    makeCertVerify Context
    ctx PubKey
    pubKey HashAndSignatureAlgorithm
    sigAlg ByteString
    hChSc
                      Context -> Packet13 -> PacketFlightM b ()
    forall b. Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 Context
    ctx (Packet13 -> PacketFlightM b ()) -> Packet13 -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake13] -> Packet13
    Handshake13 [Handshake13
    vfy]
        --
        sendClientData13 CertificateChain
    _ Maybe ByteString
    _ =
            TLSError -> PacketFlightM b ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> PacketFlightM b ()) -> TLSError -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol
                ( String
    "missing TLS 1.3 certificate request context token"
                , Bool
    True
                , AlertDescription
    InternalError
                )

    setALPN :: Context -> MessageType -> [ExtensionRaw] -> IO ()
    setALPN :: Context -> MessageType -> [ExtensionRaw] -> IO ()
    setALPN Context
    ctx MessageType
    msgt [ExtensionRaw]
    exts = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    extensionID_ApplicationLayerProtocolNegotiation [ExtensionRaw]
    exts Maybe ByteString
    -> (ByteString -> Maybe ApplicationLayerProtocolNegotiation)
    -> Maybe ApplicationLayerProtocolNegotiation
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MessageType
    -> ByteString -> Maybe ApplicationLayerProtocolNegotiation
    forall a. Extension a => MessageType -> ByteString -> Maybe a
    extensionDecode MessageType
    msgt of
        Just (ApplicationLayerProtocolNegotiation [ByteString
    proto]) -> Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe [ByteString]
    mprotos <- TLSSt (Maybe [ByteString])
    getClientALPNSuggest
            case Maybe [ByteString]
    mprotos of
                Just [ByteString]
    protos -> Bool -> TLSSt () -> TLSSt ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    proto ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString]
    protos) (TLSSt () -> TLSSt ()) -> TLSSt () -> TLSSt ()
    forall a b. (a -> b) -> a -> b
    $ do
                    Bool -> TLSSt ()
    setExtensionALPN Bool
    True
                    ByteString -> TLSSt ()
    setNegotiatedProtocol ByteString
    proto
                Maybe [ByteString]
    _ -> () -> TLSSt ()
    forall a. a -> TLSSt a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Maybe ApplicationLayerProtocolNegotiation
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    postHandshakeAuthClientWith :: ClientParams -> Context -> Handshake13 -> IO ()
    postHandshakeAuthClientWith :: ClientParams -> Context -> Handshake13 -> IO ()
    postHandshakeAuthClientWith ClientParams
    cparams Context
    ctx h :: Handshake13
    h@(CertRequest13 ByteString
    certReqCtx [ExtensionRaw]
    exts) =
        IO (Saved (Maybe HandshakeState))
    -> (Saved (Maybe HandshakeState)
        -> IO (Saved (Maybe HandshakeState)))
    -> (Saved (Maybe HandshakeState) -> IO ())
    -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Context -> IO (Saved (Maybe HandshakeState))
    saveHState Context
    ctx) (Context
    -> Saved (Maybe HandshakeState)
    -> IO (Saved (Maybe HandshakeState))
    restoreHState Context
    ctx) ((Saved (Maybe HandshakeState) -> IO ()) -> IO ())
    -> (Saved (Maybe HandshakeState) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Saved (Maybe HandshakeState)
    _ -> do
            Context -> Handshake13 -> IO ()
    processHandshake13 Context
    ctx Handshake13
    h
            Context -> ByteString -> [ExtensionRaw] -> IO ()
    forall (m :: * -> *).
    MonadIO m =>
    Context -> ByteString -> [ExtensionRaw] -> m ()
    processCertRequest13 Context
    ctx ByteString
    certReqCtx [ExtensionRaw]
    exts
            (Hash
    usedHash, Cipher
    _, CryptLevel
    level, ByteString
    applicationSecretN) <- Context -> IO (Hash, Cipher, CryptLevel, ByteString)
    getTxState Context
    ctx
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (CryptLevel
    level CryptLevel -> CryptLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == CryptLevel
    CryptApplicationSecret) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unexpected post-handshake authentication request", Bool
    True, AlertDescription
    UnexpectedMessage)
            ClientParams -> Context -> Hash -> ClientTrafficSecret Any -> IO ()
    forall a.
    ClientParams -> Context -> Hash -> ClientTrafficSecret a -> IO ()
    sendClientFlight13 ClientParams
    cparams Context
    ctx Hash
    usedHash (ByteString -> ClientTrafficSecret Any
    forall a. ByteString -> ClientTrafficSecret a
    ClientTrafficSecret ByteString
    applicationSecretN)

    postHandshakeAuthClientWith ClientParams
    _ Context
    _ Handshake13
    _ =
        TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    "unexpected handshake message received in postHandshakeAuthClientWith", Bool
    True, AlertDescription
    UnexpectedMessage)

    contextSync :: Context -> ClientState -> IO ()
    contextSync :: Context -> ClientState -> IO ()
    contextSync Context
    ctx ClientState
    ctl = case Context -> HandshakeSync
    ctxHandshakeSync Context
    ctx of
        HandshakeSync Context -> ClientState -> IO ()
    sync Context -> ServerState -> IO ()
    _ -> Context -> ClientState -> IO ()
    sync Context
    ctx ClientState
    ctl