wai-extra 3.0.7.1 → 3.0.8.0

raw patch · 5 files changed

+114/−12 lines, 5 filesdep ~case-insensitivedep ~waiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: case-insensitive, wai

API changes (from Hackage documentation)

Files

• Network/Wai/Middleware/AddHeaders.hs +3/−9
• Network/Wai/Middleware/RequestLogger.hs +2/−0
• Network/Wai/Middleware/StripHeaders.hs +45/−0
• test/Network/Wai/Middleware/StripHeadersSpec.hs +58/−0
• wai-extra.cabal +6/−3

@@ -6,7 +6,7 @@     ) where  import Network.HTTP.Types   (ResponseHeaders, Header)-import Network.Wai          (Middleware)+import Network.Wai          (Middleware, modifyResponse, mapResponseHeaders) import Network.Wai.Internal (Response(..)) import Data.ByteString      (ByteString) @@ -18,13 +18,7 @@ -- -- Since 3.0.3 -addHeaders h app req respond = app req $ respond . addHeaders' (map (first CI.mk) h)--mapHeader :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response-mapHeader f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2-mapHeader f (ResponseBuilder s h b) = ResponseBuilder s (f h) b-mapHeader f (ResponseStream s h b) = ResponseStream s (f h) b-mapHeader _ r@(ResponseRaw _ _) = r+addHeaders h = modifyResponse $ addHeaders' (map (first CI.mk) h)  addHeaders' :: [Header] -> Response -> Response-addHeaders' h = mapHeader (\hs -> h ++ hs)+addHeaders' h = mapResponseHeaders (\hs -> h ++ hs)

@@ -119,6 +119,7 @@  -- | Production request logger middleware. -- Implemented on top of "logCallback", but prints to 'stdout'+{-# NOINLINE logStdout #-} logStdout :: Middleware logStdout = unsafePerformIO $ mkRequestLogger def { outputFormat = Apache FromSocket } @@ -127,6 +128,7 @@ -- -- Flushes 'stdout' on each request, which would be inefficient in production use. -- Use "logStdout" in production.+{-# NOINLINE logStdoutDev #-} logStdoutDev :: Middleware logStdoutDev = unsafePerformIO $ mkRequestLogger def 

@@ -0,0 +1,45 @@+-- This was written for one specific use case and then generalized.++-- The specific use case was a JSON API with a consumer that would choke on the+-- "Set-Cookie" response header. The solution was to test for the API's+-- `pathInfo` in the Request and if it matched, filter the response headers.++-- When using this, care should be taken not to strip out headers that are+-- required for correct operation of the client (eg Content-Type).++module Network.Wai.Middleware.StripHeaders+    ( stripHeader+    , stripHeaders+    , stripHeaderIf+    , stripHeadersIf+    ) where++import Network.Wai                       (Middleware, Request, modifyResponse, mapResponseHeaders, ifRequest)+import Network.Wai.Internal (Response)+import Data.ByteString                   (ByteString)++import qualified Data.CaseInsensitive as CI++stripHeader :: ByteString -> (Response -> Response)+stripHeader h = mapResponseHeaders (filter (\ hdr -> fst hdr /= CI.mk h))++stripHeaders :: [ByteString] -> (Response -> Response)+stripHeaders hs =+  let hnames = map CI.mk hs+  in mapResponseHeaders (filter (\ hdr -> fst hdr `notElem` hnames))++-- | If the request satisifes the provided predicate, strip headers matching+-- the provided header name.+--+-- Since 3.0.8+stripHeaderIf :: ByteString -> (Request -> Bool) -> Middleware+stripHeaderIf h rpred =+  ifRequest rpred (modifyResponse $ stripHeader h)++-- | If the request satisifes the provided predicate, strip all headers whose+-- header name is in the list of provided header names.+--+-- Since 3.0.8+stripHeadersIf :: [ByteString] -> (Request -> Bool) -> Middleware+stripHeadersIf hs rpred+  = ifRequest rpred (modifyResponse $ stripHeaders hs)

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.StripHeadersSpec+    ( main+    , spec+    ) where++import Test.Hspec++import Network.Wai.Middleware.AddHeaders+import Network.Wai.Middleware.StripHeaders++import Control.Arrow (first)+import Data.ByteString (ByteString)+import Data.Monoid ((<>))+import Network.HTTP.Types (status200)+import Network.Wai+import Network.Wai.Test++import qualified Data.CaseInsensitive as CI+++main :: IO ()+main = hspec spec+++spec :: Spec+spec = describe "stripHeader" $ do+    let host = "example.com"+    let ciTestHeaders = map (first CI.mk) testHeaders++    it "strips a specific header" $ do+        resp1 <- runApp host (addHeaders testHeaders) defaultRequest+        resp2 <- runApp host (stripHeaderIf "Foo" (const False) . addHeaders testHeaders) defaultRequest+        resp3 <- runApp host (stripHeaderIf "Foo" (const True) . addHeaders testHeaders) defaultRequest++        simpleHeaders resp1 `shouldBe` ciTestHeaders+        simpleHeaders resp2 `shouldBe` ciTestHeaders+        simpleHeaders resp3 `shouldBe` tail ciTestHeaders++    it "strips specific set of headers" $ do+        resp1 <- runApp host (addHeaders testHeaders) defaultRequest+        resp2 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest+        resp3 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest++        simpleHeaders resp1 `shouldBe` ciTestHeaders+        simpleHeaders resp2 `shouldBe` ciTestHeaders+        simpleHeaders resp3 `shouldBe` [last ciTestHeaders]+++testHeaders :: [(ByteString, ByteString)]+testHeaders = [("Foo", "fooey"), ("Bar", "barbican"), ("Baz", "bazooka")]+++runApp :: ByteString -> Middleware -> Request -> IO SResponse+runApp host mw req = runSession+    (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app+  where+    app _ respond = respond $ responseLBS status200 [] ""

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.7.1+Version:             3.0.8.0 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -84,7 +84,7 @@ Library   Build-Depends:     base                      >= 4 && < 5                    , bytestring                >= 0.9.1.4-                   , wai                       >= 3.0      && < 3.1+                   , wai                       >= 3.0.3.0  && < 3.1                    , old-locale                >= 1.0.0.2  && < 1.1                    , time                      >= 1.1.4                    , network                   >= 2.2.1.5@@ -130,6 +130,7 @@                      Network.Wai.Middleware.MethodOverride                      Network.Wai.Middleware.MethodOverridePost                      Network.Wai.Middleware.Rewrite+                     Network.Wai.Middleware.StripHeaders                      Network.Wai.Middleware.Vhost                      Network.Wai.Middleware.HttpAuth                      Network.Wai.Middleware.StreamFile@@ -152,6 +153,7 @@                      Network.Wai.RequestSpec                      Network.Wai.Middleware.ApprootSpec                      Network.Wai.Middleware.ForceSSLSpec+                     Network.Wai.Middleware.StripHeadersSpec                      WaiExtraSpec     build-depends:   base                      >= 4        && < 5                    , wai-extra@@ -168,7 +170,8 @@                    , blaze-builder                    , cookie                    , time-    ghc-options:     -Wall -Werror+                   , case-insensitive+    ghc-options:     -Wall  source-repository head   type:     git