git.iko.soy/typeable/wai
on master help sign in
test cases for addServer and fix (#619).
commit875dd7fcf4d5e84b0c84bd1bb8c2ab478684de9d authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 9 May 2017, 13:43 (9 years ago) parentc4000b0
2 files changed+30−7
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/Response.hs+6−4 warp/test/ResponseHeaderSpec.hs+24−3
warp/Network/Wai/Handler/Warp/Response.hs+6−4
@@ -11,6 +11,7 @@ module Network.Wai.Handler.Warp.Response (
1111 , warpVersion
1212 , hasBody
1313 , replaceHeader
14+ , addServer
1415 ) where
1516
1617#ifndef MIN_VERSION_base
@@ -430,11 +431,12 @@ warpVersion :: String
430431warpVersion = showVersion Paths_warp.version
431432
432433addServer :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
434+addServer "" rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
435+ Nothing -> hdrs
436+ Just _ -> filter ((/= H.hServer) . fst) hdrs
433437addServer serverName rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
434− Nothing -> (H.hServer, serverName) : hdrs
435− Just serverName'
436− | S.null serverName' -> filter (\(x, _) -> x /= "Server") hdrs
437− | otherwise -> hdrs
438+ Nothing -> (H.hServer, serverName) : hdrs
439+ Just _ -> hdrs
438440
439441----------------------------------------------------------------
440442
warp/test/ResponseHeaderSpec.hs+24−3
@@ -5,15 +5,36 @@ module ResponseHeaderSpec (main, spec) where
55import Data.ByteString
66import qualified Network.HTTP.Types as H
77import Network.Wai.Handler.Warp.ResponseHeader
8+import Network.Wai.Handler.Warp.Response
9+import Network.Wai.Handler.Warp.Header
810import Test.Hspec
911
1012main :: IO ()
1113main = hspec spec
1214
1315spec :: Spec
14−spec = describe "composeHeader" $ do
15− it "composes a HTTP header" $
16− composeHeader H.http11 H.ok200 headers `shouldReturn` composedHeader
16+spec = do
17+ describe "composeHeader" $ do
18+ it "composes a HTTP header" $
19+ composeHeader H.http11 H.ok200 headers `shouldReturn` composedHeader
20+ describe "addServer" $ do
21+ it "adds Server if not exist" $ do
22+ let hdrs = []
23+ rspidxhdr = indexResponseHeader hdrs
24+ addServer "MyServer" rspidxhdr hdrs `shouldBe` [("Server","MyServer")]
25+ it "does not add Server if exists" $ do
26+ let hdrs = [("Server","MyServer")]
27+ rspidxhdr = indexResponseHeader hdrs
28+ addServer "MyServer2" rspidxhdr hdrs `shouldBe` hdrs
29+ it "does not add Server if empty" $ do
30+ let hdrs = []
31+ rspidxhdr = indexResponseHeader hdrs
32+ addServer "" rspidxhdr hdrs `shouldBe` hdrs
33+ it "deletes Server " $ do
34+ let hdrs = [("Server","MyServer")]
35+ rspidxhdr = indexResponseHeader hdrs
36+ addServer "" rspidxhdr hdrs `shouldBe` []
37+
1738
1839headers :: H.ResponseHeaders
1940headers = [