    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}

    module Network.TLS.Handshake.Server.ServerHello12 (
        sendServerHello12,
    ) where

    import Network.TLS.Cipher
    import Network.TLS.Compression
    import Network.TLS.Context.Internal
    import Network.TLS.Credentials
    import Network.TLS.Crypto
    import Network.TLS.Extension
    import Network.TLS.Handshake.Certificate
    import Network.TLS.Handshake.Common
    import Network.TLS.Handshake.Key
    import Network.TLS.Handshake.Random
    import Network.TLS.Handshake.Server.Common
    import Network.TLS.Handshake.Signature
    import Network.TLS.Handshake.State
    import Network.TLS.IO
    import Network.TLS.Imports
    import Network.TLS.Parameters
    import Network.TLS.Session
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Types
    import Network.TLS.X509 hiding (Certificate)

    sendServerHello12
        :: ServerParams
        -> Context
        -> (Cipher, Maybe Credential)
        -> CH
        -> IO (Maybe SessionData)
    sendServerHello12 :: ServerParams
    -> Context
    -> (Cipher, Maybe Credential)
    -> CH
    -> IO (Maybe SessionData)
    sendServerHello12 ServerParams
    sparams Context
    ctx (Cipher
    usedCipher, Maybe Credential
    mcred) ch :: CH
    ch@CH{[CipherId]
    [ExtensionRaw]
    Session
    chSession :: Session
    chCiphers :: [CipherId]
    chExtensions :: [ExtensionRaw]
    chExtensions :: CH -> [ExtensionRaw]
    chCiphers :: CH -> [CipherId]
    chSession :: CH -> Session
    ..} = do
        resumeSessionData <- Context -> CH -> IO (Maybe SessionData)
    recoverSessionData Context
    ctx CH
    ch
        case resumeSessionData of
            Maybe SessionData
    Nothing -> do
                serverSession <- Context -> IO Session
    newSession Context
    ctx
                usingState_ ctx $ setSession serverSession
                serverhello <-
                    makeServerHello sparams ctx usedCipher mcred chExtensions serverSession
                build <- sendServerFirstFlight sparams ctx usedCipher mcred chExtensions
                let ff = Handshake
    serverhello Handshake -> [Handshake] -> [Handshake]
    forall a. a -> [a] -> [a]
    : [Handshake] -> [Handshake]
    build [Handshake
    ServerHelloDone]
                sendPacket12 ctx $ Handshake ff
                contextFlush ctx
            Just SessionData
    sessionData -> 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
    $ do
                    Session -> TLSSt ()
    setSession Session
    chSession
                    Bool -> TLSSt ()
    setTLS12SessionResuming Bool
    True
                serverhello <-
                    ServerParams
    -> Context
    -> Cipher
    -> Maybe Credential
    -> [ExtensionRaw]
    -> Session
    -> IO Handshake
    makeServerHello ServerParams
    sparams Context
    ctx Cipher
    usedCipher Maybe Credential
    mcred [ExtensionRaw]
    chExtensions Session
    chSession
                sendPacket12 ctx $ Handshake [serverhello]
                let mainSecret = SessionData -> ByteString
    sessionSecret SessionData
    sessionData
                usingHState ctx $ setMainSecret TLS12 ServerRole mainSecret
                logKey ctx $ MainSecret mainSecret
                sendCCSandFinished ctx ServerRole
        return resumeSessionData

    recoverSessionData :: Context -> CH -> IO (Maybe SessionData)
    recoverSessionData :: Context -> CH -> IO (Maybe SessionData)
    recoverSessionData Context
    ctx CH{[CipherId]
    [ExtensionRaw]
    Session
    chExtensions :: CH -> [ExtensionRaw]
    chCiphers :: CH -> [CipherId]
    chSession :: CH -> Session
    chSession :: Session
    chCiphers :: [CipherId]
    chExtensions :: [ExtensionRaw]
    ..} = do
        serverName <- Context -> TLSSt (Maybe HostName) -> IO (Maybe HostName)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe HostName)
    getClientSNI
        ems <- processExtendedMainSecret ctx TLS12 MsgTClientHello chExtensions
        let mticket =
                ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> Maybe ByteString
    -> (SessionTicket -> Maybe ByteString)
    -> Maybe ByteString
    forall e a.
    Extension e =>
    ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
    lookupAndDecode
                    ExtensionID
    EID_SessionTicket
                    MessageType
    MsgTClientHello
                    [ExtensionRaw]
    chExtensions
                    Maybe ByteString
    forall a. Maybe a
    Nothing
                    (\(SessionTicket ByteString
    ticket) -> ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    ticket)
            midentity = Maybe ByteString -> Session -> Maybe ByteString
    ticketOrSessionID12 Maybe ByteString
    mticket Session
    chSession
        case midentity of
            Maybe ByteString
    Nothing -> Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    forall a. Maybe a
    Nothing
            Just ByteString
    identity -> do
                sd <- SessionManager -> ByteString -> IO (Maybe SessionData)
    sessionResume (Shared -> SessionManager
    sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
    forall a b. (a -> b) -> a -> b
    $ Context -> Shared
    ctxShared Context
    ctx) ByteString
    identity
                validateSession ctx chCiphers serverName ems sd

    validateSession
        :: Context
        -> [CipherId]
        -> Maybe HostName
        -> Bool
        -> Maybe SessionData
        -> IO (Maybe SessionData)
    validateSession :: Context
    -> [CipherId]
    -> Maybe HostName
    -> Bool
    -> Maybe SessionData
    -> IO (Maybe SessionData)
    validateSession Context
    _ [CipherId]
    _ Maybe HostName
    _ Bool
    _ Maybe SessionData
    Nothing = Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    forall a. Maybe a
    Nothing
    validateSession Context
    ctx [CipherId]
    ciphers Maybe HostName
    sni Bool
    ems m :: Maybe SessionData
    m@(Just SessionData
    sd)
        -- SessionData parameters are assumed to match the local server configuration
        -- so we need to compare only to ClientHello inputs.  Abbreviated handshake
        -- uses the same server_name than full handshake so the same
        -- credentials (and thus ciphers) are available.
        | Version
    TLS12 Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    < SessionData -> Version
    sessionVersion SessionData
    sd = Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    forall a. Maybe a
    Nothing -- fixme
        | Word16 -> CipherId
    CipherId (SessionData -> Word16
    sessionCipher SessionData
    sd) CipherId -> [CipherId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [CipherId]
    ciphers =
            TLSError -> IO (Maybe SessionData)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (Maybe SessionData))
    -> TLSError -> IO (Maybe SessionData)
    forall a b. (a -> b) -> a -> b
    $
                HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    "new cipher is diffrent from the old one" AlertDescription
    IllegalParameter
        | Maybe HostName -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe HostName
    sni Bool -> Bool -> Bool
    && SessionData -> Maybe HostName
    sessionClientSNI SessionData
    sd Maybe HostName -> Maybe HostName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe HostName
    sni = do
            Context -> TLSSt () -> IO ()
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt ()
    clearClientSNI
            Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    forall a. Maybe a
    Nothing
        | Bool
    ems Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    emsSession = Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    forall a. Maybe a
    Nothing
        | Bool -> Bool
    not Bool
    ems Bool -> Bool -> Bool
    && Bool
    emsSession =
            let err :: HostName
    err = HostName
    "client resumes an EMS session without EMS"
             in TLSError -> IO (Maybe SessionData)
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO (Maybe SessionData))
    -> TLSError -> IO (Maybe SessionData)
    forall a b. (a -> b) -> a -> b
    $ HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    err AlertDescription
    HandshakeFailure
        | Bool
    otherwise = Maybe SessionData -> IO (Maybe SessionData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SessionData
    m
      where
        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
    sd

    sendServerFirstFlight
        :: ServerParams
        -> Context
        -> Cipher
        -> Maybe Credential
        -> [ExtensionRaw]
        -> IO ([Handshake] -> [Handshake])
    sendServerFirstFlight :: ServerParams
    -> Context
    -> Cipher
    -> Maybe Credential
    -> [ExtensionRaw]
    -> IO ([Handshake] -> [Handshake])
    sendServerFirstFlight ServerParams{Bool
    Int
    [SignedCertificate]
    Maybe DHParams
    Limit
    ServerHooks
    Shared
    Supported
    DebugParams
    serverWantClientCert :: Bool
    serverCACertificates :: [SignedCertificate]
    serverDHEParams :: Maybe DHParams
    serverHooks :: ServerHooks
    serverShared :: Shared
    serverSupported :: Supported
    serverDebug :: DebugParams
    serverEarlyDataSize :: Int
    serverTicketLifetime :: Int
    serverLimit :: Limit
    serverLimit :: ServerParams -> Limit
    serverTicketLifetime :: ServerParams -> Int
    serverEarlyDataSize :: ServerParams -> Int
    serverDebug :: ServerParams -> DebugParams
    serverSupported :: ServerParams -> Supported
    serverShared :: ServerParams -> Shared
    serverHooks :: ServerParams -> ServerHooks
    serverDHEParams :: ServerParams -> Maybe DHParams
    serverCACertificates :: ServerParams -> [SignedCertificate]
    serverWantClientCert :: ServerParams -> Bool
    ..} Context
    ctx Cipher
    usedCipher Maybe Credential
    mcred [ExtensionRaw]
    chExts = do
        let b0 :: a -> a
    b0 = a -> a
    forall a. a -> a
    id
        let cc :: CertificateChain
    cc = case Maybe Credential
    mcred of
                Just (CertificateChain
    srvCerts, PrivKey
    _) -> CertificateChain
    srvCerts
                Maybe Credential
    _ -> [SignedCertificate] -> CertificateChain
    CertificateChain []
        let b1 :: [Handshake] -> [Handshake]
    b1 = [Handshake] -> [Handshake]
    forall a. a -> a
    b0 ([Handshake] -> [Handshake])
    -> ([Handshake] -> [Handshake]) -> [Handshake] -> [Handshake]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TLSCertificateChain -> Handshake
    Certificate (CertificateChain -> TLSCertificateChain
    TLSCertificateChain CertificateChain
    cc) Handshake -> [Handshake] -> [Handshake]
    forall a. a -> [a] -> [a]
    :)
        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
    cc

        -- send server key exchange if needed
        skx <- case Cipher -> CipherKeyExchangeType
    cipherKeyExchange Cipher
    usedCipher of
            CipherKeyExchangeType
    CipherKeyExchange_DH_Anon -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
    forall a. a -> Maybe a
    Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
    -> IO ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO ServerKeyXchgAlgorithmData
    generateSKX_DH_Anon
            CipherKeyExchangeType
    CipherKeyExchange_DHE_RSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
    forall a. a -> Maybe a
    Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
    -> IO ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_DHE KeyExchangeSignatureAlg
    KX_RSA
            CipherKeyExchangeType
    CipherKeyExchange_DHE_DSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
    forall a. a -> Maybe a
    Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
    -> IO ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_DHE KeyExchangeSignatureAlg
    KX_DSA
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_RSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
    forall a. a -> Maybe a
    Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
    -> IO ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_ECDHE KeyExchangeSignatureAlg
    KX_RSA
            CipherKeyExchangeType
    CipherKeyExchange_ECDHE_ECDSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
    forall a. a -> Maybe a
    Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
    -> IO ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_ECDHE KeyExchangeSignatureAlg
    KX_ECDSA
            CipherKeyExchangeType
    _ -> Maybe ServerKeyXchgAlgorithmData
    -> IO (Maybe ServerKeyXchgAlgorithmData)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ServerKeyXchgAlgorithmData
    forall a. Maybe a
    Nothing
        let b2 = case Maybe ServerKeyXchgAlgorithmData
    skx of
                Maybe ServerKeyXchgAlgorithmData
    Nothing -> [Handshake] -> [Handshake]
    b1
                Just ServerKeyXchgAlgorithmData
    kx -> [Handshake] -> [Handshake]
    b1 ([Handshake] -> [Handshake])
    -> ([Handshake] -> [Handshake]) -> [Handshake] -> [Handshake]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ServerKeyXchgAlgorithmData -> Handshake
    ServerKeyXchg ServerKeyXchgAlgorithmData
    kx Handshake -> [Handshake] -> [Handshake]
    forall a. a -> [a] -> [a]
    :)

        -- FIXME we don't do this on a Anonymous server

        -- When configured, send a certificate request with the DNs of all
        -- configured CA certificates.
        --
        -- Client certificates MUST NOT be accepted if not requested.
        --
        if serverWantClientCert
            then do
                let (certTypes, hashSigs) =
                        let as = Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures Supported
    serverSupported
                         in (nub $ mapMaybe hashSigToCertType as, as)
                    creq =
                        [CertificateType]
    -> [HashAndSignatureAlgorithm] -> [DistinguishedName] -> Handshake
    CertRequest
                            [CertificateType]
    certTypes
                            [HashAndSignatureAlgorithm]
    hashSigs
                            ((SignedCertificate -> DistinguishedName)
    -> [SignedCertificate] -> [DistinguishedName]
    forall a b. (a -> b) -> [a] -> [b]
    map SignedCertificate -> DistinguishedName
    extractCAname [SignedCertificate]
    serverCACertificates)
                usingHState ctx $ setCertReqSent True
                return $ b2 . (creq :)
            else return b2
      where
        commonGroups :: [Group]
    commonGroups = [Group] -> [ExtensionRaw] -> [Group]
    negotiatedGroupsInCommon (Supported -> [Group]
    supportedGroups Supported
    serverSupported) [ExtensionRaw]
    chExts
        commonHashSigs :: [HashAndSignatureAlgorithm]
    commonHashSigs = [HashAndSignatureAlgorithm]
    -> [ExtensionRaw] -> [HashAndSignatureAlgorithm]
    hashAndSignaturesInCommon (Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures Supported
    serverSupported) [ExtensionRaw]
    chExts
        setup_DHE :: IO ServerDHParams
    setup_DHE = do
            let possibleFFGroups :: [Group]
    possibleFFGroups = [Group]
    commonGroups [Group] -> [Group] -> [Group]
    forall a. Eq a => [a] -> [a] -> [a]
    `intersect` [Group]
    availableFFGroups
            (dhparams, priv, pub) <-
                case [Group]
    possibleFFGroups of
                    [] ->
                        let dhparams :: DHParams
    dhparams = Maybe DHParams -> DHParams
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe DHParams
    serverDHEParams
                         in case DHParams -> Maybe Group
    findFiniteFieldGroup DHParams
    dhparams of
                                Just Group
    g -> 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
    g
                                    Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
    generateFFDHE Context
    ctx Group
    g
                                Maybe Group
    Nothing -> do
                                    (priv, pub) <- Context -> DHParams -> IO (DHPrivate, DHPublic)
    generateDHE Context
    ctx DHParams
    dhparams
                                    return (dhparams, priv, pub)
                    Group
    g : [Group]
    _ -> 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
    g
                        Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
    generateFFDHE Context
    ctx Group
    g

            let serverParams = DHParams -> DHPublic -> ServerDHParams
    serverDHParamsFrom DHParams
    dhparams DHPublic
    pub

            usingHState ctx $ setServerDHParams serverParams
            usingHState ctx $ setDHPrivate priv
            return serverParams

        -- Choosing a hash algorithm to sign (EC)DHE parameters
        -- in ServerKeyExchange. Hash algorithm is not suggested by
        -- the chosen cipher suite. So, it should be selected based on
        -- the "signature_algorithms" extension in a client hello.
        -- If RSA is also used for key exchange, this function is
        -- not called.
        decideHashSig :: PubKey -> m HashAndSignatureAlgorithm
    decideHashSig PubKey
    pubKey = do
            case (HashAndSignatureAlgorithm -> Bool)
    -> [HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (PubKey
    pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
    `signatureCompatible`) [HashAndSignatureAlgorithm]
    commonHashSigs of
                [] -> HostName -> m HashAndSignatureAlgorithm
    forall a. HasCallStack => HostName -> a
    error (HostName
    "no hash signature for " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> HostName
    pubkeyType PubKey
    pubKey)
                HashAndSignatureAlgorithm
    x : [HashAndSignatureAlgorithm]
    _ -> HashAndSignatureAlgorithm -> m HashAndSignatureAlgorithm
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashAndSignatureAlgorithm
    x

        generateSKX_DHE :: KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_DHE KeyExchangeSignatureAlg
    kxsAlg = do
            serverParams <- IO ServerDHParams
    setup_DHE
            pubKey <- getLocalPublicKey ctx
            mhashSig <- decideHashSig pubKey
            signed <- digitallySignDHParams ctx serverParams pubKey mhashSig
            case kxsAlg of
                KeyExchangeSignatureAlg
    KX_RSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
    -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a b. (a -> b) -> a -> b
    $ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
    SKX_DHE_RSA ServerDHParams
    serverParams DigitallySigned
    signed
                KeyExchangeSignatureAlg
    KX_DSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
    -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a b. (a -> b) -> a -> b
    $ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
    SKX_DHE_DSA ServerDHParams
    serverParams DigitallySigned
    signed
                KeyExchangeSignatureAlg
    _ ->
                    HostName -> IO ServerKeyXchgAlgorithmData
    forall a. HasCallStack => HostName -> a
    error (HostName
    "generate skx_dhe unsupported key exchange signature: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ KeyExchangeSignatureAlg -> HostName
    forall a. Show a => a -> HostName
    show KeyExchangeSignatureAlg
    kxsAlg)

        generateSKX_DH_Anon :: IO ServerKeyXchgAlgorithmData
    generateSKX_DH_Anon = ServerDHParams -> ServerKeyXchgAlgorithmData
    SKX_DH_Anon (ServerDHParams -> ServerKeyXchgAlgorithmData)
    -> IO ServerDHParams -> IO ServerKeyXchgAlgorithmData
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO ServerDHParams
    setup_DHE

        setup_ECDHE :: Group -> IO ServerECDHParams
    setup_ECDHE 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
            (srvpri, srvpub) <- Context -> Group -> IO (GroupPrivate, GroupPublic)
    generateECDHE Context
    ctx Group
    grp
            let serverParams = Group -> GroupPublic -> ServerECDHParams
    ServerECDHParams Group
    grp GroupPublic
    srvpub
            usingHState ctx $ setServerECDHParams serverParams
            usingHState ctx $ setGroupPrivate srvpri
            return serverParams

        generateSKX_ECDHE :: KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
    generateSKX_ECDHE KeyExchangeSignatureAlg
    kxsAlg = do
            let possibleECGroups :: [Group]
    possibleECGroups = [Group]
    commonGroups [Group] -> [Group] -> [Group]
    forall a. Eq a => [a] -> [a] -> [a]
    `intersect` [Group]
    availableECGroups
            grp <- case [Group]
    possibleECGroups of
                [] -> TLSError -> IO Group
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO Group) -> TLSError -> IO Group
    forall a b. (a -> b) -> a -> b
    $ HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    "no common group" AlertDescription
    HandshakeFailure
                Group
    g : [Group]
    _ -> Group -> IO Group
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Group
    g
            serverParams <- setup_ECDHE grp
            pubKey <- getLocalPublicKey ctx
            mhashSig <- decideHashSig pubKey
            signed <- digitallySignECDHParams ctx serverParams pubKey mhashSig
            case kxsAlg of
                KeyExchangeSignatureAlg
    KX_RSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
    -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a b. (a -> b) -> a -> b
    $ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
    SKX_ECDHE_RSA ServerECDHParams
    serverParams DigitallySigned
    signed
                KeyExchangeSignatureAlg
    KX_ECDSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
    -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
    forall a b. (a -> b) -> a -> b
    $ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
    SKX_ECDHE_ECDSA ServerECDHParams
    serverParams DigitallySigned
    signed
                KeyExchangeSignatureAlg
    _ ->
                    HostName -> IO ServerKeyXchgAlgorithmData
    forall a. HasCallStack => HostName -> a
    error (HostName
    "generate skx_ecdhe unsupported key exchange signature: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ KeyExchangeSignatureAlg -> HostName
    forall a. Show a => a -> HostName
    show KeyExchangeSignatureAlg
    kxsAlg)

    ---
    -- When the client sends a certificate, check whether
    -- it is acceptable for the application.
    --
    ---
    makeServerHello
        :: ServerParams
        -> Context
        -> Cipher
        -> Maybe Credential
        -> [ExtensionRaw]
        -> Session
        -> IO Handshake
    makeServerHello :: ServerParams
    -> Context
    -> Cipher
    -> Maybe Credential
    -> [ExtensionRaw]
    -> Session
    -> IO Handshake
    makeServerHello ServerParams
    sparams Context
    ctx Cipher
    usedCipher Maybe Credential
    mcred [ExtensionRaw]
    chExts Session
    session = do
        resuming <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS12SessionResuming
        srand <-
            serverRandom ctx TLS12 $ supportedVersions $ serverSupported sparams
        case mcred of
            Just Credential
    cred -> Context -> Credential -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Credential -> m ()
    storePrivInfoServer Context
    ctx Credential
    cred
            Maybe Credential
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- return a sensible error
        sniExt <- do
            if resuming
                then return Nothing
                else do
                    msni <- usingState_ ctx getClientSNI
                    case msni of
                        -- RFC6066: In this event, the server SHALL include
                        -- an extension of type "server_name" in the
                        -- (extended) server hello. The "extension_data"
                        -- field of this extension SHALL be empty.
                        Just HostName
    _ -> 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 []
                        Maybe HostName
    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

        let ecPointExt = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
    extensionLookup ExtensionID
    EID_EcPointFormats [ExtensionRaw]
    chExts of
                Maybe ByteString
    Nothing -> Maybe ExtensionRaw
    forall a. Maybe a
    Nothing
                Just ByteString
    _ -> 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]

        alpnExt <- applicationProtocol ctx chExts sparams

        ems <- usingHState ctx getExtendedMainSecret
        let emsExt
                | Bool
    ems = ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ ExtendedMainSecret -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw ExtendedMainSecret
    ExtendedMainSecret
                | Bool
    otherwise = Maybe ExtensionRaw
    forall a. Maybe a
    Nothing

        let useTicket = SessionManager -> Bool
    sessionUseTicket (SessionManager -> Bool) -> SessionManager -> Bool
    forall a b. (a -> b) -> a -> b
    $ Shared -> SessionManager
    sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
    forall a b. (a -> b) -> a -> b
    $ ServerParams -> Shared
    serverShared ServerParams
    sparams
            sessionTicketExt
                | Bool -> Bool
    not Bool
    resuming Bool -> Bool -> Bool
    && Bool
    useTicket = ExtensionRaw -> Maybe ExtensionRaw
    forall a. a -> Maybe a
    Just (ExtensionRaw -> Maybe ExtensionRaw)
    -> ExtensionRaw -> Maybe ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ SessionTicket -> ExtensionRaw
    forall e. Extension e => e -> ExtensionRaw
    toExtensionRaw (SessionTicket -> ExtensionRaw) -> SessionTicket -> ExtensionRaw
    forall a b. (a -> b) -> a -> b
    $ ByteString -> SessionTicket
    SessionTicket ByteString
    ""
                | Bool
    otherwise = Maybe ExtensionRaw
    forall a. Maybe a
    Nothing

        -- in TLS12, we need to check as well the certificates we are sending if they have in the extension
        -- the necessary bits set.
        secReneg <- usingState_ ctx getSecureRenegotiation
        secureRenegExt <-
            if secReneg
                then do
                    vd <- usingState_ ctx $ do
                        VerifyData cvd <- getVerifyData ClientRole
                        VerifyData svd <- getVerifyData ServerRole
                        return $ SecureRenegotiation cvd svd
                    return $ Just $ toExtensionRaw vd
                else return Nothing

        recodeSizeLimitExt <- processRecordSizeLimit ctx chExts False

        let shExts =
                Shared -> [ExtensionRaw]
    sharedHelloExtensions (ServerParams -> Shared
    serverShared ServerParams
    sparams)
                    [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
    forall a. [a] -> [a] -> [a]
    ++ [Maybe ExtensionRaw] -> [ExtensionRaw]
    forall a. [Maybe a] -> [a]
    catMaybes
                        [ {- 0x00 -} Maybe ExtensionRaw
    sniExt
                        , {- 0x0b -} Maybe ExtensionRaw
    ecPointExt
                        , {- 0x10 -} Maybe ExtensionRaw
    alpnExt
                        , {- 0x17 -} Maybe ExtensionRaw
    emsExt
                        , {- 0x1c -} Maybe ExtensionRaw
    recodeSizeLimitExt
                        , {- 0x23 -} Maybe ExtensionRaw
    sessionTicketExt
                        , {- 0xff01 -} Maybe ExtensionRaw
    secureRenegExt
                        ]
        usingState_ ctx $ setVersion TLS12
        usingHState ctx $
            setServerHelloParameters TLS12 srand usedCipher nullCompression
        return $
            ServerHello
                TLS12
                srand
                session
                (CipherId (cipherID usedCipher))
                (compressionID nullCompression)
                shExts

    negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
    negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
    negotiatedGroupsInCommon [Group]
    serverGroups [ExtensionRaw]
    chExts =
        ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> [Group]
    -> (SupportedGroups -> [Group])
    -> [Group]
    forall e a.
    Extension e =>
    ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
    lookupAndDecode
            ExtensionID
    EID_SupportedGroups
            MessageType
    MsgTClientHello
            [ExtensionRaw]
    chExts
            []
            SupportedGroups -> [Group]
    common
      where
        common :: SupportedGroups -> [Group]
    common (SupportedGroups [Group]
    clientGroups) = [Group]
    serverGroups [Group] -> [Group] -> [Group]
    forall a. Eq a => [a] -> [a] -> [a]
    `intersect` [Group]
    clientGroups