1{-# LANGUAGE OverloadedStrings #-} 2module Network.Wai.Middleware.StripHeadersSpec 3 ( main 4 , spec 5 ) where 6 7import Test.Hspec 8 9import Network.Wai.Middleware.AddHeaders 10import Network.Wai.Middleware.StripHeaders 11 12import Control.Arrow (first) 13import Data.ByteString (ByteString) 14import Data.Monoid ((<>)) 15import Network.HTTP.Types (status200) 16import Network.Wai 17import Network.Wai.Test 18 19import qualified Data.CaseInsensitive as CI 20 21 22main :: IO () 23main = hspec spec 24 25 26spec :: Spec 27spec = 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 (stripHeaderIf "Foo" (const False) . addHeaders testHeaders) defaultRequest 34 resp3 <- runApp host (stripHeaderIf "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 (stripHeadersIf ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest 43 resp3 <- runApp host (stripHeadersIf ["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 50testHeaders :: [(ByteString, ByteString)] 51testHeaders = [("Foo", "fooey"), ("Bar", "barbican"), ("Baz", "bazooka")] 52 53 54runApp :: ByteString -> Middleware -> Request -> IO SResponse 55runApp host mw req = runSession 56 (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app 57 where 58 app _ respond = respond $ responseLBS status200 [] "" 59