{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

---------------------------------------------------------
--
-- Module        : Network.Wai.Handler.Warp
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Stable
-- Portability   : portable
--
-- A fast, light-weight HTTP server handler for WAI.
--
---------------------------------------------------------

-- | A fast, light-weight HTTP server handler for WAI.
--
-- HTTP\/1.0, HTTP\/1.1 and HTTP\/2 are supported. For HTTP\/2,
-- Warp supports direct and ALPN (in TLS) but not upgrade.
--
-- Note on slowloris timeouts: to prevent slowloris attacks, timeouts are used
-- at various points in request receiving and response sending. One interesting
-- corner case is partial request body consumption; in that case, Warp's
-- timeout handling is still in effect, and the timeout will not be triggered
-- again. Therefore, it is recommended that once you start consuming the
-- request body, you either:
--
-- * consume the entire body promptly
--
-- * call the 'pauseTimeout' function
--
-- For more information, see <https://github.com/yesodweb/wai/issues/351>.
--
--
module Network.Wai.Handler.Warp (
    -- * Run a Warp server
    -- | All of these automatically serve the same 'Application' over HTTP\/1,
    -- HTTP\/1.1, and HTTP\/2.
    run
  , runEnv
  , runSettings
  , runSettingsSocket
    -- * Settings
  , Settings
  , defaultSettings
    -- ** Setters
  , setPort
  , setHost
  , setOnException
  , setOnExceptionResponse
  , setOnOpen
  , setOnClose
  , setTimeout
  , setManager
  , setFdCacheDuration
  , setFileInfoCacheDuration
  , setBeforeMainLoop
  , setNoParsePath
  , setInstallShutdownHandler
  , setServerName
  , setMaximumBodyFlush
  , setFork
  , setProxyProtocolNone
  , setProxyProtocolRequired
  , setProxyProtocolOptional
  , setSlowlorisSize
  , setHTTP2Disabled
  , setLogger
    -- ** Getters
  , getPort
  , getHost
  , getOnOpen
  , getOnClose
  , getOnException
    -- ** Exception handler
  , defaultOnException
  , defaultShouldDisplayException
    -- ** Exception response handler
  , defaultOnExceptionResponse
  , exceptionResponseForDebug
    -- * Data types
  , HostPreference
  , Port
  , InvalidRequest (..)
    -- * Utilities
  , pauseTimeout
  , FileInfo(..)
  , getFileInfo
  , withApplication
  , testWithApplication
  , openFreePort
    -- * Version
  , warpVersion
  ) where

import Control.Exception (SomeException, throwIO)
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Data.Streaming.Network (HostPreference)
import qualified Data.Vault.Lazy as Vault
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr)
import Network.Wai (Request, Response, vault)
import Network.Wai.Handler.Warp.FileInfoCache
import Network.Wai.Handler.Warp.Request
import Network.Wai.Handler.Warp.Response (warpVersion)
import Network.Wai.Handler.Warp.Run
import Network.Wai.Handler.Warp.Settings
import Network.Wai.Handler.Warp.Timeout
import Network.Wai.Handler.Warp.Types hiding (getFileInfo)
import Network.Wai.Handler.Warp.WithApplication

-- | Port to listen on. Default value: 3000
--
-- Since 2.1.0
setPort :: Port -> Settings -> Settings
setPort x y = y { settingsPort = x }

-- | Interface to bind to. Default value: HostIPv4
--
-- Since 2.1.0
setHost :: HostPreference -> Settings -> Settings
setHost x y = y { settingsHost = x }

-- | What to do with exceptions thrown by either the application or server.
-- Default: 'defaultOnException'
--
-- Since 2.1.0
setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
setOnException x y = y { settingsOnException = x }

-- | A function to create a `Response` when an exception occurs.
--
-- Default: 'defaultOnExceptionResponse'
--
-- Since 2.1.0
setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
setOnExceptionResponse x y = y { settingsOnExceptionResponse = x }

