{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Network.Wai.Handler.Warp (
run,
runEnv,
runSettings,
runSettingsSocket,
Settings,
defaultSettings,
setPort,
setHost,
setOnException,
setOnExceptionResponse,
setOnOpen,
setOnClose,
setTimeout,
setManager,
setFdCacheDuration,
setFileInfoCacheDuration,
setBeforeMainLoop,
setNoParsePath,
setInstallShutdownHandler,
setServerName,
setMaximumBodyFlush,
setFork,
setAccept,
setProxyProtocolNone,
setProxyProtocolRequired,
setProxyProtocolOptional,
setSlowlorisSize,
setHTTP2Disabled,
setLogger,
setServerPushLogger,
setGracefulShutdownTimeout,
setGracefulCloseTimeout1,
setGracefulCloseTimeout2,
setMaxTotalHeaderLength,
setAltSvc,
setMaxBuilderResponseBufferSize,
getPort,
getHost,
getOnOpen,
getOnClose,
getOnException,
getGracefulShutdownTimeout,
getGracefulCloseTimeout1,
getGracefulCloseTimeout2,
defaultOnException,
defaultShouldDisplayException,
defaultOnExceptionResponse,
exceptionResponseForDebug,
HostPreference,
Port,
InvalidRequest (..),
pauseTimeout,
FileInfo (..),
getFileInfo,
#ifdef MIN_VERSION_crypton_x509
clientCertificate,
#endif
withApplication,
withApplicationSettings,
testWithApplication,
testWithApplicationSettings,
openFreePort,
warpVersion,
HTTP2Data,
http2dataPushPromise,
http2dataTrailers,
defaultHTTP2Data,
getHTTP2Data,
setHTTP2Data,
modifyHTTP2Data,
PushPromise,
promisedPath,
promisedFile,
promisedResponseHeaders,
promisedWeight,
defaultPushPromise,
) where
import Data.Streaming.Network (HostPreference)
import qualified Data.Vault.Lazy as Vault
import UnliftIO.Exception (SomeException, throwIO)
#ifdef MIN_VERSION_crypton_x509
import Data.X509
#endif
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr, Socket)
import Network.Wai (Request, Response, vault)
import System.TimeManager
import Network.Wai.Handler.Warp.FileInfoCache
import Network.Wai.Handler.Warp.HTTP2.Request (
getHTTP2Data,
modifyHTTP2Data,
setHTTP2Data,
)
import Network.Wai.Handler.Warp.HTTP2.Types
import Network.Wai.Handler.Warp.Imports
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.Types hiding (getFileInfo)
import Network.Wai.Handler.Warp.WithApplication
setPort :: Port -> Settings -> Settings
setPort :: Int -> Settings -> Settings
setPort Int
x Settings
y = Settings
y{settingsPort = x}
setHost :: HostPreference -> Settings -> Settings
setHost :: HostPreference -> Settings -> Settings
setHost HostPreference
x Settings
y = Settings
y{settingsHost = x}
setOnException
:: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
setOnException Maybe Request -> SomeException -> IO ()
x Settings
y = Settings
y{settingsOnException = x}
setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
setOnExceptionResponse SomeException -> Response
x Settings
y = Settings
y{settingsOnExceptionResponse = x}
setOnOpen :: (SockAddr -> IO Bool) -> Settings -> Settings
setOnOpen :: (SockAddr -> IO Bool) -> Settings -> Settings
setOnOpen SockAddr -> IO Bool
x Settings
y = Settings
y{settingsOnOpen = x}
setOnClose :: (SockAddr -> IO ()) -> Settings -> Settings
setOnClose :: (SockAddr -> IO ()) -> Settings -> Settings
setOnClose SockAddr -> IO ()
x Settings
y = Settings
y{settingsOnClose = x}
setTimeout :: Int -> Settings -> Settings
setTimeout :: Int -> Settings -> Settings
setTimeout Int
x Settings
y = Settings
y{settingsTimeout = x}
setManager :: Manager -> Settings -> Settings
setManager :: Manager -> Settings -> Settings
setManager Manager
x Settings
y = Settings
y{settingsManager = Just x}
setFdCacheDuration :: Int -> Settings -> Settings
setFdCacheDuration :: Int -> Settings -> Settings
setFdCacheDuration Int
x Settings
y = Settings
y{settingsFdCacheDuration = x}
setFileInfoCacheDuration :: Int -> Settings -> Settings
setFileInfoCacheDuration :: Int -> Settings -> Settings
setFileInfoCacheDuration Int
x Settings
y = Settings
y{settingsFileInfoCacheDuration = x}
setBeforeMainLoop :: IO () -> Settings -> Settings
setBeforeMainLoop :: IO () -> Settings -> Settings
setBeforeMainLoop IO ()
x Settings
y = Settings
y{settingsBeforeMainLoop = x}
setNoParsePath :: Bool -> Settings -> Settings
setNoParsePath :: Bool -> Settings -> Settings
setNoParsePath Bool
x Settings
y = Settings
y{settingsNoParsePath = x}
getPort :: Settings -> Port
getPort :: Settings -> Int
getPort = Settings -> Int
settingsPort
getHost :: Settings -> HostPreference
getHost :: Settings -> HostPreference
getHost = Settings -> HostPreference
settingsHost
getOnOpen :: Settings -> SockAddr -> IO Bool
getOnOpen :: Settings -> SockAddr -> IO Bool
getOnOpen = Settings -> SockAddr -> IO Bool
settingsOnOpen
getOnClose :: Settings -> SockAddr -> IO ()
getOnClose :: Settings -> SockAddr -> IO ()
getOnClose = Settings -> SockAddr -> IO ()
settingsOnClose
getOnException :: Settings -> Maybe Request -> SomeException -> IO ()
getOnException :: Settings -> Maybe Request -> SomeException -> IO ()
getOnException = Settings -> Maybe Request -> SomeException -> IO ()
settingsOnException
getGracefulShutdownTimeout :: Settings -> Maybe Int
getGracefulShutdownTimeout :: Settings -> Maybe Int
getGracefulShutdownTimeout = Settings -> Maybe Int
settingsGracefulShutdownTimeout
setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings
setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings
setInstallShutdownHandler IO () -> IO ()
x Settings
y = Settings
y{settingsInstallShutdownHandler = x}
setServerName :: ByteString -> Settings -> Settings
setServerName :: ByteString -> Settings -> Settings
setServerName ByteString
x Settings
y = Settings
y{settingsServerName = x}
setMaximumBodyFlush :: Maybe Int -> Settings -> Settings
setMaximumBodyFlush :: Maybe Int -> Settings -> Settings
setMaximumBodyFlush Maybe Int
x Settings
y
| Just Int
x' <- Maybe Int
x, Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Settings
forall a. HasCallStack => [Char] -> a
error [Char]
"setMaximumBodyFlush: must be positive"
| Bool
otherwise = Settings
y{settingsMaximumBodyFlush = x}
setFork
:: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings
setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> Settings -> Settings
setFork ((forall a. IO a -> IO a) -> IO ()) -> IO ()
fork' Settings
s = Settings
s{settingsFork = fork'}
setAccept :: (Socket -> IO (Socket, SockAddr)) -> Settings -> Settings
setAccept :: (Socket -> IO (Socket, SockAddr)) -> Settings -> Settings
setAccept Socket -> IO (Socket, SockAddr)
accept' Settings
s = Settings
s{settingsAccept = accept'}
setProxyProtocolNone :: Settings -> Settings
setProxyProtocolNone :: Settings -> Settings
setProxyProtocolNone Settings
y = Settings
y{settingsProxyProtocol = ProxyProtocolNone}
setProxyProtocolRequired :: Settings -> Settings
setProxyProtocolRequired :: Settings -> Settings
setProxyProtocolRequired Settings
y = Settings
y{settingsProxyProtocol = ProxyProtocolRequired}
setProxyProtocolOptional :: Settings -> Settings
setProxyProtocolOptional :: Settings -> Settings
setProxyProtocolOptional Settings
y = Settings
y{settingsProxyProtocol = ProxyProtocolOptional}
setSlowlorisSize :: Int -> Settings -> Settings
setSlowlorisSize :: Int -> Settings -> Settings
setSlowlorisSize Int
x Settings
y = Settings
y{settingsSlowlorisSize = x}
setHTTP2Disabled :: Settings -> Settings
setHTTP2Disabled :: Settings -> Settings
setHTTP2Disabled Settings
y = Settings
y{settingsHTTP2Enabled = False}
setLogger
:: (Request -> H.Status -> Maybe Integer -> IO ())
-> Settings
-> Settings
setLogger :: (Request -> Status -> Maybe Integer -> IO ())
-> Settings -> Settings
setLogger Request -> Status -> Maybe Integer -> IO ()
lgr Settings
y = Settings
y{settingsLogger = lgr}
setServerPushLogger
:: (Request -> ByteString -> Integer -> IO ())
-> Settings
-> Settings
setServerPushLogger :: (Request -> ByteString -> Integer -> IO ()) -> Settings -> Settings
setServerPushLogger Request -> ByteString -> Integer -> IO ()
lgr Settings
y = Settings
y{settingsServerPushLogger = lgr}
setGracefulShutdownTimeout
:: Maybe Int
-> Settings
-> Settings
setGracefulShutdownTimeout :: Maybe Int -> Settings -> Settings
setGracefulShutdownTimeout Maybe Int
time Settings
y = Settings
y{settingsGracefulShutdownTimeout = time}
setMaxTotalHeaderLength :: Int -> Settings -> Settings
Int
maxTotalHeaderLength Settings
settings =
Settings
settings
{ settingsMaxTotalHeaderLength = maxTotalHeaderLength
}
setAltSvc :: ByteString -> Settings -> Settings
setAltSvc :: ByteString -> Settings -> Settings
setAltSvc ByteString
altsvc Settings
settings = Settings
settings{settingsAltSvc = Just altsvc}
setMaxBuilderResponseBufferSize :: Int -> Settings -> Settings
setMaxBuilderResponseBufferSize :: Int -> Settings -> Settings
setMaxBuilderResponseBufferSize Int
maxRspBufSize Settings
settings = Settings
settings{settingsMaxBuilderResponseBufferSize = maxRspBufSize}
pauseTimeout :: Request -> IO ()
pauseTimeout :: Request -> IO ()
pauseTimeout = IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Maybe (IO ()) -> IO ())
-> (Request -> Maybe (IO ())) -> Request -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (IO ()) -> Vault -> Maybe (IO ())
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key (IO ())
pauseTimeoutKey (Vault -> Maybe (IO ()))
-> (Request -> Vault) -> Request -> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Vault
vault
getFileInfo :: Request -> FilePath -> IO FileInfo
getFileInfo :: Request -> [Char] -> IO FileInfo
getFileInfo =
([Char] -> IO FileInfo)
-> Maybe ([Char] -> IO FileInfo) -> [Char] -> IO FileInfo
forall a. a -> Maybe a -> a
fromMaybe (\[Char]
_ -> IOError -> IO FileInfo
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ([Char] -> IOError
userError [Char]
"getFileInfo"))
(Maybe ([Char] -> IO FileInfo) -> [Char] -> IO FileInfo)
-> (Request -> Maybe ([Char] -> IO FileInfo))
-> Request
-> [Char]
-> IO FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key ([Char] -> IO FileInfo)
-> Vault -> Maybe ([Char] -> IO FileInfo)
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key ([Char] -> IO FileInfo)
getFileInfoKey
(Vault -> Maybe ([Char] -> IO FileInfo))
-> (Request -> Vault) -> Request -> Maybe ([Char] -> IO FileInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Vault
vault
setGracefulCloseTimeout1 :: Int -> Settings -> Settings
setGracefulCloseTimeout1 :: Int -> Settings -> Settings
setGracefulCloseTimeout1 Int
x Settings
y = Settings
y{settingsGracefulCloseTimeout1 = x}
getGracefulCloseTimeout1 :: Settings -> Int
getGracefulCloseTimeout1 :: Settings -> Int
getGracefulCloseTimeout1 = Settings -> Int
settingsGracefulCloseTimeout1
setGracefulCloseTimeout2 :: Int -> Settings -> Settings
setGracefulCloseTimeout2 :: Int -> Settings -> Settings
setGracefulCloseTimeout2 Int
x Settings
y = Settings
y{settingsGracefulCloseTimeout2 = x}
getGracefulCloseTimeout2 :: Settings -> Int
getGracefulCloseTimeout2 :: Settings -> Int
getGracefulCloseTimeout2 = Settings -> Int
settingsGracefulCloseTimeout2
#ifdef MIN_VERSION_crypton_x509
clientCertificate :: Request -> Maybe CertificateChain
clientCertificate :: Request -> Maybe CertificateChain
clientCertificate = Maybe (Maybe CertificateChain) -> Maybe CertificateChain
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe CertificateChain) -> Maybe CertificateChain)
-> (Request -> Maybe (Maybe CertificateChain))
-> Request
-> Maybe CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (Maybe CertificateChain)
-> Vault -> Maybe (Maybe CertificateChain)
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key (Maybe CertificateChain)
getClientCertificateKey (Vault -> Maybe (Maybe CertificateChain))
-> (Request -> Vault) -> Request -> Maybe (Maybe CertificateChain)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Vault
vault
#endif