    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}

    -- | HTTP over TLS support for Warp via the TLS package.
    --
    --   If HTTP\/2 is negotiated by ALPN, HTTP\/2 over TLS is used.
    --   Otherwise HTTP\/1.1 over TLS is used.
    --
    --   Support for SSL is now obsoleted.
    module Network.Wai.Handler.WarpTLS (
        -- * Runner
        runTLS,
        runTLSSocket,

        -- * Settings
        TLSSettings,
        defaultTlsSettings,

        -- * Smart constructors

        -- ** From files
        tlsSettings,
        tlsSettingsChain,

        -- ** From memory
        tlsSettingsMemory,
        tlsSettingsChainMemory,

        -- ** From references
        tlsSettingsRef,
        tlsSettingsChainRef,
        CertSettings,

        -- ** Dynamically retrieved
        tlsSettingsSni,

        -- * Accessors
        tlsCredentials,
        tlsLogging,
        tlsAllowedVersions,
        tlsCiphers,
        tlsWantClientCert,
        tlsServerHooks,
        tlsServerDHEParams,
        tlsSessionManagerConfig,
        tlsSessionManager,
        onInsecure,
        OnInsecure (..),

        -- * Exception
        WarpTLSException (..),

        -- * Low-level
        attachConn
    ) where

    import Control.Applicative ((<|>))
    import Control.Exception (
        Exception,
        IOException,
        SomeException (..),
        bracket,
        finally,
        fromException,
        handle,
        handleJust,
        onException,
        throwIO,
        try,
     )
    import Control.Monad (guard, void)
    import qualified Data.ByteString as S
    import qualified Data.ByteString.Lazy as L
    import qualified Data.IORef as I
    import Data.Streaming.Network (bindPortTCP, safeRecv)
    import Data.Typeable (Typeable)
    import GHC.IO.Exception (IOErrorType (..))
    import Network.Socket (
        SockAddr,
        Socket,
        close,
        getSocketName,
    #if MIN_VERSION_network(3,1,1)
        gracefulClose,
    #endif
        withSocketsDo,
     )
    import qualified Control.Exception as E
    import Network.Socket.BufferPool
    import Network.Socket.ByteString (sendAll)
    import qualified Network.TLS as TLS
    import qualified Network.TLS.SessionManager as SM
    import Network.Wai (Application)
    import Network.Wai.Handler.Warp
    import Network.Wai.Handler.Warp.Internal
    import Network.Wai.Handler.WarpTLS.Internal
    import System.IO.Error (ioeGetErrorType, isEOFError)
    import System.Timeout (timeout)

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

    -- | A smart constructor for 'TLSSettings' based on 'defaultTlsSettings'.
    tlsSettings
        :: FilePath
        -- ^ Certificate file
        -> FilePath
        -- ^ Key file
        -> TLSSettings
    tlsSettings :: FilePath -> FilePath -> TLSSettings
    tlsSettings FilePath
    cert FilePath
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromFile cert [] key
            }

    -- | A smart constructor for 'TLSSettings' that allows specifying
    -- chain certificates based on 'defaultTlsSettings'.
    --
    -- Since 3.0.3
    tlsSettingsChain
        :: FilePath
        -- ^ Certificate file
        -> [FilePath]
        -- ^ Chain certificate files
        -> FilePath
        -- ^ Key file
        -> TLSSettings
    tlsSettingsChain :: FilePath -> [FilePath] -> FilePath -> TLSSettings
    tlsSettingsChain FilePath
    cert [FilePath]
    chainCerts FilePath
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromFile cert chainCerts key
            }

    -- | A smart constructor for 'TLSSettings', but uses in-memory representations
    -- of the certificate and key based on 'defaultTlsSettings'.
    --
    -- Since 3.0.1
    tlsSettingsMemory
        :: S.ByteString
        -- ^ Certificate bytes
        -> S.ByteString
        -- ^ Key bytes
        -> TLSSettings
    tlsSettingsMemory :: ByteString -> ByteString -> TLSSettings
    tlsSettingsMemory ByteString
    cert ByteString
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromMemory cert [] key
            }

    -- | A smart constructor for 'TLSSettings', but uses in-memory representations
    -- of the certificate and key based on 'defaultTlsSettings'.
    --
    -- Since 3.0.3
    tlsSettingsChainMemory
        :: S.ByteString
        -- ^ Certificate bytes
        -> [S.ByteString]
        -- ^ Chain certificate bytes
        -> S.ByteString
        -- ^ Key bytes
        -> TLSSettings
    tlsSettingsChainMemory :: ByteString -> [ByteString] -> ByteString -> TLSSettings
    tlsSettingsChainMemory ByteString
    cert [ByteString]
    chainCerts ByteString
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromMemory cert chainCerts key
            }

    -- | Smart constructor for TLS settings that obtains its credentials during
    -- Server Name Indication. Can be used to return different credentials
    -- depending on the hostname but also to retrieve dynamically updated
    -- credentials from an IORef. Credentials can be loaded from PEM-encoded chain
    -- and key files using 'TLS.credentialLoadX509'.
    --
    -- @since 3.4.13
    tlsSettingsSni :: (Maybe TLS.HostName -> IO TLS.Credentials) -> TLSSettings
    tlsSettingsSni :: (Maybe FilePath -> IO Credentials) -> TLSSettings
    tlsSettingsSni Maybe FilePath -> IO Credentials
    onServerNameIndicationHook =
      TLSSettings
    defaultTlsSettings
        { tlsCredentials = Just (TLS.Credentials [])
        , tlsServerHooks = (tlsServerHooks defaultTlsSettings)
          { TLS.onServerNameIndication =  onServerNameIndicationHook
          }
        }

    -- | A smart constructor for 'TLSSettings', but uses references to in-memory
    -- representations of the certificate and key based on 'defaultTlsSettings'.
    --
    -- @since 3.3.0
    tlsSettingsRef
        :: I.IORef S.ByteString
        -- ^ Reference to certificate bytes
        -> I.IORef S.ByteString
        -- ^ Reference to key bytes
        -> TLSSettings
    tlsSettingsRef :: IORef ByteString -> IORef ByteString -> TLSSettings
    tlsSettingsRef IORef ByteString
    cert IORef ByteString
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromRef cert [] key
            }

    {-# DEPRECATED tlsSettingsRef "This function was added to allow Warp to serve new certificates without restarting, but it has always behaved the same as 'tlsSettingsMemory'. It will be removed in the next major release. To retain existing behavior, swich to 'tlsSettingsMemory'. To dynamically update credentials, see 'tlsSettingsSni'." #-}

    -- | A smart constructor for 'TLSSettings', but uses references to in-memory
    -- representations of the certificate and key based on 'defaultTlsSettings'.
    --
    -- @since 3.3.0
    tlsSettingsChainRef
        :: I.IORef S.ByteString
        -- ^ Reference to certificate bytes
        -> [I.IORef S.ByteString]
        -- ^ Reference to chain certificate bytes
        -> I.IORef S.ByteString
        -- ^ Reference to key bytes
        -> TLSSettings
    tlsSettingsChainRef :: IORef ByteString
    -> [IORef ByteString] -> IORef ByteString -> TLSSettings
    tlsSettingsChainRef IORef ByteString
    cert [IORef ByteString]
    chainCerts IORef ByteString
    key =
        TLSSettings
    defaultTlsSettings
            { certSettings = CertFromRef cert chainCerts key
            }

    {-# DEPRECATED tlsSettingsChainRef "This function was added to allow Warp to serve new certificates without restarting, but it has always behaved the same as 'tlsSettingsChainMemory'. It will be removed in the next major release. To retain existing behavior, swich to 'tlsSettingsChainMemory'. To dynamically update credentials, see 'tlsSettingsSni'." #-}

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

    -- | Running 'Application' with 'TLSSettings' and 'Settings'.
    runTLS :: TLSSettings -> Settings -> Application -> IO ()
    runTLS :: TLSSettings -> Settings -> Application -> IO ()
    runTLS TLSSettings
    tset Settings
    set Application
    app =
        IO () -> IO ()
    forall a. IO a -> IO a
    withSocketsDo (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
                (Int -> HostPreference -> IO Socket
    bindPortTCP (Settings -> Int
    getPort Settings
    set) (Settings -> HostPreference
    getHost Settings
    set))
                Socket -> IO ()
    close
                ( \Socket
    sock -> do
                    Socket -> IO ()
    setSocketCloseOnExec Socket
    sock
                    TLSSettings -> Settings -> Socket -> Application -> IO ()
    runTLSSocket TLSSettings
    tset Settings
    set Socket
    sock Application
    app
                )

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

    loadCredentials :: TLSSettings -> IO TLS.Credentials
    loadCredentials :: TLSSettings -> IO Credentials
    loadCredentials TLSSettings{tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsCredentials = Just Credentials
    creds} = Credentials -> IO Credentials
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Credentials
    creds
    loadCredentials TLSSettings{Bool
    [HashAndSignatureAlgorithm]
    [Version]
    [Cipher]
    Maybe SessionManager
    Maybe Credentials
    Maybe Config
    Maybe DHParams
    Logging
    ServerHooks
    OnInsecure
    CertSettings
    tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsLogging :: TLSSettings -> Logging
    tlsAllowedVersions :: TLSSettings -> [Version]
    tlsCiphers :: TLSSettings -> [Cipher]
    tlsWantClientCert :: TLSSettings -> Bool
    tlsServerHooks :: TLSSettings -> ServerHooks
    tlsServerDHEParams :: TLSSettings -> Maybe DHParams
    tlsSessionManagerConfig :: TLSSettings -> Maybe Config
    tlsSessionManager :: TLSSettings -> Maybe SessionManager
    onInsecure :: TLSSettings -> OnInsecure
    certSettings :: TLSSettings -> CertSettings
    certSettings :: CertSettings
    onInsecure :: OnInsecure
    tlsLogging :: Logging
    tlsAllowedVersions :: [Version]
    tlsCiphers :: [Cipher]
    tlsWantClientCert :: Bool
    tlsServerHooks :: ServerHooks
    tlsServerDHEParams :: Maybe DHParams
    tlsSessionManagerConfig :: Maybe Config
    tlsCredentials :: Maybe Credentials
    tlsSessionManager :: Maybe SessionManager
    tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
    tlsSupportedHashSignatures :: TLSSettings -> [HashAndSignatureAlgorithm]
    ..} = case CertSettings
    certSettings of
        CertFromFile FilePath
    cert [FilePath]
    chainFiles FilePath
    key -> do
            cred <- (FilePath -> Credential)
    -> (Credential -> Credential)
    -> Either FilePath Credential
    -> Credential
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either FilePath -> Credential
    forall a. HasCallStack => FilePath -> a
    error Credential -> Credential
    forall a. a -> a
    id (Either FilePath Credential -> Credential)
    -> IO (Either FilePath Credential) -> IO Credential
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath
    -> [FilePath] -> FilePath -> IO (Either FilePath Credential)
    TLS.credentialLoadX509Chain FilePath
    cert [FilePath]
    chainFiles FilePath
    key
            return $ TLS.Credentials [cred]
        CertFromRef IORef ByteString
    certRef [IORef ByteString]
    chainCertsRef IORef ByteString
    keyRef -> do
            cert <- IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    I.readIORef IORef ByteString
    certRef
            chainCerts <- mapM I.readIORef chainCertsRef
            key <- I.readIORef keyRef
            cred <-
                either error return $ TLS.credentialLoadX509ChainFromMemory cert chainCerts key
            return $ TLS.Credentials [cred]
        CertFromMemory ByteString
    certMemory [ByteString]
    chainCertsMemory ByteString
    keyMemory -> do
            cred <-
                (FilePath -> IO Credential)
    -> (Credential -> IO Credential)
    -> Either FilePath Credential
    -> IO Credential
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either FilePath -> IO Credential
    forall a. HasCallStack => FilePath -> a
    error Credential -> IO Credential
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either FilePath Credential -> IO Credential)
    -> Either FilePath Credential -> IO Credential
    forall a b. (a -> b) -> a -> b
    $
                    ByteString
    -> [ByteString] -> ByteString -> Either FilePath Credential
    TLS.credentialLoadX509ChainFromMemory ByteString
    certMemory [ByteString]
    chainCertsMemory ByteString
    keyMemory
            return $ TLS.Credentials [cred]

    getSessionManager :: TLSSettings -> IO TLS.SessionManager
    getSessionManager :: TLSSettings -> IO SessionManager
    getSessionManager TLSSettings{tlsSessionManager :: TLSSettings -> Maybe SessionManager
    tlsSessionManager = Just SessionManager
    mgr} = SessionManager -> IO SessionManager
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SessionManager
    mgr
    getSessionManager TLSSettings{Bool
    [HashAndSignatureAlgorithm]
    [Version]
    [Cipher]
    Maybe SessionManager
    Maybe Credentials
    Maybe Config
    Maybe DHParams
    Logging
    ServerHooks
    OnInsecure
    CertSettings
    tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsLogging :: TLSSettings -> Logging
    tlsAllowedVersions :: TLSSettings -> [Version]
    tlsCiphers :: TLSSettings -> [Cipher]
    tlsWantClientCert :: TLSSettings -> Bool
    tlsServerHooks :: TLSSettings -> ServerHooks
    tlsServerDHEParams :: TLSSettings -> Maybe DHParams
    tlsSessionManagerConfig :: TLSSettings -> Maybe Config
    tlsSessionManager :: TLSSettings -> Maybe SessionManager
    onInsecure :: TLSSettings -> OnInsecure
    certSettings :: TLSSettings -> CertSettings
    tlsSupportedHashSignatures :: TLSSettings -> [HashAndSignatureAlgorithm]
    certSettings :: CertSettings
    onInsecure :: OnInsecure
    tlsLogging :: Logging
    tlsAllowedVersions :: [Version]
    tlsCiphers :: [Cipher]
    tlsWantClientCert :: Bool
    tlsServerHooks :: ServerHooks
    tlsServerDHEParams :: Maybe DHParams
    tlsSessionManagerConfig :: Maybe Config
    tlsCredentials :: Maybe Credentials
    tlsSessionManager :: Maybe SessionManager
    tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
    ..} = case Maybe Config
    tlsSessionManagerConfig of
        Maybe Config
    Nothing -> SessionManager -> IO SessionManager
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SessionManager
    TLS.noSessionManager
        Just Config
    config -> Config -> IO SessionManager
    SM.newSessionManager Config
    config

    -- | Running 'Application' with 'TLSSettings' and 'Settings' using
    --   specified 'Socket'.
    runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()
    runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()
    runTLSSocket TLSSettings
    tlsset Settings
    set Socket
    sock Application
    app = do
        Settings -> IO () -> IO ()
    settingsInstallShutdownHandler Settings
    set (Socket -> IO ()
    close Socket
    sock)
        credentials <- TLSSettings -> IO Credentials
    loadCredentials TLSSettings
    tlsset
        mgr <- getSessionManager tlsset
        runTLSSocket' tlsset set credentials mgr sock app

    runTLSSocket'
        :: TLSSettings
        -> Settings
        -> TLS.Credentials
        -> TLS.SessionManager
        -> Socket
        -> Application
        -> IO ()
    runTLSSocket' :: TLSSettings
    -> Settings
    -> Credentials
    -> SessionManager
    -> Socket
    -> Application
    -> IO ()
    runTLSSocket' tlsset :: TLSSettings
    tlsset@TLSSettings{Bool
    [HashAndSignatureAlgorithm]
    [Version]
    [Cipher]
    Maybe SessionManager
    Maybe Credentials
    Maybe Config
    Maybe DHParams
    Logging
    ServerHooks
    OnInsecure
    CertSettings
    tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsLogging :: TLSSettings -> Logging
    tlsAllowedVersions :: TLSSettings -> [Version]
    tlsCiphers :: TLSSettings -> [Cipher]
    tlsWantClientCert :: TLSSettings -> Bool
    tlsServerHooks :: TLSSettings -> ServerHooks
    tlsServerDHEParams :: TLSSettings -> Maybe DHParams
    tlsSessionManagerConfig :: TLSSettings -> Maybe Config
    tlsSessionManager :: TLSSettings -> Maybe SessionManager
    onInsecure :: TLSSettings -> OnInsecure
    certSettings :: TLSSettings -> CertSettings
    tlsSupportedHashSignatures :: TLSSettings -> [HashAndSignatureAlgorithm]
    certSettings :: CertSettings
    onInsecure :: OnInsecure
    tlsLogging :: Logging
    tlsAllowedVersions :: [Version]
    tlsCiphers :: [Cipher]
    tlsWantClientCert :: Bool
    tlsServerHooks :: ServerHooks
    tlsServerDHEParams :: Maybe DHParams
    tlsSessionManagerConfig :: Maybe Config
    tlsCredentials :: Maybe Credentials
    tlsSessionManager :: Maybe SessionManager
    tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
    ..} Settings
    set Credentials
    credentials SessionManager
    mgr Socket
    sock =
        Settings
    -> IO (IO (Connection, Transport), SockAddr)
    -> Application
    -> IO ()
    runSettingsConnectionMakerSecure Settings
    set IO (IO (Connection, Transport), SockAddr)
    get
      where
        get :: IO (IO (Connection, Transport), SockAddr)
    get = TLSSettings
    -> Settings
    -> Socket
    -> ServerParams
    -> IO (IO (Connection, Transport), SockAddr)
    forall params.
    TLSParams params =>
    TLSSettings
    -> Settings
    -> Socket
    -> params
    -> IO (IO (Connection, Transport), SockAddr)
    getter TLSSettings
    tlsset Settings
    set Socket
    sock ServerParams
    params
        params :: ServerParams
    params =
            ServerParams
    TLS.defaultParamsServer
                { TLS.serverWantClientCert = tlsWantClientCert
                , TLS.serverCACertificates = []
                , TLS.serverDHEParams = tlsServerDHEParams
                , TLS.serverHooks = hooks
                , TLS.serverShared = shared
                , TLS.serverSupported = supported
    #if MIN_VERSION_tls(1,5,0)
                , TLS.serverEarlyDataSize = 2018
    #endif
                }
        -- Adding alpn to user's tlsServerHooks.
        hooks :: ServerHooks
    hooks =
            ServerHooks
    tlsServerHooks
                { TLS.onALPNClientSuggest =
                    TLS.onALPNClientSuggest tlsServerHooks
                        <|> (if settingsHTTP2Enabled set then Just alpn else Nothing)
                }
        shared :: Shared
    shared =
            Shared
    TLS.defaultShared
                { TLS.sharedCredentials = credentials
                , TLS.sharedSessionManager = mgr
                }
        supported :: Supported
    supported =
            Supported
    TLS.defaultSupported
                { TLS.supportedVersions = tlsAllowedVersions
                , TLS.supportedCiphers = tlsCiphers
                , TLS.supportedCompressions = [TLS.nullCompression]
                , TLS.supportedSecureRenegotiation = True
                , TLS.supportedClientInitiatedRenegotiation = False
                , TLS.supportedSession = True
                , TLS.supportedFallbackScsv = True
                , TLS.supportedHashSignatures = tlsSupportedHashSignatures
    #if MIN_VERSION_tls(1,5,0)
                , TLS.supportedGroups = [TLS.X25519,TLS.P256,TLS.P384]
    #endif
                }

    alpn :: [S.ByteString] -> IO S.ByteString
    alpn :: [ByteString] -> IO ByteString
    alpn [ByteString]
    xs
        | ByteString
    "h2" ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString]
    xs = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    "h2"
        | Bool
    otherwise = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    "http/1.1"

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

    getter
        :: TLS.TLSParams params
        => TLSSettings
        -> Settings
        -> Socket
        -> params
        -> IO (IO (Connection, Transport), SockAddr)
    getter :: forall params.
    TLSParams params =>
    TLSSettings
    -> Settings
    -> Socket
    -> params
    -> IO (IO (Connection, Transport), SockAddr)
    getter TLSSettings
    tlsset set :: Settings
    set@Settings{settingsAccept :: Settings -> Socket -> IO (Socket, SockAddr)
    settingsAccept = Socket -> IO (Socket, SockAddr)
    accept'} Socket
    sock params
    params = do
        (s, sa) <- Socket -> IO (Socket, SockAddr)
    accept' Socket
    sock
        setSocketCloseOnExec s
        return (mkConn tlsset set s params, sa)

    mkConn
        :: TLS.TLSParams params
        => TLSSettings
        -> Settings
        -> Socket
        -> params
        -> IO (Connection, Transport)
    mkConn :: forall params.
    TLSParams params =>
    TLSSettings
    -> Settings -> Socket -> params -> IO (Connection, Transport)
    mkConn TLSSettings
    tlsset Settings
    set Socket
    s params
    params = do
        let tm :: Int
    tm = Settings -> Int
    settingsTimeout Settings
    set Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000000
        mbs <- Int -> IO ByteString -> IO (Maybe ByteString)
    forall a. Int -> IO a -> IO (Maybe a)
    timeout Int
    tm IO ByteString
    recvFirstBS
        case mbs of
          Maybe ByteString
    Nothing -> InvalidRequest -> IO (Connection, Transport)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO InvalidRequest
    IncompleteHeaders
          Just ByteString
    bs -> ByteString -> IO (Connection, Transport)
    switch ByteString
    bs
      where
        recvFirstBS :: IO ByteString
    recvFirstBS = Socket -> Int -> IO ByteString
    safeRecv Socket
    s Int
    4096 IO ByteString -> IO () -> IO ByteString
    forall a b. IO a -> IO b -> IO a
    `onException` Socket -> IO ()
    close Socket
    s
        switch :: ByteString -> IO (Connection, Transport)
    switch ByteString
    firstBS
            | ByteString -> Bool
    S.null ByteString
    firstBS = Socket -> IO ()
    close Socket
    s IO () -> IO (Connection, Transport) -> IO (Connection, Transport)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> WarpTLSException -> IO (Connection, Transport)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO WarpTLSException
    ClientClosedConnectionPrematurely
            | HasCallStack => ByteString -> Word8
    ByteString -> Word8
    S.head ByteString
    firstBS Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x16 = TLSSettings
    -> Settings
    -> Socket
    -> ByteString
    -> params
    -> IO (Connection, Transport)
    forall params.
    TLSParams params =>
    TLSSettings
    -> Settings
    -> Socket
    -> ByteString
    -> params
    -> IO (Connection, Transport)
    httpOverTls TLSSettings
    tlsset Settings
    set Socket
    s ByteString
    firstBS params
    params
            | Bool
    otherwise = TLSSettings
    -> Settings -> Socket -> ByteString -> IO (Connection, Transport)
    plainHTTP TLSSettings
    tlsset Settings
    set Socket
    s ByteString
    firstBS

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

    isAsyncException :: Exception e => e -> Bool
    isAsyncException :: forall e. Exception e => e -> Bool
    isAsyncException e
    e =
        case SomeException -> Maybe SomeAsyncException
    forall e. Exception e => SomeException -> Maybe e
    E.fromException (e -> SomeException
    forall e. Exception e => e -> SomeException
    E.toException e
    e) of
            Just (E.SomeAsyncException e
    _) -> Bool
    True
            Maybe SomeAsyncException
    Nothing -> Bool
    False

    throughAsync :: IO a -> SomeException -> IO a
    throughAsync :: forall a. IO a -> SomeException -> IO a
    throughAsync IO a
    action (SomeException e
    e)
      | e -> Bool
    forall e. Exception e => e -> Bool
    isAsyncException e
    e = e -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO e
    e
      | Bool
    otherwise          = IO a
    action

    httpOverTls
        :: TLS.TLSParams params
        => TLSSettings
        -> Settings
        -> Socket
        -> S.ByteString
        -> params
        -> IO (Connection, Transport)
    httpOverTls :: forall params.
    TLSParams params =>
    TLSSettings
    -> Settings
    -> Socket
    -> ByteString
    -> params
    -> IO (Connection, Transport)
    httpOverTls TLSSettings{Bool
    [HashAndSignatureAlgorithm]
    [Version]
    [Cipher]
    Maybe SessionManager
    Maybe Credentials
    Maybe Config
    Maybe DHParams
    Logging
    ServerHooks
    OnInsecure
    CertSettings
    tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsLogging :: TLSSettings -> Logging
    tlsAllowedVersions :: TLSSettings -> [Version]
    tlsCiphers :: TLSSettings -> [Cipher]
    tlsWantClientCert :: TLSSettings -> Bool
    tlsServerHooks :: TLSSettings -> ServerHooks
    tlsServerDHEParams :: TLSSettings -> Maybe DHParams
    tlsSessionManagerConfig :: TLSSettings -> Maybe Config
    tlsSessionManager :: TLSSettings -> Maybe SessionManager
    onInsecure :: TLSSettings -> OnInsecure
    certSettings :: TLSSettings -> CertSettings
    tlsSupportedHashSignatures :: TLSSettings -> [HashAndSignatureAlgorithm]
    certSettings :: CertSettings
    onInsecure :: OnInsecure
    tlsLogging :: Logging
    tlsAllowedVersions :: [Version]
    tlsCiphers :: [Cipher]
    tlsWantClientCert :: Bool
    tlsServerHooks :: ServerHooks
    tlsServerDHEParams :: Maybe DHParams
    tlsSessionManagerConfig :: Maybe Config
    tlsCredentials :: Maybe Credentials
    tlsSessionManager :: Maybe SessionManager
    tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
    ..} Settings
    set Socket
    s ByteString
    bs0 params
    params =
        IO (Connection, Transport)
    makeConn IO (Connection, Transport) -> IO () -> IO (Connection, Transport)
    forall a b. IO a -> IO b -> IO a
    `onException` Socket -> IO ()
    close Socket
    s
      where
        makeConn :: IO (Connection, Transport)
    makeConn = do
            pool <- Int -> Int -> IO BufferPool
    newBufferPool Int
    2048 Int
    16384
            rawRecvN <- makeRecvN bs0 $ receive s pool
            let recvN = (Int -> IO ByteString) -> Int -> IO ByteString
    forall {a} {t}. IsString a => (t -> IO a) -> t -> IO a
    wrappedRecvN Int -> IO ByteString
    rawRecvN
            ctx <- TLS.contextNew (backend recvN) params
            TLS.contextHookSetLogging ctx tlsLogging
            let tm = Settings -> Int
    settingsTimeout Settings
    set Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000000
            mconn <- timeout tm $ do
                TLS.handshake ctx
                mysa <- getSocketName s
                attachConn mysa ctx
            case mconn of
              Maybe (Connection, Transport)
    Nothing -> InvalidRequest -> IO (Connection, Transport)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO InvalidRequest
    IncompleteHeaders
              Just (Connection, Transport)
    conn -> (Connection, Transport) -> IO (Connection, Transport)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Connection, Transport)
    conn
        wrappedRecvN :: (t -> IO a) -> t -> IO a
    wrappedRecvN t -> IO a
    recvN t
    n = (SomeException -> IO a) -> IO a -> IO a
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (IO a -> SomeException -> IO a
    forall a. IO a -> SomeException -> IO a
    throughAsync (a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    "")) (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ t -> IO a
    recvN t
    n
        backend :: (Int -> IO ByteString) -> Backend
    backend Int -> IO ByteString
    recvN =
            TLS.Backend
                { backendFlush :: IO ()
    TLS.backendFlush = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if MIN_VERSION_network(3,1,1)
                , backendClose :: IO ()
    TLS.backendClose =
                    Socket -> Int -> IO ()
    gracefulClose Socket
    s Int
    5000 IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` IO () -> SomeException -> IO ()
    forall a. IO a -> SomeException -> IO a
    throughAsync (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
    #else
                , TLS.backendClose = close s
    #endif
                , backendSend :: ByteString -> IO ()
    TLS.backendSend = Socket -> ByteString -> IO ()
    sendAll' Socket
    s
                , backendRecv :: Int -> IO ByteString
    TLS.backendRecv = Int -> IO ByteString
    recvN
                }
        sendAll' :: Socket -> ByteString -> IO ()
    sendAll' Socket
    sock ByteString
    bs =
            (IOError -> Maybe InvalidRequest)
    -> (InvalidRequest -> IO ()) -> IO () -> IO ()
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
    E.handleJust
                ( \IOError
    e ->
                    if IOError -> IOErrorType
    ioeGetErrorType IOError
    e IOErrorType -> IOErrorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOErrorType
    ResourceVanished
                        then InvalidRequest -> Maybe InvalidRequest
    forall a. a -> Maybe a
    Just InvalidRequest
    ConnectionClosedByPeer
                        else Maybe InvalidRequest
    forall a. Maybe a
    Nothing
                )
                InvalidRequest -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO
                (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Socket -> ByteString -> IO ()
    sendAll Socket
    sock ByteString
    bs

    -- | Get "Connection" and "Transport" for a TLS connection that is already did the handshake.
    -- @since 3.4.7
    attachConn :: SockAddr -> TLS.Context -> IO (Connection, Transport)
    attachConn :: SockAddr -> Context -> IO (Connection, Transport)
    attachConn SockAddr
    mysa Context
    ctx = do
        h2 <- (Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "h2") (Maybe ByteString -> Bool) -> IO (Maybe ByteString) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO (Maybe ByteString)
    forall (m :: * -> *). MonadIO m => Context -> m (Maybe ByteString)
    TLS.getNegotiatedProtocol Context
    ctx
        isH2 <- I.newIORef h2
        writeBuffer <- createWriteBuffer 16384
        writeBufferRef <- I.newIORef writeBuffer
        -- Creating a cache for leftover input data.
        tls <- getTLSinfo ctx
        return (conn writeBufferRef isH2, tls)
      where
        conn :: IORef WriteBuffer -> IORef Bool -> Connection
    conn IORef WriteBuffer
    writeBufferRef IORef Bool
    isH2 =
            Connection
                { connSendMany :: [ByteString] -> IO ()
    connSendMany = Context -> ByteString -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
    TLS.sendData Context
    ctx (ByteString -> IO ())
    -> ([ByteString] -> ByteString) -> [ByteString] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    L.fromChunks
                , connSendAll :: ByteString -> IO ()
    connSendAll = ByteString -> IO ()
    sendall
                , connSendFile :: SendFile
    connSendFile = SendFile
    sendfile
                , connClose :: IO ()
    connClose = IO ()
    close'
                , connRecv :: IO ByteString
    connRecv = IO ByteString
    recv
                , connRecvBuf :: RecvBuf
    connRecvBuf = \Buffer
    _ Int
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True -- obsoleted
                , connWriteBuffer :: IORef WriteBuffer
    connWriteBuffer = IORef WriteBuffer
    writeBufferRef
                , connHTTP2 :: IORef Bool
    connHTTP2 = IORef Bool
    isH2
                , connMySockAddr :: SockAddr
    connMySockAddr = SockAddr
    mysa
                }
          where
            sendall :: ByteString -> IO ()
    sendall = Context -> ByteString -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
    TLS.sendData Context
    ctx (ByteString -> IO ())
    -> (ByteString -> ByteString) -> ByteString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    L.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            recv :: IO ByteString
    recv = (SomeException -> IO ByteString) -> IO ByteString -> IO ByteString
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle SomeException -> IO ByteString
    onEOF (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    TLS.recvData Context
    ctx
              where
                onEOF :: SomeException -> IO ByteString
    onEOF SomeException
    e
    #if MIN_VERSION_tls(1,8,0)
                    | Just (TLS.PostHandshake TLSError
    TLS.Error_EOF) <- SomeException -> Maybe TLSException
    forall e. Exception e => SomeException -> Maybe e
    E.fromException SomeException
    e = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    S.empty
    #else
                    | Just TLS.Error_EOF <- fromException e = return S.empty
    #endif
                    | Just IOError
    ioe <- SomeException -> Maybe IOError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e, IOError -> Bool
    isEOFError IOError
    ioe = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    S.empty
                    | Bool
    otherwise = SomeException -> IO ByteString
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    e
            sendfile :: SendFile
    sendfile FileId
    fid Integer
    offset Integer
    len IO ()
    hook [ByteString]
    headers = do
                writeBuffer <- IORef WriteBuffer -> IO WriteBuffer
    forall a. IORef a -> IO a
    I.readIORef IORef WriteBuffer
    writeBufferRef
                readSendFile
                    (bufBuffer writeBuffer)
                    (bufSize writeBuffer)
                    sendall
                    fid
                    offset
                    len
                    hook
                    headers

            close' :: IO ()
    close' =
                IO (Either IOError ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO () -> IO (Either IOError ())
    forall a. IO a -> IO (Either IOError a)
    tryIO IO ()
    sendBye)
                    IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    `finally` Context -> IO ()
    TLS.contextClose Context
    ctx

            sendBye :: IO ()
    sendBye =
                -- It's fine if the connection was closed by the other side before
                -- receiving close_notify, see RFC 5246 section 7.2.1.
                (InvalidRequest -> Maybe InvalidRequest)
    -> (InvalidRequest -> IO ()) -> IO () -> IO ()
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
    handleJust
                    (\InvalidRequest
    e -> Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (InvalidRequest
    e InvalidRequest -> InvalidRequest -> Bool
    forall a. Eq a => a -> a -> Bool
    == InvalidRequest
    ConnectionClosedByPeer) Maybe () -> Maybe InvalidRequest -> Maybe InvalidRequest
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> InvalidRequest -> Maybe InvalidRequest
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return InvalidRequest
    e)
                    (IO () -> InvalidRequest -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()))
                    (Context -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    TLS.bye Context
    ctx)

    getTLSinfo :: TLS.Context -> IO Transport
    getTLSinfo :: Context -> IO Transport
    getTLSinfo Context
    ctx = do
        proto <- Context -> IO (Maybe ByteString)
    forall (m :: * -> *). MonadIO m => Context -> m (Maybe ByteString)
    TLS.getNegotiatedProtocol Context
    ctx
        minfo <- TLS.contextGetInformation ctx
        case minfo of
            Maybe Information
    Nothing -> Transport -> IO Transport
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Transport
    TCP
            Just Information
    info -> do
                let (Int
    major, Int
    minor) = case Information -> Version
    TLS.infoVersion Information
    info of
                        Version
    TLS.SSL2 -> (Int
    2, Int
    0)
                        Version
    TLS.SSL3 -> (Int
    3, Int
    0)
                        Version
    TLS.TLS10 -> (Int
    3, Int
    1)
                        Version
    TLS.TLS11 -> (Int
    3, Int
    2)
                        Version
    TLS.TLS12 -> (Int
    3, Int
    3)
                        Version
    _ -> (Int
    3,Int
    4)
                clientCert <- Context -> IO (Maybe CertificateChain)
    TLS.getClientCertificateChain Context
    ctx
                return
                    TLS
                        { tlsMajorVersion = major
                        , tlsMinorVersion = minor
                        , tlsNegotiatedProtocol = proto
                        , tlsChiperID = TLS.cipherID $ TLS.infoCipher info
                        , tlsClientCertificate = clientCert
                        }

    tryIO :: IO a -> IO (Either IOException a)
    tryIO :: forall a. IO a -> IO (Either IOError a)
    tryIO = IO a -> IO (Either IOError a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try

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

    plainHTTP
        :: TLSSettings -> Settings -> Socket -> S.ByteString -> IO (Connection, Transport)
    plainHTTP :: TLSSettings
    -> Settings -> Socket -> ByteString -> IO (Connection, Transport)
    plainHTTP TLSSettings{Bool
    [HashAndSignatureAlgorithm]
    [Version]
    [Cipher]
    Maybe SessionManager
    Maybe Credentials
    Maybe Config
    Maybe DHParams
    Logging
    ServerHooks
    OnInsecure
    CertSettings
    tlsCredentials :: TLSSettings -> Maybe Credentials
    tlsLogging :: TLSSettings -> Logging
    tlsAllowedVersions :: TLSSettings -> [Version]
    tlsCiphers :: TLSSettings -> [Cipher]
    tlsWantClientCert :: TLSSettings -> Bool
    tlsServerHooks :: TLSSettings -> ServerHooks
    tlsServerDHEParams :: TLSSettings -> Maybe DHParams
    tlsSessionManagerConfig :: TLSSettings -> Maybe Config
    tlsSessionManager :: TLSSettings -> Maybe SessionManager
    onInsecure :: TLSSettings -> OnInsecure
    certSettings :: TLSSettings -> CertSettings
    tlsSupportedHashSignatures :: TLSSettings -> [HashAndSignatureAlgorithm]
    certSettings :: CertSettings
    onInsecure :: OnInsecure
    tlsLogging :: Logging
    tlsAllowedVersions :: [Version]
    tlsCiphers :: [Cipher]
    tlsWantClientCert :: Bool
    tlsServerHooks :: ServerHooks
    tlsServerDHEParams :: Maybe DHParams
    tlsSessionManagerConfig :: Maybe Config
    tlsCredentials :: Maybe Credentials
    tlsSessionManager :: Maybe SessionManager
    tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
    ..} Settings
    set Socket
    s ByteString
    bs0 = case OnInsecure
    onInsecure of
        OnInsecure
    AllowInsecure -> do
            conn' <- Settings -> Socket -> IO Connection
    socketConnection Settings
    set Socket
    s
            cachedRef <- I.newIORef bs0
            let conn'' =
                    Connection
    conn'
                        { connRecv = recvPlain cachedRef (connRecv conn')
                        }
            return (conn'', TCP)
        DenyInsecure ByteString
    lbs -> do
            -- Listening port 443 but TLS records do not arrive.
            -- We want to let the browser know that TLS is required.
            -- So, we use 426.
            --     http://tools.ietf.org/html/rfc2817#section-4.2
            --     https://tools.ietf.org/html/rfc7231#section-6.5.15
            -- FIXME: should we distinguish HTTP/1.1 and HTTP/2?
            --        In the case of HTTP/2, should we send
            --        GOAWAY + INADEQUATE_SECURITY?
            -- FIXME: Content-Length:
            -- FIXME: TLS/<version>
            Socket -> ByteString -> IO ()
    sendAll
                Socket
    s
                "HTTP/1.1 426 Upgrade Required\
                \\r\nUpgrade: TLS/1.0, HTTP/1.1\
                \\r\nConnection: Upgrade\
                \\r\nContent-Type: text/plain\r\n\r\n"
            (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Socket -> ByteString -> IO ()
    sendAll Socket
    s) ([ByteString] -> IO ()) -> [ByteString] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    L.toChunks ByteString
    lbs
            Socket -> IO ()
    close Socket
    s
            WarpTLSException -> IO (Connection, Transport)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO WarpTLSException
    InsecureConnectionDenied

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

    -- | Modify the given receive function to first check the given @IORef@ for a
    -- chunk of data. If present, takes the chunk of data from the @IORef@ and
    -- empties out the @IORef@. Otherwise, calls the supplied receive function.
    recvPlain :: I.IORef S.ByteString -> IO S.ByteString -> IO S.ByteString
    recvPlain :: IORef ByteString -> IO ByteString -> IO ByteString
    recvPlain IORef ByteString
    ref IO ByteString
    fallback = do
        bs <- IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    I.readIORef IORef ByteString
    ref
        if S.null bs
            then fallback
            else do
                I.writeIORef ref S.empty
                return bs

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

    data WarpTLSException
        = InsecureConnectionDenied
        | ClientClosedConnectionPrematurely
        deriving (Int -> WarpTLSException -> ShowS
    [WarpTLSException] -> ShowS
    WarpTLSException -> FilePath
    (Int -> WarpTLSException -> ShowS)
    -> (WarpTLSException -> FilePath)
    -> ([WarpTLSException] -> ShowS)
    -> Show WarpTLSException
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> WarpTLSException -> ShowS
    showsPrec :: Int -> WarpTLSException -> ShowS
    $cshow :: WarpTLSException -> FilePath
    show :: WarpTLSException -> FilePath
    $cshowList :: [WarpTLSException] -> ShowS
    showList :: [WarpTLSException] -> ShowS
    Show, Typeable)
    instance Exception WarpTLSException