1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-} 2{-# LANGUAGE PatternGuards, RankNTypes #-} 3{-# LANGUAGE ImpredicativeTypes, CPP #-} 4{-# LANGUAGE MagicHash, UnboxedTuples #-} 5 6module Network.Wai.Handler.Warp.Settings where 7 8import GHC.IO (unsafeUnmask, IO (IO)) 9import GHC.Prim (fork#) 10import UnliftIO (SomeException, fromException) 11import qualified Data.ByteString.Char8 as C8 12import qualified Data.ByteString.Builder as Builder 13import Data.ByteString.Lazy (fromStrict) 14import Data.Streaming.Network (HostPreference) 15import qualified Data.Text as T 16import qualified Data.Text.IO as TIO 17import Data.Version (showVersion) 18import GHC.IO.Exception (IOErrorType(..), AsyncException (ThreadKilled)) 19import qualified Network.HTTP.Types as H 20import Network.HTTP2.Frame (HTTP2Error (..), ErrorCodeId (..)) 21import Network.Socket (SockAddr) 22import Network.Wai 23import qualified Paths_warp 24import System.IO (stderr) 25import System.IO.Error (ioeGetErrorType) 26import System.TimeManager 27 28import Network.Wai.Handler.Warp.Imports 29import Network.Wai.Handler.Warp.Types 30 31-- | Various Warp server settings. This is purposely kept as an abstract data 32-- type so that new settings can be added without breaking backwards 33-- compatibility. In order to create a 'Settings' value, use 'defaultSettings' 34-- and the various \'set\' functions to modify individual fields. For example: 35-- 36-- > setTimeout 20 defaultSettings 37data Settings = Settings 38 { settingsPort :: Port -- ^ Port to listen on. Default value: 3000 39 , settingsHost :: HostPreference -- ^ Default value: HostIPv4 40 , 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. 41 , settingsOnExceptionResponse :: SomeException -> Response 42 -- ^ A function to create `Response` when an exception occurs. 43 -- 44 -- Default: 500, text/plain, \"Something went wrong\" 45 -- 46 -- Since 2.0.3 47 , 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'. 48 , settingsOnClose :: SockAddr -> IO () -- ^ What to do when a connection is close. Default: do nothing. 49 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30 50 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing' 51 , settingsFdCacheDuration :: Int -- ^ Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used. Default value: 0 52 , settingsFileInfoCacheDuration :: Int -- ^ Cache duration time of file information in seconds. 0 means that the cache mechanism is not used. Default value: 0 53 , settingsBeforeMainLoop :: IO () 54 -- ^ Code to run after the listening socket is ready but before entering 55 -- the main event loop. Useful for signaling to tests that they can start 56 -- running, or to drop permissions after binding to a restricted port. 57 -- 58 -- Default: do nothing. 59 -- 60 -- Since 1.3.6 61 62 , settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO () 63 -- ^ Code to fork a new thread to accept a connection. 64 -- 65 -- This may be useful if you need OS bound threads, or if 66 -- you wish to develop an alternative threading model. 67 -- 68 -- Default: 'defaultFork' 69 -- 70 -- Since 3.0.4 71 72 , settingsNoParsePath :: Bool 73 -- ^ Perform no parsing on the rawPathInfo. 74 -- 75 -- This is useful for writing HTTP proxies. 76 -- 77 -- Default: False 78 -- 79 -- Since 2.0.3 80 , settingsInstallShutdownHandler :: IO () -> IO () 81 -- ^ An action to install a handler (e.g. Unix signal handler) 82 -- to close a listen socket. 83 -- The first argument is an action to close the listen socket. 84 -- 85 -- Default: no action 86 -- 87 -- Since 3.0.1 88 , settingsServerName :: ByteString 89 -- ^ Default server name if application does not set one. 90 -- 91 -- Since 3.0.2 92 , settingsMaximumBodyFlush :: Maybe Int 93 -- ^ See @setMaximumBodyFlush@. 94 -- 95 -- Since 3.0.3 96 , settingsProxyProtocol :: ProxyProtocol 97 -- ^ Specify usage of the PROXY protocol. 98 -- 99 -- Since 3.0.5 100 , settingsSlowlorisSize :: Int 101 -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048 102 -- 103 -- Since 3.1.2 104 , settingsHTTP2Enabled :: Bool 105 -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True 106 -- 107 -- Since 3.1.7 108 , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO () 109 -- ^ A log function. Default: no action. 110 -- 111 -- Since 3.1.10 112 , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO () 113 -- ^ A HTTP/2 server push log function. Default: no action. 114 -- 115 -- Since 3.2.7 116 , settingsGracefulShutdownTimeout :: Maybe Int 117 -- ^ An optional timeout to limit the time (in seconds) waiting for 118 -- a graceful shutdown of the web server. 119 -- 120 -- Since 3.2.8 121 , settingsGracefulCloseTimeout1 :: Int 122 -- ^ A timeout to limit the time (in milliseconds) waiting for 123 -- FIN for HTTP/1.x. 0 means uses immediate close. 124 -- Default: 0. 125 -- 126 -- Since 3.3.5 127 , settingsGracefulCloseTimeout2 :: Int 128 -- ^ A timeout to limit the time (in milliseconds) waiting for 129 -- FIN for HTTP/2. 0 means uses immediate close. 130 -- Default: 2000. 131 -- 132 -- Since 3.3.5 133 , settingsMaxTotalHeaderLength :: Int 134 -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x. 135 -- 136 -- Since 3.3.8 137 , settingsAltSvc :: Maybe ByteString 138 -- ^ Specify the header value of Alternative Services (AltSvc:). 139 -- 140 -- Default: Nothing 141 -- 142 -- Since 3.3.11 143 } 144 145-- | Specify usage of the PROXY protocol. 146data ProxyProtocol = ProxyProtocolNone 147 -- ^ See @setProxyProtocolNone@. 148 | ProxyProtocolRequired 149 -- ^ See @setProxyProtocolRequired@. 150 | ProxyProtocolOptional 151 -- ^ See @setProxyProtocolOptional@. 152 153-- | The default settings for the Warp server. See the individual settings for 154-- the default value. 155defaultSettings :: Settings 156defaultSettings = Settings 157 { settingsPort = 3000 158 , settingsHost = "*4" 159 , settingsOnException = defaultOnException 160 , settingsOnExceptionResponse = defaultOnExceptionResponse 161 , settingsOnOpen = const $ return True 162 , settingsOnClose = const $ return () 163 , settingsTimeout = 30 164 , settingsManager = Nothing 165 , settingsFdCacheDuration = 0 166 , settingsFileInfoCacheDuration = 0 167 , settingsBeforeMainLoop = return () 168 , settingsFork = defaultFork 169 , settingsNoParsePath = False 170 , settingsInstallShutdownHandler = const $ return () 171 , settingsServerName = C8.pack $ "Warp/" ++ showVersion Paths_warp.version 172 , settingsMaximumBodyFlush = Just 8192 173 , settingsProxyProtocol = ProxyProtocolNone 174 , settingsSlowlorisSize = 2048 175 , settingsHTTP2Enabled = True 176 , settingsLogger = \_ _ _ -> return () 177 , settingsServerPushLogger = \_ _ _ -> return () 178 , settingsGracefulShutdownTimeout = Nothing 179 , settingsGracefulCloseTimeout1 = 0 180 , settingsGracefulCloseTimeout2 = 2000 181 , settingsMaxTotalHeaderLength = 50 * 1024 182 , settingsAltSvc = Nothing 183 } 184 185-- | Apply the logic provided by 'defaultOnException' to determine if an 186-- exception should be shown or not. The goal is to hide exceptions which occur 187-- under the normal course of the web server running. 188-- 189-- Since 2.1.3 190defaultShouldDisplayException :: SomeException -> Bool 191defaultShouldDisplayException se 192 | Just ThreadKilled <- fromException se = False 193 | Just (_ :: InvalidRequest) <- fromException se = False 194 | Just (ioeGetErrorType -> et) <- fromException se 195 , et == ResourceVanished || et == InvalidArgument = False 196 | Just TimeoutThread <- fromException se = False 197 | otherwise = True 198 199-- | Printing an exception to standard error 200-- if `defaultShouldDisplayException` returns `True`. 201-- 202-- Since: 3.1.0 203defaultOnException :: Maybe Request -> SomeException -> IO () 204defaultOnException _ e = 205 when (defaultShouldDisplayException e) 206 $ TIO.hPutStrLn stderr $ T.pack $ show e 207 208-- | Sending 400 for bad requests. 209-- Sending 500 for internal server errors. 210-- Since: 3.1.0 211-- Sending 413 for too large payload. 212-- Sending 431 for too large headers. 213-- Since 3.2.27 214defaultOnExceptionResponse :: SomeException -> Response 215defaultOnExceptionResponse e 216 | Just (_ :: InvalidRequest) <- 217 fromException e = responseLBS H.badRequest400 218 [(H.hContentType, "text/plain; charset=utf-8")] 219 "Bad Request" 220 | Just (ConnectionError (UnknownErrorCode 413) t) <- 221 fromException e = responseLBS H.status413 222 [(H.hContentType, "text/plain; charset=utf-8")] 223 (fromStrict t) 224 | Just (ConnectionError (UnknownErrorCode 431) t) <- 225 fromException e = responseLBS H.status431 226 [(H.hContentType, "text/plain; charset=utf-8")] 227 (fromStrict t) 228 | otherwise = responseLBS H.internalServerError500 229 [(H.hContentType, "text/plain; charset=utf-8")] 230 "Something went wrong" 231 232-- | Exception handler for the debugging purpose. 233-- 500, text/plain, a showed exception. 234-- 235-- Since: 2.0.3.2 236exceptionResponseForDebug :: SomeException -> Response 237exceptionResponseForDebug e = 238 responseBuilder H.internalServerError500 239 [(H.hContentType, "text/plain; charset=utf-8")] 240 $ "Exception: " <> Builder.stringUtf8 (show e) 241 242-- | Similar to @forkIOWithUnmask@, but does not set up the default exception handler. 243-- 244-- Since Warp will always install its own exception handler in forked threads, this provides 245-- a minor optimization. 246-- 247-- For inspiration of this function, see @rawForkIO@ in the @async@ package. 248-- 249-- @since 3.3.17 250defaultFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO () 251defaultFork io = 252 IO $ \s0 -> 253 case (fork# (io unsafeUnmask) s0) of 254 (# s1, _tid #) -> 255 (# s1, () #) 256