warp 2.1.1 → 2.1.1.1

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

@@ -173,7 +173,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@@ -378,10 +378,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@@ -309,3 +310,15 @@                 hPutStr handle "67890"                 hFlush handle                 timeout 100000 (S.hGet handle 10) >>= (`shouldBe` Just "6677889900")++    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.1.1+Version:             2.1.1.1 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE