    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Network.TLS.Handshake.Client.TLS12 (
        recvServerFirstFlight12,
        sendClientSecondFlight12,
        recvServerSecondFlight12,
    ) where

    import Control.Monad.State.Strict
    import qualified Data.ByteString as B

    import Network.TLS.Cipher
    import Network.TLS.Context.Internal
    import Network.TLS.Crypto
    import Network.TLS.Handshake.Client.Common
    import Network.TLS.Handshake.Common
    import Network.TLS.Handshake.Key
    import Network.TLS.Handshake.Signature
    import Network.TLS.Handshake.State
    import Network.TLS.IO
    import Network.TLS.Imports
    import Network.TLS.Packet hiding (getExtensions, getSession)
    import Network.TLS.Parameters
    import Network.TLS.Session
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Types
    import Network.TLS.Util (catchException)
    import Network.TLS.Wire
    import Network.TLS.X509 hiding (Certificate)

    ----------------------------------------------------------------

    recvServerFirstFlight12 :: ClientParams -> Context -> [Handshake] -> IO ()
    recvServerFirstFlight12 :: ClientParams -> Context -> [Handshake] -> IO ()
    recvServerFirstFlight12 ClientParams
    cparams Context
    ctx [Handshake]
    hs = do
        resuming <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS12SessionResuming
        if resuming
            then recvNSTandCCSandFinished ctx
            else do
                let st = (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
    RecvStateHandshake (ClientParams -> Context -> Handshake -> IO (RecvState IO)
    expectCertificate ClientParams
    cparams Context
    ctx)
                runRecvStateHS ctx st hs

    expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
    expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
    expectCertificate ClientParams
    cparams Context
    ctx (Certificate (TLSCertificateChain CertificateChain
    certs)) = 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
    $ CertificateChain -> TLSSt ()
    setServerCertificateChain CertificateChain
    certs
        ClientParams -> Context -> CertificateChain -> IO ()
    doCertificate ClientParams
    cparams Context
    ctx CertificateChain
    certs
        Context -> Role -> CertificateChain -> IO ()
    processCertificate Context
    ctx Role
    ClientRole CertificateChain
    certs
        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)
    expectServerKeyExchange Context
    ctx)
    expectCertificate ClientParams
    _ Context
    ctx Handshake
    p = Context -> Handshake -> IO (RecvState IO)
    expectServerKeyExchange Context
    ctx Handshake
    p

    expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
    expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
    expectServerKeyExchange Context
    ctx (ServerKeyXchg ServerKeyXchgAlgorithmData
    origSkx) = do
        Context -> ServerKeyXchgAlgorithmData -> IO ()
    doServerKeyExchange Context
    ctx 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)
    expectCertificateRequest Context
    ctx)
    expectServerKeyExchange Context
    ctx Handshake
    p = Context -> Handshake -> IO (RecvState IO)
    expectCertificateRequest Context
    ctx Handshake
    p

    expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
    expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
    expectCertificateRequest Context
    ctx (CertRequest [CertificateType]
    cTypesSent [HashAndSignatureAlgorithm]
    sigAlgs [DistinguishedName]
    dNames) = do
        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, [HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm]
    forall a. a -> Maybe a
    Just [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)
    expectServerHelloDone Context
    ctx)
    expectCertificateRequest 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)
    expectServerHelloDone Context
    ctx Handshake
    p

    expectServerHelloDone :: Context -> Handshake -> IO (RecvState m)
    expectServerHelloDone :: forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
    expectServerHelloDone 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
    expectServerHelloDone Context
    _ Handshake
    p = [Char] -> Maybe [Char] -> IO (RecvState m)
    forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
    unexpected (Handshake -> [Char]
    forall a. Show a => a -> [Char]
    show Handshake
    p) ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    "server hello data")

    ----------------------------------------------------------------

    sendClientSecondFlight12 :: ClientParams -> Context -> IO ()
    sendClientSecondFlight12 :: ClientParams -> Context -> IO ()
    sendClientSecondFlight12 ClientParams
    cparams Context
    ctx = do
        sessionResuming <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS12SessionResuming
        if sessionResuming
            then sendCCSandFinished ctx ClientRole
            else do
                sendClientCCC cparams ctx
                sendCCSandFinished ctx ClientRole

    recvServerSecondFlight12 :: ClientParams -> Context -> IO ()
    recvServerSecondFlight12 :: ClientParams -> Context -> IO ()
    recvServerSecondFlight12 ClientParams
    cparams Context
    ctx = do
        sessionResuming <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS12SessionResuming
        unless sessionResuming $ recvNSTandCCSandFinished ctx
        mticket <- usingState_ ctx getTLS12SessionTicket
        session <- usingState_ ctx getSession
        let midentity = Maybe Ticket -> Session -> Maybe Ticket
    ticketOrSessionID12 Maybe Ticket
    mticket Session
    session
        case midentity of
            Maybe Ticket
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just Ticket
    identity -> do
                sessionData <- Context -> IO (Maybe SessionData)
    getSessionData Context
    ctx
                void $
                    sessionEstablish
                        (sharedSessionManager $ ctxShared ctx)
                        identity
                        (fromJust sessionData)
        handshakeDone12 ctx
        liftIO $ do
            minfo <- contextGetInformation ctx
            case minfo of
                Maybe Information
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just Information
    info -> ClientHooks -> Information -> IO ()
    onServerFinished (ClientParams -> ClientHooks
    clientHooks ClientParams
    cparams) Information
    info

    recvNSTandCCSandFinished :: Context -> IO ()
    recvNSTandCCSandFinished :: Context -> IO ()
    recvNSTandCCSandFinished Context
    ctx = do
        st <- Maybe Ticket -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Ticket -> Bool) -> IO (Maybe Ticket) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> TLSSt (Maybe Ticket) -> IO (Maybe Ticket)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe Ticket)
    getTLS12SessionTicket
        if st
            then runRecvState ctx $ RecvStateHandshake expectNewSessionTicket
            else do runRecvState ctx $ RecvStatePacket expectChangeCipher
      where
        expectNewSessionTicket :: Handshake -> IO (RecvState IO)
    expectNewSessionTicket (NewSessionTicket Second
    _ Ticket
    ticket) = 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
    $ Ticket -> TLSSt ()
    setTLS12SessionTicket Ticket
    ticket
            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
    RecvStatePacket Packet -> IO (RecvState IO)
    expectChangeCipher
        expectNewSessionTicket Handshake
    p = [Char] -> Maybe [Char] -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
    unexpected (Handshake -> [Char]
    forall a. Show a => a -> [Char]
    show Handshake
    p) ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    "Handshake Finished")

        expectChangeCipher :: Packet -> IO (RecvState IO)
    expectChangeCipher Packet
    ChangeCipherSpec = do
            Context -> IO ()
    enableMyRecordLimit Context
    ctx
            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)) -> RecvState IO)
    -> (Handshake -> IO (RecvState IO)) -> RecvState IO
    forall a b. (a -> b) -> a -> b
    $ Context -> Handshake -> IO (RecvState IO)
    expectFinished Context
    ctx
        expectChangeCipher Packet
    p = [Char] -> Maybe [Char] -> IO (RecvState IO)
    forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
    unexpected (Packet -> [Char]
    forall a. Show a => a -> [Char]
    show Packet
    p) ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    "change cipher")

    ----------------------------------------------------------------

    -- | 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]
    sendClientCCC :: ClientParams -> Context -> IO ()
    sendClientCCC :: ClientParams -> Context -> IO ()
    sendClientCCC ClientParams
    cparams Context
    ctx = do
        ClientParams -> Context -> IO ()
    sendCertificate ClientParams
    cparams Context
    ctx
        ClientParams -> Context -> IO ()
    sendClientKeyXchg ClientParams
    cparams Context
    ctx
        Context -> IO ()
    sendCertificateVerify Context
    ctx

    ----------------------------------------------------------------

    sendCertificate :: ClientParams -> Context -> IO ()
    sendCertificate :: ClientParams -> Context -> IO ()
    sendCertificate ClientParams
    cparams Context
    ctx = 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 ()
    sendPacket12 Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Handshake] -> Packet
    Handshake [TLSCertificateChain -> Handshake
    Certificate (CertificateChain -> TLSCertificateChain
    TLSCertificateChain CertificateChain
    cc)]

    ----------------------------------------------------------------

    sendClientKeyXchg :: ClientParams -> Context -> IO ()
    sendClientKeyXchg :: ClientParams -> Context -> IO ()
    sendClientKeyXchg ClientParams
    cparams Context
    ctx = do
        cipher <- Context -> HandshakeM Cipher -> IO Cipher
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM Cipher
    getPendingCipher
        (ckx, setMainSec) <- case cipherKeyExchange cipher of
            CipherKeyExchangeType
    CipherKeyExchange_RSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_RSA Context
    ctx
            CipherKeyExchangeType
    CipherKeyExchange_DHE_RSA -> ClientParams
    -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_DHE ClientParams
    cparams Context
    ctx
            CipherKeyExchangeType
    CipherKeyExchange_DHE_DSA -> ClientParams
    -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_DHE ClientParams
    cparams Context
    ctx
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_ECDHE Context
    ctx
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_ECDHE Context
    ctx
            CipherKeyExchangeType
    _ ->
                TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket))
    -> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    forall a b. (a -> b) -> a -> b
    $
                    [Char] -> AlertDescription -> TLSError
    Error_Protocol [Char]
    "client key exchange unsupported type" AlertDescription
    HandshakeFailure
        sendPacket12 ctx $ Handshake [ClientKeyXchg ckx]
        mainSecret <- usingHState ctx setMainSec
        logKey ctx (MainSecret mainSecret)

    --------------------------------

    getCKX_RSA
        :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_RSA :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_RSA Context
    ctx = do
        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
        (xver, prerand) <- usingState_ ctx $ (,) <$> getVersion <*> genRandom 46

        let preMain = Version -> Ticket -> Ticket
    encodePreMainSecret Version
    clientVersion Ticket
    prerand
            setMainSec = Version -> Role -> Ticket -> HandshakeM Ticket
    forall preMain.
    ByteArrayAccess preMain =>
    Version -> Role -> preMain -> HandshakeM Ticket
    setMainSecretFromPre Version
    xver Role
    ClientRole Ticket
    preMain
        encryptedPreMain <- 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.
            e <- encryptRSA ctx preMain
            let extra = Word16 -> Ticket
    encodeWord16 (Word16 -> Ticket) -> Word16 -> Ticket
    forall a b. (a -> b) -> a -> b
    $ Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ Ticket -> Int
    B.length Ticket
    e
            return $ extra `B.append` e
        return (CKX_RSA encryptedPreMain, setMainSec)

    --------------------------------

    getCKX_DHE
        :: ClientParams
        -> Context
        -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_DHE :: ClientParams
    -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_DHE ClientParams
    cparams Context
    ctx = do
        xver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        serverParams <- usingHState ctx getServerDHParams

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

        unless (maybe False (isSupportedGroup ctx) ffGroup) $ do
            groupUsage <-
                onCustomFFDHEGroup (clientHooks cparams) params srvpub
                    `catchException` throwMiscErrorOnException "custom group callback failed"
            case 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
    $
                        [Char] -> AlertDescription -> TLSError
    Error_Protocol [Char]
    "FFDHE group is not secure enough" AlertDescription
    InsufficientSecurity
                GroupUsageUnsupported [Char]
    reason ->
                    TLSError -> IO ()
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        [Char] -> AlertDescription -> TLSError
    Error_Protocol ([Char]
    "unsupported FFDHE group: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    reason) 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
    $ [Char] -> AlertDescription -> TLSError
    Error_Protocol [Char]
    "invalid server public key" 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.
        (clientDHPub, preMain) <-
            case ffGroup of
                Maybe Group
    Nothing -> do
                    (clientDHPriv, clientDHPub) <- Context -> DHParams -> IO (DHPrivate, DHPublic)
    generateDHE Context
    ctx DHParams
    params
                    let preMain = DHParams -> DHPrivate -> DHPublic -> DHKey
    dhGetShared DHParams
    params DHPrivate
    clientDHPriv DHPublic
    srvpub
                    return (clientDHPub, preMain)
                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 ()
    setSupportedGroup Group
    grp
                    dhePair <- Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
    generateFFDHEShared Context
    ctx Group
    grp DHPublic
    srvpub
                    case 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
    $
                                [Char] -> AlertDescription -> TLSError
    Error_Protocol ([Char]
    "invalid server " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Group -> [Char]
    forall a. Show a => a -> [Char]
    show Group
    grp [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " public key") 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 setMainSec = Version -> Role -> DHKey -> HandshakeM Ticket
    forall preMain.
    ByteArrayAccess preMain =>
    Version -> Role -> preMain -> HandshakeM Ticket
    setMainSecretFromPre Version
    xver Role
    ClientRole DHKey
    preMain
        return (CKX_DH clientDHPub, setMainSec)

    --------------------------------

    getCKX_ECDHE
        :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
    getCKX_ECDHE :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    getCKX_ECDHE Context
    ctx = do
        ServerECDHParams grp srvpub <- Context -> HandshakeM ServerECDHParams -> IO ServerECDHParams
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx HandshakeM ServerECDHParams
    getServerECDHParams
        checkSupportedGroup ctx grp
        usingHState ctx $ setSupportedGroup grp
        ecdhePair <- generateECDHEShared ctx srvpub
        case ecdhePair of
            Maybe (GroupPublic, GroupKey)
    Nothing ->
                TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket))
    -> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
    forall a b. (a -> b) -> a -> b
    $
                    [Char] -> AlertDescription -> TLSError
    Error_Protocol ([Char]
    "invalid server " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Group -> [Char]
    forall a. Show a => a -> [Char]
    show Group
    grp [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " public key") AlertDescription
    IllegalParameter
            Just (GroupPublic
    clipub, GroupKey
    preMain) -> do
                xver <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
                let setMainSec = Version -> Role -> GroupKey -> HandshakeM Ticket
    forall preMain.
    ByteArrayAccess preMain =>
    Version -> Role -> preMain -> HandshakeM Ticket
    setMainSecretFromPre Version
    xver Role
    ClientRole GroupKey
    preMain
                return (CKX_ECDH $ encodeGroupPublic clipub, setMainSec)

    ----------------------------------------------------------------

    -- 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 :: Context -> IO ()
    sendCertificateVerify :: Context -> IO ()
    sendCertificateVerify Context
    ctx = do
        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.
        --
        certSent <- usingHState ctx getClientCertSent
        when certSent $ do
            pubKey <- getLocalPublicKey ctx
            mhashSig <-
                let cHashSigs = Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
    -> Supported -> [HashAndSignatureAlgorithm]
    forall a b. (a -> b) -> a -> b
    $ Context -> Supported
    ctxSupported Context
    ctx
                 in getLocalHashSigAlg ctx signatureCompatible cHashSigs pubKey
            -- Fetch all handshake messages up to now.
            msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
            sigDig <- createCertificateVerify ctx ver pubKey mhashSig msgs
            sendPacket12 ctx $ Handshake [CertVerify sigDig]