-- | What to do when a connection is opened. When 'False' is returned, the
-- connection is closed immediately. Otherwise, the connection is going on.
-- Default: always returns 'True'.
--
-- Since 2.1.0
setOnOpen :: (SockAddr -> IO Bool) -> Settings -> Settings
setOnOpen x y = y { settingsOnOpen = x }

-- | What to do when a connection is closed. Default: do nothing.
--
-- Since 2.1.0
setOnClose :: (SockAddr -> IO ()) -> Settings -> Settings
setOnClose x y = y { settingsOnClose = x }

-- | Timeout value in seconds. Default value: 30
--
-- Since 2.1.0
setTimeout :: Int -> Settings -> Settings
setTimeout x y = y { settingsTimeout = x }

-- | Use an existing timeout manager instead of spawning a new one. If used,
-- 'settingsTimeout' is ignored.
--
-- Since 2.1.0
setManager :: Manager -> Settings -> Settings
setManager x y = y { settingsManager = Just x }

-- | Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used.
--
-- The FD cache is an optimization that is useful for servers dealing with
-- static files. However, if files are being modified, it can cause incorrect
-- results in some cases. Therefore, we disable it by default. If you know that
-- your files will be static or you prefer performance to file consistency,
-- it's recommended to turn this on; a reasonable value for those cases is 10.
-- Enabling this cache results in drastic performance improvement for file
-- transfers.
--
-- Default value: 0, was previously 10
--
-- Since 3.0.13
setFdCacheDuration :: Int -> Settings -> Settings
setFdCacheDuration x y = y { settingsFdCacheDuration = x }

-- | Cache duration time of file information in seconds. 0 means that the cache mechanism is not used.
--
-- The file information cache is an optimization that is useful for servers dealing with
-- static files. However, if files are being modified, it can cause incorrect
-- results in some cases. Therefore, we disable it by default. If you know that
-- your files will be static or you prefer performance to file consistency,
-- it's recommended to turn this on; a reasonable value for those cases is 10.
-- Enabling this cache results in drastic performance improvement for file
-- transfers.
--
-- Default value: 0
setFileInfoCacheDuration :: Int -> Settings -> Settings
setFileInfoCacheDuration x y = y { settingsFileInfoCacheDuration = x }

-- | 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 2.1.0
setBeforeMainLoop :: IO () -> Settings -> Settings
setBeforeMainLoop x y = y { settingsBeforeMainLoop = x }

-- | Perform no parsing on the rawPathInfo.
--
-- This is useful for writing HTTP proxies.
--
-- Default: False
--
-- Since 2.1.0
setNoParsePath :: Bool -> Settings -> Settings
setNoParsePath x y = y { settingsNoParsePath = x }

-- | Get the listening port.
--
-- Since 2.1.1
getPort :: Settings -> Port
getPort = settingsPort

-- | Get the interface to bind to.
--
-- Since 2.1.1
getHost :: Settings -> HostPreference
getHost = settingsHost

-- | Get the action on opening connection.
getOnOpen :: Settings -> SockAddr -> IO Bool
getOnOpen = settingsOnOpen

-- | Get the action on closeing connection.
getOnClose :: Settings -> SockAddr -> IO ()
getOnClose = settingsOnClose

-- | Get the exception handler.
getOnException :: Settings -> Maybe Request -> SomeException -> IO ()
getOnException = settingsOnException

-- | A code to install shutdown handler.
--
-- For instance, this code should set up a UNIX signal
-- handler. The handler should call the first argument,
-- which closes the listen socket, at shutdown.
--
-- Default: does not install any code.
--
-- Since 3.0.1
setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings
setInstallShutdownHandler x y = y { settingsInstallShutdownHandler = x }

-- | Default server name if application does not set one.
--
-- Since 3.0.2
setServerName :: ByteString -> Settings -> Settings
setServerName x y = y { settingsServerName = x }

