warp 2.0.3.3 → 2.0.3.4

raw patch · 4 files changed

+25/−8 lines, 4 files

Files

Network/Wai/Handler/Warp/Header.hs +4/−2
Network/Wai/Handler/Warp/Response.hs +7/−5
test/RunSpec.hs +13/−0
warp.cabal +1/−1

@@ -49,17 +49,19 @@ indexResponseHeader :: ResponseHeaders -> IndexedHeader indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex -idxServer :: Int+idxServer, idxDate :: Int --idxContentLength = 0 idxServer        = 1+idxDate          = 2  -- | The size for 'IndexedHeader' for HTTP Response. responseMaxIndex :: Int-responseMaxIndex = 1+responseMaxIndex = 2  responseKeyIndex :: HeaderName -> Int responseKeyIndex "content-length" = idxContentLength responseKeyIndex "server"         = idxServer+responseKeyIndex "date"           = idxDate responseKeyIndex _                = -1  ----------------------------------------------------------------

Network/Wai/Handler/Warp/Response.hs view

@@ -169,7 +169,7 @@     rspidxhdr = indexResponseHeader hs0     th = threadHandle ii     dc = dateCacher ii-    addServerAndDate = addDate dc . addServer rspidxhdr+    addServerAndDate = addDate dc rspidxhdr . addServer rspidxhdr     mRange = reqidxhdr ! idxRange     reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr     (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo@@ -347,10 +347,12 @@       ( '/'       : showInt total "")) -addDate :: D.DateCache -> H.ResponseHeaders -> IO H.ResponseHeaders-addDate dc hdrs = do-    gmtdate <- D.getDate dc-    return $ (H.hDate, gmtdate) : hdrs+addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders+addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of+    Nothing -> do+        gmtdate <- D.getDate dc+        return $ (H.hDate, gmtdate) : hdrs+    Just _ -> return hdrs  ----------------------------------------------------------------

test/RunSpec.hs view

@@ -25,6 +25,7 @@ import Control.Exception.Lifted (bracket, try, IOException, onException) import Data.Conduit.Network (bindPort) import Network.Socket (sClose)+import qualified Network.HTTP as HTTP  main :: IO () main = hspec spec@@ -293,3 +294,15 @@                 threadDelay 5000000                 front <- I.readIORef ifront                 S.concat (front []) `shouldBe` bs++    it "only one date and server header" $ do+        let app _ = return $ responseLBS status200+                [ ("server", "server")+                , ("date", "date")+                ] ""+        withApp defaultSettings app $ \port -> do+            Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)+            map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrServer res)+                `shouldBe` ["server"]+            map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrDate res)+                `shouldBe` ["date"]

warp.cabal view

@@ -1,5 +1,5 @@ Name:                warp-Version:             2.0.3.3+Version:             2.0.3.4 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE