76d4748 · typeable/wai

git.iko.soy/typeable/wai

Don't have double content-length headers snoyberg/keter#52

Pinging @kazu-yamamoto. Can you review this patch? The issue is that, currently, any responseFile respone which sets content-length ends up with two content-length headers. I'm also going to patch wai-app-static to not provide a content-length header, since it's incorrect in the case of range requests.

commit76d474873e777a65649dcec295116e4b7a430506 authorMichael Snoyman <michael@snoyman.com> dateSun 19 Oct 2014, 23:56 (12 years ago) parent7880a55

3 files changed+29−6

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Response.hs+9−5 warp/test/ResponseSpec.hs+2−1 warp/test/RunSpec.hs+18

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

@@ -67,16 +67,17 @@ mapRight f eith = case eith of

6767

6868fileRange :: H.Status -> H.ResponseHeaders -> FilePath

6969 -> Maybe FilePart -> Maybe HeaderValue

70+ -> IndexedHeader

7071 -> IO (Either IOException

7172 (H.Status, H.ResponseHeaders, Integer, Integer))

72−fileRange s0 hs0 path mPart mRange =

73+fileRange s0 hs0 path mPart mRange rspidxhdr =

7374 mapRight (fileRangeSized . fromIntegral . P.fileSize) <$>

7475 try (P.getFileStatus path)

7576 where

7677 fileRangeSized :: Integer -> (H.Status, H.ResponseHeaders, Integer, Integer)

7778 fileRangeSized fileSize =

7879 let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange

79− hs1 = addContentLength len hs0

80+ hs1 = addContentLength rspidxhdr len hs0

8081 hs | isEntire = hs1

8182 | otherwise = addContentRange beg end fileSize hs1

8283 s | isEntire = s0

@@ -213,7 +214,7 @@ sendRsp :: Connection

213214 -> Rsp

214215 -> IO ()

215216sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do

216− ex <- fileRange s0 hs path mPart mRange

217+ ex <- fileRange s0 hs path mPart mRange rspidxhdr

217218 case ex of

218219 Left _ex ->

219220#ifdef WARP_DEBUG

@@ -228,6 +229,7 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do

228229 s2 = H.status404

229230 hs2 = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0

230231 body = fromByteString "File not found"

232+ rspidxhdr = indexResponseHeader hs0

231233

232234----------------------------------------------------------------

233235

@@ -356,8 +358,10 @@ addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs

356358addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders

357359addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs

358360

359−addContentLength :: Integer -> H.ResponseHeaders -> H.ResponseHeaders

360−addContentLength cl hdrs = (H.hContentLength, len) : hdrs

361+addContentLength :: IndexedHeader -> Integer -> H.ResponseHeaders -> H.ResponseHeaders

362+addContentLength rspidxhdr cl hdrs = case rspidxhdr ! idxContentLength of

363+ Nothing -> (H.hContentLength, len) : hdrs

364+ Just _ -> hdrs

361365 where

362366 len = B.pack $ show cl

363367

warp/test/ResponseSpec.hs+2−1

@@ -9,6 +9,7 @@ import Network (connectTo, PortID (PortNumber))

99import Network.HTTP.Types

1010import Network.Wai

1111import Network.Wai.Handler.Warp

12+import Network.Wai.Handler.Warp.Header (indexResponseHeader)

1213import Network.Wai.Handler.Warp.Response

1314import RunSpec (withApp)

1415import System.IO (hClose, hFlush)

@@ -74,7 +75,7 @@ testFileRange :: String

7475 -> Either String (Status, ResponseHeaders, Integer, Integer)

7576 -> Spec

7677testFileRange desc s rsphdr file mPart mRange ans = it desc $ do

77− eres <- fileRange s rsphdr file mPart mRange

78+ eres <- fileRange s rsphdr file mPart mRange (indexResponseHeader rsphdr)

7879 let res = case eres of

7980 Left e -> Left $ show e

8081 Right r -> Right r

warp/test/RunSpec.hs+18

@@ -378,6 +378,24 @@ spec = do

378378 Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

379379 HTTP.rspBody res `shouldBe` "HelloHelloHelloHello"

380380

381+ it "file with length: one content-length header" $ do

382+ let fp = "LICENSE"

383+ size <- fmap S.length $ S.readFile fp

384+ let app _ = ($ responseFile status200 [("content-length", S8.pack $ show size)] fp Nothing)

385+ withApp defaultSettings app $ \port -> do

386+ Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

387+ map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrContentLength res)

388+ `shouldBe` [show size]

389+

390+ it "file without length: one content-length header" $ do

391+ let fp = "LICENSE"

392+ size <- fmap S.length $ S.readFile fp

393+ let app _ = ($ responseFile status200 [] fp Nothing)

394+ withApp defaultSettings app $ \port -> do

395+ Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

396+ map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrContentLength res)

397+ `shouldBe` [show size]

398+

381399consumeBody :: IO ByteString -> IO [ByteString]

382400consumeBody body =

383401 loop id