warp 3.2.11.2 → 3.2.12

raw patch · 6 files changed

+70/−6 lines, 6 files

Files

• ChangeLog.md +4/−0
• Network/Wai/Handler/Warp.hs +4/−1
• Network/Wai/Handler/Warp/HTTP2/HPACK.hs +5/−1
• Network/Wai/Handler/Warp/Response.hs +5/−0
• test/ResponseHeaderSpec.hs +51/−3
• warp.cabal +1/−1

@@ -1,3 +1,7 @@+## 3.2.12++* If an empty string is set by setServerName, the Server header is not included in response headers [#619](https://github.com/yesodweb/wai/issues/619)+ ## 3.2.11.2  * Don't throw exceptions when closing a keep-alive connection

@@ -302,7 +302,10 @@ setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings setInstallShutdownHandler x y = y { settingsInstallShutdownHandler = x } --- | Default server name if application does not set one.+-- | Default server name to be sent as the \"Server:\" header+--   if an application does not set one.+--   If an empty string is set, the \"Server:\" header is not sent.+--   This is true even if an application set one. -- -- Since 3.0.2 setServerName :: ByteString -> Settings -> Settings

@@ -7,6 +7,7 @@   , hpackDecodeHeader   , just   , addNecessaryHeaders+  , addHeader -- testing   ) where  import qualified Control.Exception as E@@ -27,9 +28,12 @@  {-# INLINE addHeader #-} addHeader :: Token -> ByteString -> ValueTable -> TokenHeaderList -> TokenHeaderList+addHeader t "" tbl ths = case getHeaderValue t tbl of+    Nothing -> ths+    _       -> filter ((/= tokenServer) . fst) ths addHeader t v tbl ths = case getHeaderValue t tbl of     Nothing -> (t,v) : ths-    Just _  -> ths+    _       -> ths  addNecessaryHeaders :: Context                     -> Rspn

@@ -11,6 +11,7 @@   , warpVersion   , hasBody   , replaceHeader+  , addServer -- testing   ) where  #ifndef MIN_VERSION_base@@ -429,7 +430,11 @@ warpVersion :: String warpVersion = showVersion Paths_warp.version +{-# INLINE addServer #-} addServer :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders+addServer "" rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of+    Nothing -> hdrs+    _       -> filter ((/= H.hServer) . fst) hdrs addServer serverName rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of     Nothing -> (H.hServer, serverName) : hdrs     _       -> hdrs

@@ -5,15 +5,63 @@ import Data.ByteString import qualified Network.HTTP.Types as H import Network.Wai.Handler.Warp.ResponseHeader+import Network.Wai.Handler.Warp.Response+import Network.Wai.Handler.Warp.Header+import Network.Wai.Handler.Warp.HTTP2.HPACK+import Network.HPACK+import Network.HPACK.Token import Test.Hspec  main :: IO () main = hspec spec  spec :: Spec-spec = describe "composeHeader" $ do-    it "composes a HTTP header" $-        composeHeader H.http11 H.ok200 headers `shouldReturn` composedHeader+spec = do+    describe "composeHeader" $ do+        it "composes a HTTP header" $+            composeHeader H.http11 H.ok200 headers `shouldReturn` composedHeader+    describe "addServer" $ do+        it "adds Server if not exist" $ do+            let hdrs = []+                rspidxhdr = indexResponseHeader hdrs+            addServer "MyServer" rspidxhdr hdrs `shouldBe` [("Server","MyServer")]+        it "does not add Server if exists" $ do+            let hdrs = [("Server","MyServer")]+                rspidxhdr = indexResponseHeader hdrs+            addServer "MyServer2" rspidxhdr hdrs `shouldBe` hdrs+        it "does not add Server if empty" $ do+            let hdrs = []+                rspidxhdr = indexResponseHeader hdrs+            addServer "" rspidxhdr hdrs `shouldBe` hdrs+        it "deletes Server " $ do+            let hdrs = [("Server","MyServer")]+                rspidxhdr = indexResponseHeader hdrs+            addServer "" rspidxhdr hdrs `shouldBe` []+    describe "addHeader" $ do+        it "adds Server if not exist" $ do+            let v = "MyServer"+                hdrs = []+                hdrs1 = [("Server",v)]+            (thl, vt) <- toHeaderTable hdrs+            (thl1, _) <- toHeaderTable hdrs1+            addHeader tokenServer v vt thl `shouldBe` thl1+        it "does not add Server if exists" $ do+            let v = "MyServer2"+                hdrs = [("Server","MyServer")]+            (thl, vt) <- toHeaderTable hdrs+            addHeader tokenServer v vt thl `shouldBe` thl+        it "does not add Server if empty" $ do+            let v = ""+                hdrs = []+            (thl, vt) <- toHeaderTable hdrs+            addHeader tokenServer v vt thl `shouldBe` thl+        it "deletes Server " $ do+            let v = ""+                hdrs = [("Server","MyServer")]+                hdrs1 = []+            (thl, vt) <- toHeaderTable hdrs+            (thl1, _) <- toHeaderTable hdrs1+            addHeader tokenServer v vt thl `shouldBe` thl1  headers :: H.ResponseHeaders headers = [

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