on master help sign in
Warp test suite passes again
e67d64cMichael Snoyman
warp/Network/Wai/Handler/Warp/Response.hs+4−20
@@ -167,7 +167,7 @@ sendResponse conn ii req reqidxhdr src response = do
167 T.tickle th
167 T.tickle th
168 return ret
168 return ret
169 else do
169 else do
170− sendResponseNoBody conn ver s hs response
170+ sendResponseNoBody conn ver s hs
171 T.tickle th
171 T.tickle th
172 return isPersist
172 return isPersist
173 where
173 where
@@ -196,7 +196,7 @@ sendResponse conn ii req reqidxhdr src response = do
196
196
197data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) (IO ())
197data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) (IO ())
198 | RspBuilder Builder Bool
198 | RspBuilder Builder Bool
199− | RspStream ((Maybe Builder -> IO ()) -> IO ()) Bool T.Handle
199+ | RspStream StreamingBody Bool T.Handle
200 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
200 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
201
201
202----------------------------------------------------------------
202----------------------------------------------------------------
@@ -250,9 +250,7 @@ sendRsp conn ver s hs (RspStream withBodyFlush needsChunked th) = do
250 loop
250 loop
251 loop
251 loop
252 addChunk header
252 addChunk header
253− withBodyFlush $ \mbuilder -> addChunk $ case mbuilder of
253+ withBodyFlush (addChunk . chunkedTransferEncoding) (addChunk flush)
254− Nothing -> flush
255− Just builder -> chunkedTransferEncoding builder
256 when needsChunked $ addChunk chunkedTransferTerminator
254 when needsChunked $ addChunk chunkedTransferTerminator
257 mbs <- finish
255 mbs <- finish
258 maybe (return ()) (connSink conn th) mbs
256 maybe (return ()) (connSink conn th) mbs
@@ -274,22 +272,8 @@ sendResponseNoBody :: Connection
274 -> H.HttpVersion
272 -> H.HttpVersion
275 -> H.Status
273 -> H.Status
276 -> H.ResponseHeaders
274 -> H.ResponseHeaders
277− -> Response
278 -> IO ()
275 -> IO ()
279−sendResponseNoBody conn ver s hs (ResponseStream _ _ withBodyFlush) = do
280− -- Allow the application to free resources
281− withBodyFlush $ const $ return ()
282−
283− composeHeader ver s hs >>= connSendAll conn
284−sendResponseNoBody conn ver s hs (ResponseRaw withRaw _) = do
285− -- Allow the application to free resources
286− withRaw (return S.empty) (const $ return ())
287−
288− composeHeader ver s hs >>= connSendAll conn
289−sendResponseNoBody conn ver s hs ResponseBuilder{} =
290− composeHeader ver s hs >>= connSendAll conn
291−sendResponseNoBody conn ver s hs ResponseFile{} =
292− composeHeader ver s hs >>= connSendAll conn
276+sendResponseNoBody conn ver s hs = composeHeader ver s hs >>= connSendAll conn
293
277
294----------------------------------------------------------------
278----------------------------------------------------------------
295----------------------------------------------------------------
279----------------------------------------------------------------
warp/test/RunSpec.hs+2−2
@@ -354,11 +354,11 @@ spec = do
354 `shouldBe` ["date"]
354 `shouldBe` ["date"]
355
355
356 it "streaming echo #249" $ do
356 it "streaming echo #249" $ do
357− let app req f = f $ responseStream status200 [] $ \write -> do
357+ let app req f = f $ responseStream status200 [] $ \write _ -> do
358 let loop = do
358 let loop = do
359 bs <- requestBody req
359 bs <- requestBody req
360 unless (S.null bs) $ do
360 unless (S.null bs) $ do
361− write $ Just $ fromByteString bs
361+ write $ fromByteString bs
362 loop
362 loop
363 loop
363 loop
364 withApp defaultSettings app $ \port -> do
364 withApp defaultSettings app $ \port -> do