@@ -27,6 +27,13 @@ module Network.Wai.Handler.Warp
2727 run
2828 , runEx
2929 , serveConnections
30+ -- * Run a Warp server with full settings control
31+ , runSettings
32+ , Settings
33+ , defaultSettings
34+ , settingsPort
35+ , settingsOnException
36+ , settingsTimeout
3037 -- * Datatypes
3138 , Port
3239 , InvalidRequest (..)
@@ -53,7 +60,10 @@ import Network.Socket
5360 ( accept, SockAddr
5461 )
5562import qualified Network.Socket.ByteString as Sock
56−import Control.Exception (bracket, finally, Exception, SomeException, catch)
63+import Control.Exception
64+ ( bracket, finally, Exception, SomeException, catch
65+ , fromException
66+ )
5767import Control.Concurrent (forkIO)
5868import Data.Maybe (fromMaybe)
5969
@@ -91,23 +101,30 @@ run = runEx (const $ return ())
91101-- | Run an 'Application' on the given port, with the given exception handler.
92102-- Please note that you will also receive 'InvalidRequest' exceptions.
93103runEx :: (SomeException -> IO ()) -> Port -> Application -> IO ()
104+runEx onE port = runSettings Settings
105+ { settingsPort = port
106+ , settingsOnException = onE
107+ , settingsTimeout = 30
108+ }
109+
110+runSettings :: Settings -> Application -> IO ()
94111#if WINDOWS
95−runEx onE port app = withSocketsDo $ do
112+runSettings set app = withSocketsDo $ do
96113 var <- MV.newMVar Nothing
97114 let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
98115 _ <- forkIO $ bracket
99− (listenOn $ PortNumber $ fromIntegral port)
116+ (listenOn $ PortNumber $ fromIntegral $ settingsPort set)
100117 (const clean)
101118 (\s -> do
102119 MV.modifyMVar_ var (\_ -> return $ Just s)
103− serveConnections onE port app s)
120+ serveConnections' set app s)
104121 forever (threadDelay maxBound) `finally` clean
105122#else
106−runEx onE port =
123+runSettings set =
107124 bracket
108− (listenOn $ PortNumber $ fromIntegral port)
125+ (listenOn $ PortNumber $ fromIntegral $ settingsPort set)
109126 sClose .
110− serveConnections onE port
127+ serveConnections' set
111128#endif
112129
113130type Port = Int
@@ -119,8 +136,17 @@ type Port = Int
119136-- non-TCP socket, this can be a ficticious value.
120137serveConnections :: (SomeException -> IO ())
121138 -> Port -> Application -> Socket -> IO ()
122−serveConnections onE port app socket = do
123− tm <- T.initialize $ timeout * 1000000
139+serveConnections onE port = serveConnections' defaultSettings
140+ { settingsOnException = onE
141+ , settingsPort = port
142+ }
143+
144+serveConnections' :: Settings
145+ -> Application -> Socket -> IO ()
146+serveConnections' set app socket = do
147+ let onE = settingsOnException set
148+ port = settingsPort set
149+ tm <- T.initialize $ settingsTimeout set * 1000000
124150 forever $ do
125151 (conn, sa) <- accept socket
126152 _ <- forkIO $ do
@@ -154,11 +180,10 @@ parseRequest port remoteHost' = do
154180 parseRequest' port headers' remoteHost'
155181
156182-- FIXME come up with good values here
157−maxHeaders, maxHeaderLength, bytesPerRead, timeout :: Int
183+maxHeaders, maxHeaderLength, bytesPerRead :: Int
158184maxHeaders = 30
159185maxHeaderLength = 1024
160186bytesPerRead = 4096
161−timeout = 1 -- seconds
162187
163188data InvalidRequest =
164189 NotEnoughLines [String]
@@ -403,3 +428,22 @@ iterSocket th sock =
403428 liftIO $ Sock.sendMany sock xs
404429 liftIO $ T.tickle th
405430 E.continue step
431+
432+data Settings = Settings
433+ { settingsPort :: Int
434+ , settingsOnException :: SomeException -> IO ()
435+ , settingsTimeout :: Int -- ^ seconds
436+ }
437+
438+defaultSettings :: Settings
439+defaultSettings = Settings
440+ { settingsPort = 3000
441+ , settingsOnException = \e ->
442+ case fromException e of
443+ Just x -> go x
444+ Nothing -> print e
445+ , settingsTimeout = 30
446+ }
447+ where
448+ go :: InvalidRequest -> IO ()
449+ go _ = return ()