-- | The maximum number of bytes to flush from an unconsumed request body.
--
-- By default, Warp does not flush the request body so that, if a large body is
-- present, the connection is simply terminated instead of wasting time and
-- bandwidth on transmitting it. However, some clients do not deal with that
-- situation well. You can either change this setting to @Nothing@ to flush the
-- entire body in all cases, or in your application ensure that you always
-- consume the entire request body.
--
-- Default: 8192 bytes.
--
-- Since 3.0.3
setMaximumBodyFlush :: Maybe Int -> Settings -> Settings
setMaximumBodyFlush x y
    | Just x' <- x, x' < 0 = error "setMaximumBodyFlush: must be positive"
    | otherwise = y { settingsMaximumBodyFlush = x }

-- | 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: void . forkIOWithUnmask
--
-- Since 3.0.4
setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings
setFork fork' s = s { settingsFork = fork' }

-- | Do not use the PROXY protocol.
--
-- Since 3.0.5
setProxyProtocolNone :: Settings -> Settings
setProxyProtocolNone y = y { settingsProxyProtocol = ProxyProtocolNone }

-- | Require PROXY header.
--
-- This is for cases where a "dumb" TCP/SSL proxy is being used, which cannot
-- add an @X-Forwarded-For@ HTTP header field but has enabled support for the
-- PROXY protocol.
--
-- See <http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt> and
-- <http://docs.aws.amazon.com/ElasticLoadBalancing/latest/DeveloperGuide/TerminologyandKeyConcepts.html#proxy-protocol>.
--
-- Only the human-readable header format (version 1) is supported. The binary
-- header format (version 2) is /not/ supported.
--
-- Since 3.0.5
setProxyProtocolRequired :: Settings -> Settings
setProxyProtocolRequired y = y { settingsProxyProtocol = ProxyProtocolRequired }

-- | Use the PROXY header if it exists, but also accept
-- connections without the header.  See 'setProxyProtocolRequired'.
--
-- WARNING: This is contrary to the PROXY protocol specification and
-- using it can indicate a security problem with your
-- architecture if the web server is directly accessable
-- to the public, since it would allow easy IP address
-- spoofing.  However, it can be useful in some cases,
-- such as if a load balancer health check uses regular
-- HTTP without the PROXY header, but proxied
-- connections /do/ include the PROXY header.
--
-- Since 3.0.5
setProxyProtocolOptional :: Settings -> Settings
setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }

-- | Size in bytes read to prevent Slowloris protection. Default value: 2048
--
-- Since 3.1.2
setSlowlorisSize :: Int -> Settings -> Settings
setSlowlorisSize x y = y { settingsSlowlorisSize = x }

-- | Disable HTTP2.
--
-- Since 3.1.7
setHTTP2Disabled :: Settings -> Settings
setHTTP2Disabled y = y { settingsHTTP2Enabled = False }

-- | Setting a log function.
--
-- Since 3.X.X
setLogger :: (Request -> H.Status -> Maybe Integer -> IO ())
          -> Settings -> Settings
setLogger lgr y = y { settingsLogger = lgr }

-- | Explicitly pause the slowloris timeout.
--
-- This is useful for cases where you partially consume a request body. For
-- more information, see <https://github.com/yesodweb/wai/issues/351>
--
-- Since 3.0.10
pauseTimeout :: Request -> IO ()
pauseTimeout = fromMaybe (return ()) . Vault.lookup pauseTimeoutKey . vault

-- | Getting file information of the target file.
--
--   This function first uses a stat(2) or similar system call
--   to obtain information of the target file, then registers
--   it into the internal cache.
--   From the next time, the information is obtained
--   from the cache. This reduces the overhead to call the system call.
--   The internal cache is refreshed every duration specified by
--   'setFileInfoCacheDuration'.
--
--   This function throws an 'IO' exception if the information is not
--   available. For instance, the target file does not exist.
--   If this function is used an a Request generated by a WAI
--   backend besides Warp, it also throws an 'IO' exception.
--
-- Since 3.1.10
getFileInfo :: Request -> FilePath -> IO FileInfo
getFileInfo = fromMaybe (\_ -> throwIO (userError "getFileInfo")) . Vault.lookup getFileInfoKey . vault