3a9eb8c · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge branch 'warp-2.0'

3a9eb8cMichael Snoyman13 years ago

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

compare with master

unifiedsplit

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

173 rspidxhdr = indexResponseHeader hs0

174 th = threadHandle ii

175 dc = dateCacher ii

176− addServerAndDate = addDate dc . addServer rspidxhdr

176+ addServerAndDate = addDate dc rspidxhdr . addServer rspidxhdr

177 mRange = reqidxhdr ! idxRange

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

179 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo

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

378 ( '/'

379 : showInt total ""))

380

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

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

382−addDate dc hdrs = do

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

383+ Nothing -> do

383− gmtdate <- D.getDate dc

384+ gmtdate <- D.getDate dc

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

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

386+ Just _ -> return hdrs

385

387

386----------------------------------------------------------------

388----------------------------------------------------------------

387

389

warp/test/RunSpec.hs+13

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

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

26import Data.Conduit.Network (bindPort)

27import Network.Socket (sClose)

28+import qualified Network.HTTP as HTTP

29main :: IO ()

30main :: IO ()

30main = hspec spec

31main = hspec spec

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

309 hPutStr handle "67890"

310 hPutStr handle "67890"

310 hFlush handle

311 hFlush handle

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

312 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"]