git.iko.soy/typeable/wai
on master help sign in
refactoring respondOnException.
4a2278aKazu Yamamoto
warp/Network/Wai/Handler/Warp/Run.hs+8−11
compare with master
unifiedsplit
@@ -233,10 +233,17 @@ serveConnection :: T.Handle
233 -> Cleaner
233 -> Cleaner
234 -> Application -> Connection -> SockAddr-> IO ()
234 -> Application -> Connection -> SockAddr-> IO ()
235serveConnection timeoutHandle settings cleaner app conn remoteHost' =
235serveConnection timeoutHandle settings cleaner app conn remoteHost' =
236− respondOnException settings cleaner conn remoteHost' $ serveConnection'' $ connSource conn th
236+ (serveConnection'' $ connSource conn th) `onException` send500
237 where
237 where
238 th = threadHandle cleaner
238 th = threadHandle cleaner
239
239
240+ send500 = void . mask $ \restore ->
241+ sendResponse settings cleaner dummyreq conn restore internalError
242+
243+ dummyreq = defaultRequest { remoteHost = remoteHost' }
244+
245+ internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
246+
240 serveConnection'' fromClient = do
247 serveConnection'' fromClient = do
241 (env, getSource) <- parseRequest conn timeoutHandle remoteHost' fromClient
248 (env, getSource) <- parseRequest conn timeoutHandle remoteHost' fromClient
242 case settingsIntercept settings env of
249 case settingsIntercept settings env of
@@ -271,16 +278,6 @@ serveConnection timeoutHandle settings cleaner app conn remoteHost' =
271 ResumableSource fromClient' _ <- liftIO getSource
278 ResumableSource fromClient' _ <- liftIO getSource
272 intercept fromClient' conn
279 intercept fromClient' conn
273
280
274−respondOnException :: Settings -> Cleaner -> Connection -> SockAddr -> IO () -> IO ()
275−respondOnException settings cleaner conn remoteHost' io = io `catch` \e@(SomeException _) -> do
276− mask $ \restore ->
277− void $ sendResponse settings cleaner defaultRequest
278− { remoteHost = remoteHost'
279− } conn restore internalError
280− throwIO e
281− where
282− internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
283−
284connSource :: Connection -> T.Handle -> Source IO ByteString
281connSource :: Connection -> T.Handle -> Source IO ByteString
285connSource Connection { connRecv = recv } th = src
282connSource Connection { connRecv = recv } th = src
286 where
283 where