git.iko.soy/typeable/wai
on master help sign in
test cases for addHeader and fix (#619)
78022f9Kazu Yamamoto
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+6−3
compare with master
unifiedsplit
@@ -7,6 +7,7 @@ module Network.Wai.Handler.Warp.HTTP2.HPACK (
7 , hpackDecodeHeader
7 , hpackDecodeHeader
8 , just
8 , just
9 , addNecessaryHeaders
9 , addNecessaryHeaders
10+ , addHeader -- testing
10 ) where
11 ) where
11
12
12import qualified Control.Exception as E
13import qualified Control.Exception as E
@@ -27,10 +28,12 @@ import Network.Wai.Handler.Warp.Types
27
28
28{-# INLINE addHeader #-}
29{-# INLINE addHeader #-}
29addHeader :: Token -> ByteString -> ValueTable -> TokenHeaderList -> TokenHeaderList
30addHeader :: Token -> ByteString -> ValueTable -> TokenHeaderList -> TokenHeaderList
31+addHeader t "" tbl ths = case getHeaderValue t tbl of
32+ Nothing -> ths
33+ _ -> filter ((/= tokenServer) . fst) ths
30addHeader t v tbl ths = case getHeaderValue t tbl of
34addHeader t v tbl ths = case getHeaderValue t tbl of
31− Nothing
35+ Nothing -> (t,v) : ths
32− | v /= "" -> (t,v) : ths
33− _ -> ths
36+ _ -> ths
34
37
35addNecessaryHeaders :: Context
38addNecessaryHeaders :: Context
36 -> Rspn
39 -> Rspn
warp/test/ResponseHeaderSpec.hs+28−1
@@ -7,6 +7,9 @@ import qualified Network.HTTP.Types as H
7import Network.Wai.Handler.Warp.ResponseHeader
7import Network.Wai.Handler.Warp.ResponseHeader
8import Network.Wai.Handler.Warp.Response
8import Network.Wai.Handler.Warp.Response
9import Network.Wai.Handler.Warp.Header
9import Network.Wai.Handler.Warp.Header
10+import Network.Wai.Handler.Warp.HTTP2.HPACK
11+import Network.HPACK
12+import Network.HPACK.Token
10import Test.Hspec
13import Test.Hspec
11
14
12main :: IO ()
15main :: IO ()
@@ -34,7 +37,31 @@ spec = do
34 let hdrs = [("Server","MyServer")]
37 let hdrs = [("Server","MyServer")]
35 rspidxhdr = indexResponseHeader hdrs
38 rspidxhdr = indexResponseHeader hdrs
36 addServer "" rspidxhdr hdrs `shouldBe` []
39 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
38
65
39headers :: H.ResponseHeaders
66headers :: H.ResponseHeaders
40headers = [
67headers = [