@@ -0,0 +1,58 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Middleware.StripHeadersSpec
3+ ( main
4+ , spec
5+ ) where
6+
7+import Test.Hspec
8+
9+import Network.Wai.Middleware.AddHeaders
10+import Network.Wai.Middleware.StripHeaders
11+
12+import Control.Arrow (first)
13+import Data.ByteString (ByteString)
14+import Data.Monoid ((<>))
15+import Network.HTTP.Types (status200)
16+import Network.Wai
17+import Network.Wai.Test
18+
19+import qualified Data.CaseInsensitive as CI
20+
21+
22+main :: IO ()
23+main = hspec spec
24+
25+
26+spec :: Spec
27+spec = describe "stripHeader" $ do
28+ let host = "example.com"
29+ let ciTestHeaders = map (first CI.mk) testHeaders
30+
31+ it "strips a specific header" $ do
32+ resp1 <- runApp host (addHeaders testHeaders) defaultRequest
33+ resp2 <- runApp host (stripHeader "Foo" (const False) . addHeaders testHeaders) defaultRequest
34+ resp3 <- runApp host (stripHeader "Foo" (const True) . addHeaders testHeaders) defaultRequest
35+
36+ simpleHeaders resp1 `shouldBe` ciTestHeaders
37+ simpleHeaders resp2 `shouldBe` ciTestHeaders
38+ simpleHeaders resp3 `shouldBe` tail ciTestHeaders
39+
40+ it "strips specific set of headers" $ do
41+ resp1 <- runApp host (addHeaders testHeaders) defaultRequest
42+ resp2 <- runApp host (stripHeaders ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest
43+ resp3 <- runApp host (stripHeaders ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest
44+
45+ simpleHeaders resp1 `shouldBe` ciTestHeaders
46+ simpleHeaders resp2 `shouldBe` ciTestHeaders
47+ simpleHeaders resp3 `shouldBe` [last ciTestHeaders]
48+
49+
50+testHeaders :: [(ByteString, ByteString)]
51+testHeaders = [("Foo", "fooey"), ("Bar", "barbican"), ("Baz", "bazooka")]
52+
53+
54+runApp :: ByteString -> Middleware -> Request -> IO SResponse
55+runApp host mw req = runSession
56+ (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app
57+ where
58+ app _ respond = respond $ responseLBS status200 [] ""