3a9eb8c · typeable/wai

git.iko.soy/typeable/wai

Merge branch 'warp-2.0'

Conflicts: warp/test/RunSpec.hs warp/warp.cabal

commit3a9eb8c8d114f53fc07d48d7ed08420cb433eedc authorMichael Snoyman <michael@snoyman.com> dateMon 17 Mar 2014, 08:54 (13 years ago) parent1ba0026 19cadaa

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

@@ -173,7 +173,7 @@ sendResponse conn ii restore req reqidxhdr leftover' response = do

173173 rspidxhdr = indexResponseHeader hs0

174174 th = threadHandle ii

175175 dc = dateCacher ii

176− addServerAndDate = addDate dc . addServer rspidxhdr

176+ addServerAndDate = addDate dc rspidxhdr . addServer rspidxhdr

177177 mRange = reqidxhdr ! idxRange

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

179179 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo

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

378378 ( '/'

379379 : showInt total ""))

380380

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

382−addDate dc hdrs = do

383− gmtdate <- D.getDate dc

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

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

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

383+ Nothing -> do

384+ gmtdate <- D.getDate dc

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

386+ Just _ -> return hdrs

385387

386388----------------------------------------------------------------

387389

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

@@ -309,3 +310,15 @@ spec = do

309310 hPutStr handle "67890"

310311 hFlush handle

311312 timeout 100000 (S.hGet handle 10) >>= (`shouldBe` Just "6677889900")

313+

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

315+ let app _ = return $ responseLBS status200

316+ [ ("server", "server")

317+ , ("date", "date")

318+ ] ""

319+ withApp defaultSettings app $ \port -> do

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

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

322+ `shouldBe` ["server"]

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

324+ `shouldBe` ["date"]