5eb213f · typeable/wai

git.iko.soy/typeable/wai

Merge pull request #177 from singpolyma/pass-request-to-exception-handler

Pass the Request to the exception handler

commit5eb213fd1087bfe2f8d5e36049f01865ee1404ce authorMichael Snoyman <michael@snoyman.com> dateTue 1 Oct 2013, 05:34 (13 years ago) parent5cf67e9 b2fa01e

4 files changed+11−8

compare with master

unifiedsplit

wai-handler-launch/Network/Wai/Handler/Launch.hs+1−1 warp/Network/Wai/Handler/Warp/Run.hs+6−3 warp/Network/Wai/Handler/Warp/Settings.hs+3−3 warp/test/RunSpec.hs+1−1

wai-handler-launch/Network/Wai/Handler/Launch.hs+1−1

@@ -140,7 +140,7 @@ runUrlPort port url app = do

140140 x <- newIORef True

141141 _ <- forkIO $ Warp.runSettings Warp.defaultSettings

142142 { Warp.settingsPort = port

143− , Warp.settingsOnException = const $ return ()

143+ , Warp.settingsOnException = (\_ _ -> return ())

144144 , Warp.settingsHost = "*4"

145145 } $ ping x app

146146 launch port url

warp/Network/Wai/Handler/Warp/Run.hs+6−3

@@ -5,6 +5,7 @@ module Network.Wai.Handler.Warp.Run where

66import Control.Concurrent (threadDelay, forkIOWithUnmask)

77import Control.Exception

8+import qualified Control.Exception.Lifted as Lifted

89import Control.Monad (forever, when, unless, void)

910import Control.Monad.IO.Class (MonadIO, liftIO)

1011import qualified Control.Monad.Trans.Resource as Res

@@ -200,7 +201,7 @@ runSettingsConnectionMaker set getConn app = do

200201 in unmask .

201202 -- Call the user-supplied on exception code if any

202203 -- exceptions are thrown.

203− handle onE .

204+ handle (onE Nothing) .

204205

205206 -- Call the user-supplied code for connection open and close events

206207 bracket_ onOpen onClose $

@@ -210,7 +211,7 @@ runSettingsConnectionMaker set getConn app = do

210211 where

211212 -- FIXME: only IOEception is caught. What about other exceptions?

212213 getConnLoop = getConn `catch` \(e :: IOException) -> do

213− onE (toException e)

214+ onE Nothing (toException e)

214215 -- "resource exhausted (Too many open files)" may happen by accept().

215216 -- Wait a second hoping that resource will be available.

216217 threadDelay 1000000

@@ -241,9 +242,11 @@ serveConnection timeoutHandle settings cleaner app conn remoteHost' =

241242 | otherwise = f env

242243 th = threadHandle cleaner

243244

245+ onE env = liftIO . settingsOnException settings env

246+

244247 serveConnection'' fromClient internalState = do

245248 (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

247250 Nothing -> do

248251 -- Let the application run for as long as it wants

249252 liftIO $ T.pause th

warp/Network/Wai/Handler/Warp/Settings.hs+3−3

@@ -21,7 +21,7 @@ import System.IO.Error (ioeGetErrorType)

2121data Settings = Settings

2222 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000

2323 , 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.

2525 , settingsOnOpen :: IO () -- ^ What to do when a connection is open. Default: do nothing.

2626 , settingsOnClose :: IO () -- ^ What to do when a connection is close. Default: do nothing.

2727 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30

@@ -67,8 +67,8 @@ defaultSettings = Settings

6767 , settingsServerName = S8.pack $ "Warp/" ++ warpVersion

6868 }

6969

70−defaultExceptionHandler :: SomeException -> IO ()

71−defaultExceptionHandler e = throwIO e `catches` handlers

70+defaultExceptionHandler :: Maybe Request -> SomeException -> IO ()

71+defaultExceptionHandler _ e = throwIO e `catches` handlers

7272 where

7373 handlers = [Handler ah, Handler ih, Handler oh, Handler sh]

7474

warp/test/RunSpec.hs+1−1

@@ -118,7 +118,7 @@ runTerminateTest :: InvalidRequest

118118runTerminateTest expected input = do

119119 ref <- I.newIORef Nothing

120120 withApp defaultSettings

121− { settingsOnException = \e -> I.writeIORef ref $ Just e

121+ { settingsOnException = \_ e -> I.writeIORef ref $ Just e

122122 } dummyApp $ \port -> do

123123 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port

124124 hPutStr handle input