    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ImpredicativeTypes #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE ViewPatterns #-}

    module Network.Wai.Handler.Warp.Settings where

    import Control.Exception (SomeException(..), fromException, throw)
    import qualified Data.ByteString.Builder as Builder
    import qualified Data.ByteString.Char8 as C8
    import Data.Streaming.Network (HostPreference)
    import qualified Data.Text as T
    import qualified Data.Text.IO as TIO
    import GHC.IO (IO (IO), unsafeUnmask)
    import GHC.IO.Exception (IOErrorType (..))
    import GHC.Prim (fork#)
    import qualified Network.HTTP.Types as H
    import Network.Socket (SockAddr, Socket, accept)
    import Network.Wai
    import System.IO (stderr)
    import System.IO.Error (ioeGetErrorType)
    import System.TimeManager

    import Network.Wai.Handler.Warp.Imports
    import Network.Wai.Handler.Warp.Types
    #if WINDOWS
    import Network.Wai.Handler.Warp.Windows (windowsThreadBlockHack)
    #endif

    #ifdef INCLUDE_WARP_VERSION
    import Data.Version (showVersion)
    import qualified Paths_warp
    #endif

    -- | Various Warp server settings. This is purposely kept as an abstract data
    -- type so that new settings can be added without breaking backwards
    -- compatibility. In order to create a 'Settings' value, use 'defaultSettings'
    -- and the various \'set\' functions to modify individual fields. For example:
    --
    -- > setTimeout 20 defaultSettings
    data Settings = Settings
        { Settings -> Int
    settingsPort :: Port
        -- ^ Port to listen on. Default value: 3000
        , Settings -> HostPreference
    settingsHost :: HostPreference
        -- ^ Default value: HostIPv4
        , Settings -> Maybe Request -> SomeException -> IO ()
    settingsOnException :: Maybe Request -> SomeException -> IO ()
        -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
        , Settings -> SomeException -> Response
    settingsOnExceptionResponse :: SomeException -> Response
        -- ^ A function to create `Response` when an exception occurs.
        --
        -- Default: 500, text/plain, \"Something went wrong\"
        --
        -- Since 2.0.3
        , Settings -> SockAddr -> IO Bool
    settingsOnOpen :: SockAddr -> IO Bool
        -- ^ What to do when a connection is open. When 'False' is returned, the connection is closed immediately. Otherwise, the connection is going on. Default: always returns 'True'.
        , Settings -> SockAddr -> IO ()
    settingsOnClose :: SockAddr -> IO ()
        -- ^ What to do when a connection is close. Default: do nothing.
        , Settings -> Int
    settingsTimeout :: Int
        -- ^ Timeout value in seconds. Default value: 30
        , Settings -> Maybe Manager
    settingsManager :: Maybe Manager
        -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
        , Settings -> Int
    settingsFdCacheDuration :: Int
        -- ^ Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used. Default value: 0
        , Settings -> Int
    settingsFileInfoCacheDuration :: Int
        -- ^ Cache duration time of file information in seconds. 0 means that the cache mechanism is not used. Default value: 0
        , Settings -> IO ()
    settingsBeforeMainLoop :: IO ()
        -- ^ Code to run after the listening socket is ready but before entering
        -- the main event loop. Useful for signaling to tests that they can start
        -- running, or to drop permissions after binding to a restricted port.
        --
        -- Default: do nothing.
        --
        -- Since 1.3.6
        , Settings -> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
        -- ^ Code to fork a new thread to accept a connection.
        --
        -- This may be useful if you need OS bound threads, or if
        -- you wish to develop an alternative threading model.
        --
        -- Default: 'defaultFork'
        --
        -- Since 3.0.4
        , Settings -> Socket -> IO (Socket, SockAddr)
    settingsAccept :: Socket -> IO (Socket, SockAddr)
        -- ^ Code to accept a new connection.
        --
        -- Useful if you need to provide connected sockets from something other
        -- than a standard accept call.
        --
        -- Default: 'defaultAccept'
        --
        -- Since 3.3.24
        , Settings -> Bool
    settingsNoParsePath :: Bool
        -- ^ Perform no parsing on the rawPathInfo.
        --
        -- This is useful for writing HTTP proxies.
        --
        -- Default: False
        --
        -- Since 2.0.3
        , Settings -> IO () -> IO ()
    settingsInstallShutdownHandler :: IO () -> IO ()
        -- ^ An action to install a handler (e.g. Unix signal handler)
        -- to close a listen socket.
        -- The first argument is an action to close the listen socket.
        --
        -- Default: no action
        --
        -- Since 3.0.1
        , Settings -> ByteString
    settingsServerName :: ByteString
        -- ^ Default server name if application does not set one.
        --
        -- Since 3.0.2
        , Settings -> Maybe Int
    settingsMaximumBodyFlush :: Maybe Int
        -- ^ See @setMaximumBodyFlush@.
        --
        -- Since 3.0.3
        , Settings -> ProxyProtocol
    settingsProxyProtocol :: ProxyProtocol
        -- ^ Specify usage of the PROXY protocol.
        --
        -- Since 3.0.5
        , Settings -> Int
    settingsSlowlorisSize :: Int
        -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048
        --
        -- Since 3.1.2
        , Settings -> Bool
    settingsHTTP2Enabled :: Bool
        -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True
        --
        -- Since 3.1.7
        , Settings -> Request -> Status -> Maybe Integer -> IO ()
    settingsLogger :: Request -> H.Status -> Maybe Integer -> IO ()
        -- ^ A log function. Default: no action.
        --
        -- Since 3.1.10
        , Settings -> Request -> ByteString -> Integer -> IO ()
    settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
        -- ^ A HTTP/2 server push log function. Default: no action.
        --
        -- Since 3.2.7
        , Settings -> Maybe Int
    settingsGracefulShutdownTimeout :: Maybe Int
        -- ^ An optional timeout to limit the time (in seconds) waiting for
        -- a graceful shutdown of the web server.
        --
        -- Since 3.2.8
        , Settings -> Int
    settingsGracefulCloseTimeout1 :: Int
        -- ^ A timeout to limit the time (in milliseconds) waiting for
        -- FIN for HTTP/1.x. 0 means uses immediate close.
        -- Default: 0.
        --
        -- Since 3.3.5
        , Settings -> Int
    settingsGracefulCloseTimeout2 :: Int
        -- ^ A timeout to limit the time (in milliseconds) waiting for
        -- FIN for HTTP/2. 0 means uses immediate close.
        -- Default: 2000.
        --
        -- Since 3.3.5
        , Settings -> Int
    settingsMaxTotalHeaderLength :: Int
        -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.
        --
        -- Since 3.3.8
        , Settings -> Maybe ByteString
    settingsAltSvc :: Maybe ByteString
        -- ^ Specify the header value of Alternative Services (AltSvc:).
        --
        -- Default: Nothing
        --
        -- Since 3.3.11
        , Settings -> Int
    settingsMaxBuilderResponseBufferSize :: Int
        -- ^ Determines the maxium buffer size when sending `Builder` responses
        -- (See `responseBuilder`).
        --
        -- When sending a builder response warp uses a 16 KiB buffer to write the
        -- builder to. When that buffer is too small to fit the builder warp will
        -- free it and create a new one that will fit the builder.
        --
        -- To protect against allocating too large a buffer warp will error if the
        -- builder requires more than this maximum.
        --
        -- Default: 1049_000_000 = 1 MiB.
        --
        -- Since 3.3.22
        }

    -- | Specify usage of the PROXY protocol.
    data ProxyProtocol
        = -- | See @setProxyProtocolNone@.
          ProxyProtocolNone
        | -- | See @setProxyProtocolRequired@.
          ProxyProtocolRequired
        | -- | See @setProxyProtocolOptional@.
          ProxyProtocolOptional

    -- | The default settings for the Warp server. See the individual settings for
    -- the default value.
    defaultSettings :: Settings
    defaultSettings :: Settings
    defaultSettings =
        Settings
            { settingsPort :: Int
    settingsPort = Int
    3000
            , settingsHost :: HostPreference
    settingsHost = HostPreference
    "*4"
            , settingsOnException :: Maybe Request -> SomeException -> IO ()
    settingsOnException = Maybe Request -> SomeException -> IO ()
    defaultOnException
            , settingsOnExceptionResponse :: SomeException -> Response
    settingsOnExceptionResponse = SomeException -> Response
    defaultOnExceptionResponse
            , settingsOnOpen :: SockAddr -> IO Bool
    settingsOnOpen = IO Bool -> SockAddr -> IO Bool
    forall a b. a -> b -> a
    const (IO Bool -> SockAddr -> IO Bool) -> IO Bool -> SockAddr -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            , settingsOnClose :: SockAddr -> IO ()
    settingsOnClose = IO () -> SockAddr -> IO ()
    forall a b. a -> b -> a
    const (IO () -> SockAddr -> IO ()) -> IO () -> SockAddr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , settingsTimeout :: Int
    settingsTimeout = Int
    30
            , settingsManager :: Maybe Manager
    settingsManager = Maybe Manager
    forall a. Maybe a
    Nothing
            , settingsFdCacheDuration :: Int
    settingsFdCacheDuration = Int
    0
            , settingsFileInfoCacheDuration :: Int
    settingsFileInfoCacheDuration = Int
    0
            , settingsBeforeMainLoop :: IO ()
    settingsBeforeMainLoop = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    settingsFork = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    defaultFork
            , settingsAccept :: Socket -> IO (Socket, SockAddr)
    settingsAccept = Socket -> IO (Socket, SockAddr)
    defaultAccept
            , settingsNoParsePath :: Bool
    settingsNoParsePath = Bool
    False
            , settingsInstallShutdownHandler :: IO () -> IO ()
    settingsInstallShutdownHandler = IO () -> IO () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , settingsServerName :: ByteString
    settingsServerName = [Char] -> ByteString
    C8.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Warp/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    warpVersion
            , settingsMaximumBodyFlush :: Maybe Int
    settingsMaximumBodyFlush = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    8192
            , settingsProxyProtocol :: ProxyProtocol
    settingsProxyProtocol = ProxyProtocol
    ProxyProtocolNone
            , settingsSlowlorisSize :: Int
    settingsSlowlorisSize = Int
    2048
            , settingsHTTP2Enabled :: Bool
    settingsHTTP2Enabled = Bool
    True
            , settingsLogger :: Request -> Status -> Maybe Integer -> IO ()
    settingsLogger = \Request
    _ Status
    _ Maybe Integer
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
    settingsServerPushLogger = \Request
    _ ByteString
    _ Integer
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , settingsGracefulShutdownTimeout :: Maybe Int
    settingsGracefulShutdownTimeout = Maybe Int
    forall a. Maybe a
    Nothing
            , settingsGracefulCloseTimeout1 :: Int
    settingsGracefulCloseTimeout1 = Int
    0
            , settingsGracefulCloseTimeout2 :: Int
    settingsGracefulCloseTimeout2 = Int
    2000
            , settingsMaxTotalHeaderLength :: Int
    settingsMaxTotalHeaderLength = Int
    50 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1024
            , settingsAltSvc :: Maybe ByteString
    settingsAltSvc = Maybe ByteString
    forall a. Maybe a
    Nothing
            , settingsMaxBuilderResponseBufferSize :: Int
    settingsMaxBuilderResponseBufferSize = Int
    1049000000
            }

    -- | Apply the logic provided by 'defaultOnException' to determine if an
    -- exception should be shown or not. The goal is to hide exceptions which occur
    -- under the normal course of the web server running.
    --
    -- Since 2.1.3
    defaultShouldDisplayException :: SomeException -> Bool
    defaultShouldDisplayException :: SomeException -> Bool
    defaultShouldDisplayException SomeException
    se
        | Just (InvalidRequest
    _ :: InvalidRequest) <- SomeException -> Maybe InvalidRequest
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se = Bool
    False
        | Just (IOError -> IOErrorType
    ioeGetErrorType -> IOErrorType
    et) <- SomeException -> Maybe IOError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se
        , IOErrorType
    et IOErrorType -> IOErrorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOErrorType
    ResourceVanished Bool -> Bool -> Bool
    || IOErrorType
    et IOErrorType -> IOErrorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOErrorType
    InvalidArgument =
            Bool
    False
        | SomeException -> Bool
    forall e. Exception e => e -> Bool
    isAsyncException SomeException
    se = Bool
    False
        | Bool
    otherwise = Bool
    True

    -- | Printing an exception to standard error
    --   if `defaultShouldDisplayException` returns `True`.
    --
    -- Since: 3.1.0
    defaultOnException :: Maybe Request -> SomeException -> IO ()
    defaultOnException :: Maybe Request -> SomeException -> IO ()
    defaultOnException Maybe Request
    _ SomeException
    e =
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SomeException -> Bool
    defaultShouldDisplayException SomeException
    e) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Handle -> Text -> IO ()
    TIO.hPutStrLn Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
                    SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e

    -- | Sending 400 for bad requests.
    --   Sending 500 for internal server errors.
    -- Since: 3.1.0
    --   Sending 413 for too large payload.
    --   Sending 431 for too large headers.
    -- Since 3.2.27
    defaultOnExceptionResponse :: SomeException -> Response
    defaultOnExceptionResponse :: SomeException -> Response
    defaultOnExceptionResponse SomeException
    e
        | SomeException -> Bool
    forall e. Exception e => e -> Bool
    isAsyncException SomeException
    e = SomeException -> Response
    forall a e. (HasCallStack, Exception e) => e -> a
    throw SomeException
    e
        | Just InvalidRequest
    PayloadTooLarge <- SomeException -> Maybe InvalidRequest
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e =
            Status -> ResponseHeaders -> ByteString -> Response
    responseLBS
                Status
    H.status413
                [(HeaderName
    H.hContentType, ByteString
    "text/plain; charset=utf-8")]
                ByteString
    "Payload too large"
        | Just InvalidRequest
    RequestHeaderFieldsTooLarge <- SomeException -> Maybe InvalidRequest
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e =
            Status -> ResponseHeaders -> ByteString -> Response
    responseLBS
                Status
    H.status431
                [(HeaderName
    H.hContentType, ByteString
    "text/plain; charset=utf-8")]
                ByteString
    "Request header fields too large"
        | Just (InvalidRequest
    _ :: InvalidRequest) <- SomeException -> Maybe InvalidRequest
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e =
            Status -> ResponseHeaders -> ByteString -> Response
    responseLBS
                Status
    H.badRequest400
                [(HeaderName
    H.hContentType, ByteString
    "text/plain; charset=utf-8")]
                ByteString
    "Bad Request"
        | Bool
    otherwise =
            Status -> ResponseHeaders -> ByteString -> Response
    responseLBS
                Status
    H.internalServerError500
                [(HeaderName
    H.hContentType, ByteString
    "text/plain; charset=utf-8")]
                ByteString
    "Something went wrong"

    -- | Exception handler for the debugging purpose.
    --   500, text/plain, a showed exception.
    --
    -- Since: 2.0.3.2
    exceptionResponseForDebug :: SomeException -> Response
    exceptionResponseForDebug :: SomeException -> Response
    exceptionResponseForDebug SomeException
    e =
        Status -> ResponseHeaders -> Builder -> Response
    responseBuilder
            Status
    H.internalServerError500
            [(HeaderName
    H.hContentType, ByteString
    "text/plain; charset=utf-8")]
            (Builder -> Response) -> Builder -> Response
    forall a b. (a -> b) -> a -> b
    $ Builder
    "Exception: " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    Builder.stringUtf8 (SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e)

    -- | Similar to @forkIOWithUnmask@, but does not set up the default exception handler.
    --
    -- Since Warp will always install its own exception handler in forked threads, this provides
    -- a minor optimization.
    --
    -- For inspiration of this function, see @rawForkIO@ in the @async@ package.
    --
    -- @since 3.3.17
    defaultFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    defaultFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    defaultFork (forall a. IO a -> IO a) -> IO ()
    io =
        (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
    -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s0 ->
    #if __GLASGOW_HASKELL__ >= 904
            case (forall a. IO a -> IO a) -> IO ()
    io IO a -> IO a
    forall a. IO a -> IO a
    unsafeUnmask of
                IO State# RealWorld -> (# State# RealWorld, () #)
    io' ->
                    case (State# RealWorld -> (# State# RealWorld, () #))
    -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
    forall a.
    (State# RealWorld -> (# State# RealWorld, a #))
    -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
    fork# State# RealWorld -> (# State# RealWorld, () #)
    io' State# RealWorld
    s0 of
                        (# State# RealWorld
    s1, ThreadId#
    _tid #) -> (# State# RealWorld
    s1, () #)
    #else
            case fork# (io unsafeUnmask) s0 of
                (# s1, _tid #) -> (# s1, () #)
    #endif

    -- | Standard "accept" call for a listening socket.
    --
    -- @since 3.3.24
    defaultAccept :: Socket -> IO (Socket, SockAddr)
    defaultAccept :: Socket -> IO (Socket, SockAddr)
    defaultAccept =
    #if WINDOWS
        windowsThreadBlockHack . accept
    #else
        Socket -> IO (Socket, SockAddr)
    accept
    #endif

    -- | The version of Warp.
    warpVersion :: String
    warpVersion :: [Char]
    warpVersion =
    #ifdef INCLUDE_WARP_VERSION
      Version -> [Char]
    showVersion Version
    Paths_warp.version
    #else
      "unknown"
    #endif