on master help sign in
test cases for addHeader and fix (#619)
commit78022f960c92610446da29de67db00b51498dabf authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 9 May 2017, 15:30 (9 years ago) parent875dd7f
2 files changed+34−4
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+6−3 warp/test/ResponseHeaderSpec.hs+28−1
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+6−3
@@ -7,6 +7,7 @@ module Network.Wai.Handler.Warp.HTTP2.HPACK (
77 , hpackDecodeHeader
88 , just
99 , addNecessaryHeaders
10+ , addHeader -- testing
1011 ) where
1112
1213import qualified Control.Exception as E
@@ -27,10 +28,12 @@ import Network.Wai.Handler.Warp.Types
2728
2829{-# INLINE addHeader #-}
2930addHeader :: Token -> ByteString -> ValueTable -> TokenHeaderList -> TokenHeaderList
31+addHeader t "" tbl ths = case getHeaderValue t tbl of
32+ Nothing -> ths
33+ _ -> filter ((/= tokenServer) . fst) ths
3034addHeader t v tbl ths = case getHeaderValue t tbl of
31− Nothing
32− | v /= "" -> (t,v) : ths
33− _ -> ths
35+ Nothing -> (t,v) : ths
36+ _ -> ths
3437
3538addNecessaryHeaders :: Context
3639 -> Rspn
warp/test/ResponseHeaderSpec.hs+28−1
@@ -7,6 +7,9 @@ import qualified Network.HTTP.Types as H
77import Network.Wai.Handler.Warp.ResponseHeader
88import Network.Wai.Handler.Warp.Response
99import Network.Wai.Handler.Warp.Header
10+import Network.Wai.Handler.Warp.HTTP2.HPACK
11+import Network.HPACK
12+import Network.HPACK.Token
1013import Test.Hspec
1114
1215main :: IO ()
@@ -34,7 +37,31 @@ spec = do
3437 let hdrs = [("Server","MyServer")]
3538 rspidxhdr = indexResponseHeader hdrs
3639 addServer "" rspidxhdr hdrs `shouldBe` []
37−
40+ describe "addHeader" $ do
41+ it "adds Server if not exist" $ do
42+ let v = "MyServer"
43+ hdrs = []
44+ hdrs1 = [("Server",v)]
45+ (thl, vt) <- toHeaderTable hdrs
46+ (thl1, _) <- toHeaderTable hdrs1
47+ addHeader tokenServer v vt thl `shouldBe` thl1
48+ it "does not add Server if exists" $ do
49+ let v = "MyServer2"
50+ hdrs = [("Server","MyServer")]
51+ (thl, vt) <- toHeaderTable hdrs
52+ addHeader tokenServer v vt thl `shouldBe` thl
53+ it "does not add Server if empty" $ do
54+ let v = ""
55+ hdrs = []
56+ (thl, vt) <- toHeaderTable hdrs
57+ addHeader tokenServer v vt thl `shouldBe` thl
58+ it "deletes Server " $ do
59+ let v = ""
60+ hdrs = [("Server","MyServer")]
61+ hdrs1 = []
62+ (thl, vt) <- toHeaderTable hdrs
63+ (thl1, _) <- toHeaderTable hdrs1
64+ addHeader tokenServer v vt thl `shouldBe` thl1
3865
3966headers :: H.ResponseHeaders
4067headers = [