19cadaa · typeable/wai

git.iko.soy/typeable/wai

More fixes and a test for yesodweb/yesod#692

commit19cadaa11b40f074e30a265862b5be3238450550 authorMichael Snoyman <michael@snoyman.com> dateMon 17 Mar 2014, 08:53 (13 years ago) parentd07309e

2 files changed+20−5

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Response.hs+7−5 warp/test/RunSpec.hs+13

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

@@ -169,7 +169,7 @@ sendResponse conn ii restore req reqidxhdr response = restore $ do

169169 rspidxhdr = indexResponseHeader hs0

170170 th = threadHandle ii

171171 dc = dateCacher ii

172− addServerAndDate = addDate dc . addServer rspidxhdr

172+ addServerAndDate = addDate dc rspidxhdr . addServer rspidxhdr

173173 mRange = reqidxhdr ! idxRange

174174 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr

175175 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo

@@ -347,10 +347,12 @@ addContentRange beg end total hdrs = (hContentRange, range) : hdrs

347347 ( '/'

348348 : showInt total ""))

349349

350−addDate :: D.DateCache -> H.ResponseHeaders -> IO H.ResponseHeaders

351−addDate dc hdrs = do

352− gmtdate <- D.getDate dc

353− return $ (H.hDate, gmtdate) : hdrs

350+addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders

351+addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of

352+ Nothing -> do

353+ gmtdate <- D.getDate dc

354+ return $ (H.hDate, gmtdate) : hdrs

355+ Just _ -> return hdrs

354356

355357----------------------------------------------------------------

356358

warp/test/RunSpec.hs+13

@@ -25,6 +25,7 @@ import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

2525import Control.Exception.Lifted (bracket, try, IOException, onException)

2626import Data.Conduit.Network (bindPort)

2727import Network.Socket (sClose)

28+import qualified Network.HTTP as HTTP

2829

2930main :: IO ()

3031main = hspec spec

@@ -293,3 +294,15 @@ spec = do

293294 threadDelay 5000000

294295 front <- I.readIORef ifront

295296 S.concat (front []) `shouldBe` bs

297+

298+ it "only one date and server header" $ do

299+ let app _ = return $ responseLBS status200

300+ [ ("server", "server")

301+ , ("date", "date")

302+ ] ""

303+ withApp defaultSettings app $ \port -> do

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

305+ map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrServer res)

306+ `shouldBe` ["server"]

307+ map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrDate res)

308+ `shouldBe` ["date"]