0585865 · typeable/wai

git.iko.soy/typeable/wai

Clean up code a bit after writing clarified some things

commit05858658177618c590e3c751e7619723eb1546cd authorIan Duncan <ian@iankduncan.com> dateFri 19 Apr 2019, 16:37 (7 years ago) parentc18590a

3 files changed+30−33

compare with master

unifiedsplit

warp/ChangeLog.md+3−1 warp/Network/Wai/Handler/Warp/Response.hs+9−12 warp/Network/Wai/Handler/Warp/Run.hs+18−20

warp/ChangeLog.md+3−1

@@ -3,10 +3,12 @@

33* Internally, use `lookupEnv` instead of `getEnvironment` to get the

44 value of the `PORT` environment variable

55 [#736](https://github.com/yesodweb/wai/pull/736)

6−

76* Throw 413 for too large payload

87* Throw 431 for too large headers

98 [#741](https://github.com/yesodweb/wai/pull/741)

9+* Use exception response handler in HTTP/2 & improve connection preservation

10+ in HTTP/1.x if uncaught exceptions are thrown in an `Application`.

11+ [#738](https://github.com/yesodweb/wai/pull/738)

1012

1113## 3.2.26

1214

warp/Network/Wai/Handler/Warp/Response.hs+9−12

@@ -11,7 +11,6 @@ module Network.Wai.Handler.Warp.Response (

1111 , hasBody

1212 , replaceHeader

1313 , addServer -- testing

14− , infoFromRequest -- for determining whether to close connections on error.

1514 ) where

1615

1716import Data.ByteString.Builder.HTTP.Chunked (chunkedTransferEncoding, chunkedTransferTerminator)

@@ -212,14 +211,13 @@ sendRsp conn _ ver s hs RspNoBody = do

212211

213212sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

214213 header <- composeHeaderBuilder ver s hs needsChunked

215− let bdy

216− | needsChunked = chunkedTransferEncoding body <> chunkedTransferTerminator

217− | otherwise = body

214+ let hdrBdy

215+ | needsChunked = header <> chunkedTransferEncoding body

216+ <> chunkedTransferTerminator

217+ | otherwise = header <> body

218218 buffer = connWriteBuffer conn

219219 size = connBufferSize conn

220− toBufIOWith buffer size (connSendAll conn) header

221− E.handle (E.throwIO . ExceptionInsideResponseBody) $

222− toBufIOWith buffer size (connSendAll conn) bdy

220+ toBufIOWith buffer size (connSendAll conn) hdrBdy

223221 return (Just s, Nothing) -- fixme: can we tell the actual sent bytes?

224222

225223----------------------------------------------------------------

@@ -240,11 +238,10 @@ sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

240238 | needsChunked = send . chunkedTransferEncoding

241239 | otherwise = send

242240 send header

243− E.handle (E.throwIO . ExceptionInsideResponseBody) $ do

244− streamingBody sendChunk (sendChunk flush)

245− when needsChunked $ send chunkedTransferTerminator

246− mbs <- finish

247− maybe (return ()) (sendFragment conn th) mbs

241+ streamingBody sendChunk (sendChunk flush)

242+ when needsChunked $ send chunkedTransferTerminator

243+ mbs <- finish

244+ maybe (return ()) (sendFragment conn th) mbs

248245 return (Just s, Nothing) -- fixme: can we tell the actual sent bytes?

249246

250247----------------------------------------------------------------

warp/Network/Wai/Handler/Warp/Run.hs+18−20

@@ -396,9 +396,11 @@ serveConnection conn ii1 origAddr transport settings app = do

396396

397397 sendErrorResponse req istatus e = do

398398 status <- readIORef istatus

399− when (shouldSendErrorResponse e && status) $ do

400− let ii = toInternalInfo ii1 0 -- dummy

401− void $ sendResponse settings conn ii req defaultIndexRequestHeader (return S.empty) (errorResponse e)

399+ if (shouldSendErrorResponse e && status)

400+ then do

401+ let ii = toInternalInfo ii1 0 -- dummy

402+ sendResponse settings conn ii req defaultIndexRequestHeader (return S.empty) (errorResponse e)

403+ else return False

402404

403405 dummyreq addr = defaultRequest { remoteHost = addr }

404406

@@ -409,22 +411,9 @@ serveConnection conn ii1 origAddr transport settings app = do

409411 let req = req' { isSecure = isTransportSecure transport }

410412 keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii

411413 `E.catch` \e -> do

412− -- Attempt to unwrap exception and use it to determine

413− -- safety of keeping exception alive

414− case fromException e of

415− Nothing -> do

416− -- Call the user-supplied exception handlers, passing the request.

417− sendErrorResponse req istatus e

418− settingsOnException settings (Just req) e

419− -- Don't throw the error again to prevent calling settingsOnException twice.

420− let (isPersist, _) = infoFromRequest req idxhdr

421− return isPersist

422− Just (ExceptionInsideResponseBody e') -> do

423− -- Call the user-supplied exception handlers, passing the request.

424− sendErrorResponse req istatus e'

425− settingsOnException settings (Just req) e'

426− -- Don't throw the error again to prevent calling settingsOnException twice.

427− return False

414+ settingsOnException settings (Just req) e

415+ -- Don't throw the error again to prevent calling settingsOnException twice.

416+ return False

428417

429418 -- When doing a keep-alive connection, the other side may just

430419 -- close the connection. We don't want to treat that as an

@@ -444,7 +433,7 @@ serveConnection conn ii1 origAddr transport settings app = do

444433 -- creating the request, we need to make sure that we don't get

445434 -- an async exception before calling the ResponseSource.

446435 keepAliveRef <- newIORef $ error "keepAliveRef not filled"

447− _ <- app req $ \res -> do

436+ r <- E.try $ app req $ \res -> do

448437 T.resume th

449438 -- FIXME consider forcing evaluation of the res here to

450439 -- send more meaningful error messages to the user.

@@ -453,6 +442,15 @@ serveConnection conn ii1 origAddr transport settings app = do

453442 keepAlive <- sendResponse settings conn ii req idxhdr (readSource src) res

454443 writeIORef keepAliveRef keepAlive

455444 return ResponseReceived

445+ case r of

446+ Right ResponseReceived -> return ()

447+ Left e@(SomeException _)

448+ | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'

449+ | otherwise -> do

450+ keepAlive <- sendErrorResponse req istatus e

451+ settingsOnException settings (Just req) e

452+ writeIORef keepAliveRef keepAlive

453+

456454 keepAlive <- readIORef keepAliveRef

457455

458456 -- We just send a Response and it takes a time to