on master help sign in
Better async exception handling for Source and Raw
commit0408c10e5d01a4f0319fb417d61b79e1c66c7ac6 authorMichael Snoyman <michael@snoyman.com> dateThu 6 Mar 2014, 20:18 (13 years ago) parentb256831
1 file changed+21−13
warp/Network/Wai/Handler/Warp/Response.hs+21−13
warp/Network/Wai/Handler/Warp/Response.hs+21−13
@@ -156,14 +156,14 @@ sendResponse :: Connection
156156 -> Maybe ByteString -- ^ leftovers from header parsing
157157 -> Response -- ^ HTTP response including status code and response header.
158158 -> IO Bool -- ^ Returing True if the connection is persistent.
159−sendResponse conn ii restore req reqidxhdr leftover' response = restore $ do
159+sendResponse conn ii restore req reqidxhdr leftover' response = do
160160 hs <- addServerAndDate hs0
161161 if hasBody s req then do
162− sendRsp conn ver s hs rsp
162+ sendRsp conn ver s hs restore rsp
163163 T.tickle th
164164 return ret
165165 else do
166− sendResponseNoBody conn ver s hs response
166+ sendResponseNoBody conn ver s hs restore response
167167 T.tickle th
168168 return isPersist
169169 where
@@ -201,12 +201,13 @@ sendRsp :: Connection
201201 -> H.HttpVersion
202202 -> H.Status
203203 -> H.ResponseHeaders
204+ -> (forall a. IO a -> IO a) -- ^ restore
204205 -> Rsp
205206 -> IO ()
206−sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do
207+sendRsp conn ver s0 hs0 restore (RspFile path mPart mRange hook) = restore $ do
207208 ex <- fileRange s0 hs path mPart mRange
208209 case ex of
209− Left _ -> sendRsp conn ver s2 hs2 (RspBuilder body True)
210+ Left _ -> sendRsp conn ver s2 hs2 id (RspBuilder body True)
210211 Right (s, hs1, beg, len) -> do
211212 lheader <- composeHeader ver s hs1
212213 connSendFile conn path beg len hook [lheader]
@@ -218,7 +219,7 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do
218219
219220----------------------------------------------------------------
220221
221−sendRsp conn ver s hs (RspBuilder body needsChunked) = do
222+sendRsp conn ver s hs restore (RspBuilder body needsChunked) = restore $ do
222223 header <- composeHeaderBuilder ver s hs needsChunked
223224 let hdrBdy
224225 | needsChunked = header <> chunkedTransferEncoding body
@@ -230,7 +231,8 @@ sendRsp conn ver s hs (RspBuilder body needsChunked) = do
230231
231232----------------------------------------------------------------
232233
233−sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush $ \bodyFlush -> do
234+sendRsp conn ver s hs restore (RspSource withBodyFlush needsChunked th) =
235+ withBodyFlush $ \bodyFlush -> restore $ do
234236 header <- composeHeaderBuilder ver s hs needsChunked
235237 let src = yield header >> cbody bodyFlush
236238 buffer <- toBlazeBuffer (connBuffer conn) (connBufferSize conn)
@@ -247,8 +249,8 @@ sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush
247249
248250----------------------------------------------------------------
249251
250−sendRsp conn _ _ _ (RspRaw withApp mbs) =
251− withApp $ \app -> app src sink
252+sendRsp conn _ _ _ restore (RspRaw withApp mbs) =
253+ withApp $ \app -> restore $ app src sink
252254 where
253255 sink = CL.mapM_ (connSendAll conn)
254256 src = do
@@ -265,13 +267,19 @@ sendResponseNoBody :: Connection
265267 -> H.HttpVersion
266268 -> H.Status
267269 -> H.ResponseHeaders
270+ -> (forall a. IO a -> IO a) -- ^ restore
268271 -> Response
269272 -> IO ()
270−sendResponseNoBody conn ver s hs (ResponseSource _ _ withBodyFlush) =
273+sendResponseNoBody conn ver s hs restore (ResponseSource _ _ withBodyFlush) =
271274 withBodyFlush $ \_bodyFlush ->
272− composeHeader ver s hs >>= connSendAll conn
273−sendResponseNoBody conn ver s hs _ =
274− composeHeader ver s hs >>= connSendAll conn
275+ restore $ composeHeader ver s hs >>= connSendAll conn
276+sendResponseNoBody conn ver s hs restore (ResponseRaw withRaw _) =
277+ withRaw $ \_raw ->
278+ restore $ composeHeader ver s hs >>= connSendAll conn
279+sendResponseNoBody conn ver s hs restore ResponseBuilder{} =
280+ restore $ composeHeader ver s hs >>= connSendAll conn
281+sendResponseNoBody conn ver s hs restore ResponseFile{} =
282+ restore $ composeHeader ver s hs >>= connSendAll conn
275283
276284----------------------------------------------------------------
277285----------------------------------------------------------------