git.iko.soy/typeable/wai
on master help sign in
runSettings
04d6c1dMichael Snoyman
Network/Wai/Handler/Warp.hs+55−11
compare with master
unifiedsplit
@@ -27,6 +27,13 @@ module Network.Wai.Handler.Warp
27 run
27 run
28 , runEx
28 , runEx
29 , serveConnections
29 , serveConnections
30+ -- * Run a Warp server with full settings control
31+ , runSettings
32+ , Settings
33+ , defaultSettings
34+ , settingsPort
35+ , settingsOnException
36+ , settingsTimeout
30 -- * Datatypes
37 -- * Datatypes
31 , Port
38 , Port
32 , InvalidRequest (..)
39 , InvalidRequest (..)
@@ -53,7 +60,10 @@ import Network.Socket
53 ( accept, SockAddr
60 ( accept, SockAddr
54 )
61 )
55import qualified Network.Socket.ByteString as Sock
62import qualified Network.Socket.ByteString as Sock
63+import Control.Exception
56−import Control.Exception (bracket, finally, Exception, SomeException, catch)
64+ ( bracket, finally, Exception, SomeException, catch
65+ , fromException
66+ )
57import Control.Concurrent (forkIO)
67import Control.Concurrent (forkIO)
58import Data.Maybe (fromMaybe)
68import Data.Maybe (fromMaybe)
59
69
@@ -91,23 +101,30 @@ run = runEx (const $ return ())
91-- | Run an 'Application' on the given port, with the given exception handler.
101-- | Run an 'Application' on the given port, with the given exception handler.
92-- Please note that you will also receive 'InvalidRequest' exceptions.
102-- Please note that you will also receive 'InvalidRequest' exceptions.
93runEx :: (SomeException -> IO ()) -> Port -> Application -> IO ()
103runEx :: (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 ()
94#if WINDOWS
111#if WINDOWS
95−runEx onE port app = withSocketsDo $ do
112+runSettings set app = withSocketsDo $ do
96 var <- MV.newMVar Nothing
113 var <- MV.newMVar Nothing
97 let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
114 let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
98 _ <- forkIO $ bracket
115 _ <- forkIO $ bracket
99− (listenOn $ PortNumber $ fromIntegral port)
116+ (listenOn $ PortNumber $ fromIntegral $ settingsPort set)
100 (const clean)
117 (const clean)
101 (\s -> do
118 (\s -> do
102 MV.modifyMVar_ var (\_ -> return $ Just s)
119 MV.modifyMVar_ var (\_ -> return $ Just s)
103− serveConnections onE port app s)
120+ serveConnections' set app s)
104 forever (threadDelay maxBound) `finally` clean
121 forever (threadDelay maxBound) `finally` clean
105#else
122#else
106−runEx onE port =
123+runSettings set =
107 bracket
124 bracket
108− (listenOn $ PortNumber $ fromIntegral port)
125+ (listenOn $ PortNumber $ fromIntegral $ settingsPort set)
109 sClose .
126 sClose .
110− serveConnections onE port
127+ serveConnections' set
111#endif
128#endif
112
129
113type Port = Int
130type Port = Int
@@ -119,8 +136,17 @@ type Port = Int
119-- non-TCP socket, this can be a ficticious value.
136-- non-TCP socket, this can be a ficticious value.
120serveConnections :: (SomeException -> IO ())
137serveConnections :: (SomeException -> IO ())
121 -> Port -> Application -> Socket -> IO ()
138 -> Port -> Application -> Socket -> IO ()
122−serveConnections onE port app socket = do
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
123− tm <- T.initialize $ timeout * 1000000
149+ tm <- T.initialize $ settingsTimeout set * 1000000
124 forever $ do
150 forever $ do
125 (conn, sa) <- accept socket
151 (conn, sa) <- accept socket
126 _ <- forkIO $ do
152 _ <- forkIO $ do
@@ -154,11 +180,10 @@ parseRequest port remoteHost' = do
154 parseRequest' port headers' remoteHost'
180 parseRequest' port headers' remoteHost'
155
181
156-- FIXME come up with good values here
182-- FIXME come up with good values here
157−maxHeaders, maxHeaderLength, bytesPerRead, timeout :: Int
183+maxHeaders, maxHeaderLength, bytesPerRead :: Int
158maxHeaders = 30
184maxHeaders = 30
159maxHeaderLength = 1024
185maxHeaderLength = 1024
160bytesPerRead = 4096
186bytesPerRead = 4096
161−timeout = 1 -- seconds
162
187
163data InvalidRequest =
188data InvalidRequest =
164 NotEnoughLines [String]
189 NotEnoughLines [String]
@@ -403,3 +428,22 @@ iterSocket th sock =
403 liftIO $ Sock.sendMany sock xs
428 liftIO $ Sock.sendMany sock xs
404 liftIO $ T.tickle th
429 liftIO $ T.tickle th
405 E.continue step
430 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 ()