git.iko.soy/typeable/wai
on master help sign in
Merge pull request #177 from singpolyma/pass-request-to-exception-handler
5eb213fMichael Snoyman
wai-handler-launch/Network/Wai/Handler/Launch.hs+1−1
compare with master
unifiedsplit
@@ -140,7 +140,7 @@ runUrlPort port url app = do
140 x <- newIORef True
140 x <- newIORef True
141 _ <- forkIO $ Warp.runSettings Warp.defaultSettings
141 _ <- forkIO $ Warp.runSettings Warp.defaultSettings
142 { Warp.settingsPort = port
142 { Warp.settingsPort = port
143− , Warp.settingsOnException = const $ return ()
143+ , Warp.settingsOnException = (\_ _ -> return ())
144 , Warp.settingsHost = "*4"
144 , Warp.settingsHost = "*4"
145 } $ ping x app
145 } $ ping x app
146 launch port url
146 launch port url
warp/Network/Wai/Handler/Warp/Run.hs+6−3
@@ -5,6 +5,7 @@ module Network.Wai.Handler.Warp.Run where
5
5
6import Control.Concurrent (threadDelay, forkIOWithUnmask)
6import Control.Concurrent (threadDelay, forkIOWithUnmask)
7import Control.Exception
7import Control.Exception
8+import qualified Control.Exception.Lifted as Lifted
8import Control.Monad (forever, when, unless, void)
9import Control.Monad (forever, when, unless, void)
9import Control.Monad.IO.Class (MonadIO, liftIO)
10import Control.Monad.IO.Class (MonadIO, liftIO)
10import qualified Control.Monad.Trans.Resource as Res
11import qualified Control.Monad.Trans.Resource as Res
@@ -200,7 +201,7 @@ runSettingsConnectionMaker set getConn app = do
200 in unmask .
201 in unmask .
201 -- Call the user-supplied on exception code if any
202 -- Call the user-supplied on exception code if any
202 -- exceptions are thrown.
203 -- exceptions are thrown.
203− handle onE .
204+ handle (onE Nothing) .
204
205
205 -- Call the user-supplied code for connection open and close events
206 -- Call the user-supplied code for connection open and close events
206 bracket_ onOpen onClose $
207 bracket_ onOpen onClose $
@@ -210,7 +211,7 @@ runSettingsConnectionMaker set getConn app = do
210 where
211 where
211 -- FIXME: only IOEception is caught. What about other exceptions?
212 -- FIXME: only IOEception is caught. What about other exceptions?
212 getConnLoop = getConn `catch` \(e :: IOException) -> do
213 getConnLoop = getConn `catch` \(e :: IOException) -> do
213− onE (toException e)
214+ onE Nothing (toException e)
214 -- "resource exhausted (Too many open files)" may happen by accept().
215 -- "resource exhausted (Too many open files)" may happen by accept().
215 -- Wait a second hoping that resource will be available.
216 -- Wait a second hoping that resource will be available.
216 threadDelay 1000000
217 threadDelay 1000000
@@ -241,9 +242,11 @@ serveConnection timeoutHandle settings cleaner app conn remoteHost' =
241 | otherwise = f env
242 | otherwise = f env
242 th = threadHandle cleaner
243 th = threadHandle cleaner
243
244
245+ onE env = liftIO . settingsOnException settings env
246+
244 serveConnection'' fromClient internalState = do
247 serveConnection'' fromClient internalState = do
245 (env, getSource) <- parseRequest conn timeoutHandle internalState remoteHost' fromClient
248 (env, getSource) <- parseRequest conn timeoutHandle internalState remoteHost' fromClient
246− case settingsIntercept settings env of
249+ Lifted.handle (onE (Just env)) $ case settingsIntercept settings env of
247 Nothing -> do
250 Nothing -> do
248 -- Let the application run for as long as it wants
251 -- Let the application run for as long as it wants
249 liftIO $ T.pause th
252 liftIO $ T.pause th
warp/Network/Wai/Handler/Warp/Settings.hs+3−3
@@ -21,7 +21,7 @@ import System.IO.Error (ioeGetErrorType)
21data Settings = Settings
21data Settings = Settings
22 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
22 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
23 , settingsHost :: HostPreference -- ^ Default value: HostIPv4
23 , settingsHost :: HostPreference -- ^ Default value: HostIPv4
24− , 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.
24+ , 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.
25 , settingsOnOpen :: IO () -- ^ What to do when a connection is open. Default: do nothing.
25 , settingsOnOpen :: IO () -- ^ What to do when a connection is open. Default: do nothing.
26 , settingsOnClose :: IO () -- ^ What to do when a connection is close. Default: do nothing.
26 , settingsOnClose :: IO () -- ^ What to do when a connection is close. Default: do nothing.
27 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
27 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
@@ -67,8 +67,8 @@ defaultSettings = Settings
67 , settingsServerName = S8.pack $ "Warp/" ++ warpVersion
67 , settingsServerName = S8.pack $ "Warp/" ++ warpVersion
68 }
68 }
69
69
70−defaultExceptionHandler :: SomeException -> IO ()
70+defaultExceptionHandler :: Maybe Request -> SomeException -> IO ()
71−defaultExceptionHandler e = throwIO e `catches` handlers
71+defaultExceptionHandler _ e = throwIO e `catches` handlers
72 where
72 where
73 handlers = [Handler ah, Handler ih, Handler oh, Handler sh]
73 handlers = [Handler ah, Handler ih, Handler oh, Handler sh]
74
74
warp/test/RunSpec.hs+1−1
@@ -118,7 +118,7 @@ runTerminateTest :: InvalidRequest
118runTerminateTest expected input = do
118runTerminateTest expected input = do
119 ref <- I.newIORef Nothing
119 ref <- I.newIORef Nothing
120 withApp defaultSettings
120 withApp defaultSettings
121− { settingsOnException = \e -> I.writeIORef ref $ Just e
121+ { settingsOnException = \_ e -> I.writeIORef ref $ Just e
122 } dummyApp $ \port -> do
122 } dummyApp $ \port -> do
123 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
123 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
124 hPutStr handle input
124 hPutStr handle input