@@ -25,10 +25,9 @@
2525module Network.Wai.Handler.Warp
2626 ( -- * Run a Warp server
2727 run
28− , runEx
29− , serveConnections
30− -- * Run a Warp server with full settings control
3128 , runSettings
29+ , runSettingsSocket
30+ -- * Settings
3231 , Settings
3332 , defaultSettings
3433 , settingsPort
@@ -47,7 +46,6 @@ module Network.Wai.Handler.Warp
4746
4847import Prelude hiding (catch, lines)
4948import Network.Wai
50−import qualified System.IO
5149
5250import Data.ByteString (ByteString)
5351import qualified Data.ByteString as S
@@ -89,6 +87,7 @@ import Data.List (foldl')
8987import Control.Monad (forever)
9088import qualified Network.HTTP.Types as H
9189import qualified Data.CaseInsensitive as CI
90+import System.IO (hPutStrLn, stderr)
9291
9392#if WINDOWS
9493import Control.Concurrent (threadDelay)
@@ -96,19 +95,12 @@ import qualified Control.Concurrent.MVar as MV
9695import Network.Socket (withSocketsDo)
9796#endif
9897
99−-- | Run an 'Application' on the given port, ignoring all exceptions.
98+-- | Run an 'Application' on the given port. This calls 'runSettings' with
99+-- 'defaultSettings'.
100100run :: Port -> Application -> IO ()
101−run = runEx (const $ return ())
102−
103−-- | Run an 'Application' on the given port, with the given exception handler.
104−-- Please note that you will also receive 'InvalidRequest' exceptions.
105−runEx :: (SomeException -> IO ()) -> Port -> Application -> IO ()
106−runEx onE port = runSettings Settings
107− { settingsPort = port
108− , settingsOnException = onE
109− , settingsTimeout = 30
110− }
101+run p = runSettings defaultSettings { settingsPort = p }
111102
103+-- | Run a Warp server with the given settings.
112104runSettings :: Settings -> Application -> IO ()
113105#if WINDOWS
114106runSettings set app = withSocketsDo $ do
@@ -119,33 +111,26 @@ runSettings set app = withSocketsDo $ do
119111 (const clean)
120112 (\s -> do
121113 MV.modifyMVar_ var (\_ -> return $ Just s)
122− serveConnections' set app s)
114+ runSettingsSocket set s app)
123115 forever (threadDelay maxBound) `finally` clean
124116#else
125117runSettings set =
126118 bracket
127119 (listenOn $ PortNumber $ fromIntegral $ settingsPort set)
128120 sClose .
129− serveConnections' set
121+ (flip (runSettingsSocket set))
130122#endif
131123
132124type Port = Int
133125
134−-- | Runs a server, listening on the given socket. The user is responsible for
135−-- closing the socket after 'runWithSocket' completes. You must also supply a
136−-- 'Port' argument for use in the 'serverPort' record; however, this field is
137−-- only used for informational purposes. If you are in fact listening on a
138−-- non-TCP socket, this can be a ficticious value.
139−serveConnections :: (SomeException -> IO ())
140− -> Port -> Application -> Socket -> IO ()
141−serveConnections onE port = serveConnections' defaultSettings
142− { settingsOnException = onE
143− , settingsPort = port
144− }
145−
146−serveConnections' :: Settings
147− -> Application -> Socket -> IO ()
148−serveConnections' set app socket = do
126+-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
127+-- one. This allows the user to provide, for example, Unix named socket, which
128+-- can be used when reverse HTTP proxying into your application.
129+--
130+-- Note that the 'settingsPort' will still be passed to 'Application's via the
131+-- 'serverPort' record.
132+runSettingsSocket :: Settings -> Socket -> Application -> IO ()
133+runSettingsSocket set socket app = do
149134 let onE = settingsOnException set
150135 port = settingsPort set
151136 tm <- T.initialize $ settingsTimeout set * 1000000
@@ -194,10 +179,8 @@ data InvalidRequest =
194179 NotEnoughLines [String]
195180 | BadFirstLine String
196181 | NonHttp
197− | TooManyHeaders
198182 | IncompleteHeaders
199183 | OverLargeHeader
200− | SocketTimeout
201184 deriving (Show, Typeable, Eq)
202185instance Exception InvalidRequest
203186
@@ -235,7 +218,6 @@ parseRequest' port (firstLine:otherLines) remoteHost' = do
235218 , serverPort = port
236219 , requestHeaders = heads
237220 , isSecure = False
238− , errorHandler = System.IO.hPutStr System.IO.stderr
239221 , remoteHost = remoteHost'
240222 })
241223
@@ -419,19 +401,27 @@ iterSocket th sock =
419401 liftIO $ T.pause th
420402 E.continue step
421403
404+-- | Various Warp server settings. This is purposely kept as an abstract data
405+-- type so that new settings can be added without breaking backwards
406+-- compatibility. In order to create a 'Settings' value, use 'defaultSettings'
407+-- and record syntax to modify individual records. For example:
408+--
409+-- > defaultSettings { settingsTimeout = 20 }
422410data Settings = Settings
423− { settingsPort :: Int
424− , settingsOnException :: SomeException -> IO ()
425− , settingsTimeout :: Int -- ^ seconds
411+ { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
412+ , settingsOnException :: 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.
413+ , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
426414 }
427415
416+-- | The default settings for the Warp server. See the individual settings for
417+-- the default value.
428418defaultSettings :: Settings
429419defaultSettings = Settings
430420 { settingsPort = 3000
431421 , settingsOnException = \e ->
432422 case fromException e of
433423 Just x -> go x
434− Nothing -> print e
424+ Nothing -> hPutStrLn stderr $ show e
435425 , settingsTimeout = 30
436426 }
437427 where