9edc2aa · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

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

9edc2aaMichael Snoyman12 years ago

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

compare with master

unifiedsplit

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

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

69 -> Maybe FilePart -> Maybe HeaderValue

70− -> IndexedHeader

71 -> IO (Either IOException

70 -> IO (Either IOException

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

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

73−fileRange s0 hs0 path mPart mRange rspidxhdr =

72+fileRange s0 hs0 path mPart mRange =

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

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

75 try (P.getFileStatus path)

74 try (P.getFileStatus path)

76 where

75 where

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

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

78 fileRangeSized fileSize =

77 fileRangeSized fileSize =

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

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

80− hs1 = addContentLength rspidxhdr len hs0

79+ hs1 = addContentLength len hs0

81 hs | isEntire = hs1

80 hs | isEntire = hs1

82 | otherwise = addContentRange beg end fileSize hs1

81 | otherwise = addContentRange beg end fileSize hs1

83 s | isEntire = s0

82 s | isEntire = s0

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

214 -> Rsp

213 -> Rsp

215 -> IO ()

214 -> IO ()

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

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

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

216+ ex <- fileRange s0 hs path mPart mRange

218 case ex of

217 case ex of

219 Left _ex ->

218 Left _ex ->

220#ifdef WARP_DEBUG

219#ifdef WARP_DEBUG

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

229 s2 = H.status404

228 s2 = H.status404

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

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

231 body = fromByteString "File not found"

230 body = fromByteString "File not found"

232− rspidxhdr = indexResponseHeader hs0

233

231

234----------------------------------------------------------------

232----------------------------------------------------------------

235

233

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

358addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders

356addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders

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

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

360

358

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

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

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

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

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

364− Just _ -> hdrs

365 where

361 where

366 len = B.pack $ show cl

362 len = B.pack $ show cl

367

363

warp/test/ResponseSpec.hs+1−2

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

9import Network.HTTP.Types

10import Network.Wai

11import Network.Wai.Handler.Warp

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

13import Network.Wai.Handler.Warp.Response

12import Network.Wai.Handler.Warp.Response

14import RunSpec (withApp)

13import RunSpec (withApp)

15import System.IO (hClose, hFlush)

14import System.IO (hClose, hFlush)

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

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

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

76 -> Spec

75 -> Spec

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

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

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

77+ eres <- fileRange s rsphdr file mPart mRange

79 let res = case eres of

78 let res = case eres of

80 Left e -> Left $ show e

79 Left e -> Left $ show e

81 Right r -> Right r

80 Right r -> Right r

warp/test/RunSpec.hs−18

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

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

379 HTTP.rspBody res `shouldBe` "HelloHelloHelloHello"

380

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−

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

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

400consumeBody body =

382consumeBody body =

401 loop id

383 loop id