7c73d7e · typeable/wai

git.iko.soy/typeable/wai

Still make an HTTP response after an exception

The previous behaviour was to just close the connection with no output. This sends an HTTP 500 response with a generic message. If there was an exception partway through a previous response, this might put some garbage at the end of that, but this is a better situation for the user than a silent failure, as they still have something to report to the developer. Exceptions are rethrown so that normal exception handling may continue. Closes #174

commit7c73d7ee020267c7e96136554e146efd31983a99 authorStephen Paul Weber <singpolyma@singpolyma.net> dateWed 25 Sep 2013, 17:47 (13 years ago) parentaa6face

1 file changed+13−1

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Run.hs+13−1

warp/Network/Wai/Handler/Warp/Run.hs+13−1

@@ -1,4 +1,5 @@

11{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

23{-# LANGUAGE ScopedTypeVariables #-}

45module Network.Wai.Handler.Warp.Run where

@@ -18,6 +19,8 @@ import Network (sClose, Socket)

1819import Network.Sendfile

1920import Network.Socket (accept, SockAddr)

2021import qualified Network.Socket.ByteString as Sock

22+import Data.Monoid (mempty)

23+import qualified Network.HTTP.Types as H

2124import Network.Wai

2225import Network.Wai.Handler.Warp.Request

2326import Network.Wai.Handler.Warp.Response

@@ -233,7 +236,8 @@ serveConnection :: T.Handle

233236 -> Cleaner

234237 -> Port -> Application -> Connection -> SockAddr-> IO ()

235238serveConnection timeoutHandle settings cleaner port app conn remoteHost' =

236− runResourceT serveConnection'

239+ respondOnException settings cleaner conn remoteHost' $

240+ runResourceT serveConnection'

237241 where

238242 innerRunResourceT

239243 | settingsResourceTPerRequest settings = lift . runResourceT

@@ -265,6 +269,14 @@ serveConnection timeoutHandle settings cleaner port app conn remoteHost' =

265269 ResumableSource fromClient' _ <- liftIO getSource

266270 intercept fromClient' conn

267271

272+respondOnException :: Settings -> Cleaner -> Connection -> SockAddr -> IO () -> IO ()

273+respondOnException settings cleaner conn remoteHost' io = io `catch` \e@(SomeException _) -> do

274+ _ <- runResourceT $ sendResponse settings cleaner blankRequest conn internalError

275+ throwIO e

276+ where

277+ blankRequest = Request H.methodGet H.http10 mempty mempty mempty 0 [] False remoteHost' [] [] (return mempty) mempty (KnownLength 0)

278+ internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"

279+

268280connSource :: Connection -> T.Handle -> Source (ResourceT IO) ByteString

269281connSource Connection { connRecv = recv } th = src

270282 where