b2fa01e · typeable/wai

git.iko.soy/typeable/wai

Pass the Request to the exception handler

We change the exception handler to take Maybe Request, because some exceptions will happen before we have managed to parse a Request yet. Add an exception handler to everything just after the Request is parsed that does pass the Request through. This allows the exception handler to give more useful data to the application developer. Closes #173

commitb2fa01e715b0703676e819f73db7a84ad451c9b7 authorStephen Paul Weber <singpolyma@singpolyma.net> dateSat 28 Sep 2013, 10:11 (13 years ago) parent5cf67e9

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