wai-extra 3.0.8.2 → 3.0.9

raw patch · 4 files changed

+99/−1 lines, 4 files

Files

• ChangeLog.md +4/−0
• Network/Wai/Middleware/Routed.hs +39/−0
• test/Network/Wai/Middleware/RoutedSpec.hs +53/−0
• wai-extra.cabal +3/−1

@@ -1,3 +1,7 @@+## 3.0.9++* Network.Wai.Middleware.Routed module added+ ## 3.0.7  * Add appearsSecure: check if a request appears to be using SSL even in the

@@ -0,0 +1,39 @@+-- |+--+-- Since 3.0.9+module Network.Wai.Middleware.Routed+    ( routedMiddleware+    , hostedMiddleware+    ) where++import Network.Wai+import Data.ByteString (ByteString)+import Data.Text (Text)++-- | Apply a middleware based on a test of pathInfo+--+-- example:+--+-- > let corsify = routedMiddleWare ("static" `elem`) addCorsHeaders+--+-- Since 3.0.9+routedMiddleware :: ([Text] -> Bool) -- ^ Only use middleware if this pathInfo test returns True+                 -> Middleware -- ^ middleware to apply the path prefix guard to+                 -> Middleware -- ^ modified middleware+routedMiddleware pathCheck middle app req+  | pathCheck (pathInfo req) = middle app req+  | otherwise                = app req++-- | Only apply the middleware to certain hosts+--+-- Since 3.0.9+hostedMiddleware :: ByteString -- ^ Domain the middleware applies to+                 -> Middleware -- ^ middleware to apply the path prefix guard to+                 -> Middleware -- ^ modified middleware+hostedMiddleware domain middle app req+  | hasDomain domain req = middle app req+  | otherwise            = app req++hasDomain :: ByteString -> Request -> Bool+hasDomain domain req = maybe False (== domain) mHost+  where mHost = requestHeaderHost req

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.RoutedSpec+    ( main+    , spec+    ) where++import Test.Hspec++import Network.Wai.Middleware.Routed+import Network.Wai.Middleware.ForceSSL (forceSSL)++import Network.HTTP.Types (methodPost, status200, status301, status307)+import Network.Wai+import Network.Wai.Test+import Data.ByteString (ByteString)+import Data.String (IsString)++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "forceSSL" $ do+  it "routed middleware" $ do+    let destination = "https://example.com/d/"+    let routedSslJsonApp prefix = routedMiddleware (checkPrefix prefix) forceSSL jsonApp+        checkPrefix p (p1:_) = p == p1+        checkPrefix _ _ = False++    flip runSession (routedSslJsonApp "r") $ do+        res <- testDPath "http"+        assertNoHeader location res+        assertStatus 200 res+        assertBody "{\"foo\":\"bar\"}" res++    flip runSession (routedSslJsonApp "d") $ do+        res2 <- testDPath "http"+        assertHeader location destination res2+        assertStatus 301 res2++jsonApp :: Application+jsonApp _req cps = cps $ responseLBS status200+   [("Content-Type", "application/json")]+      "{\"foo\":\"bar\"}"++testDPath :: ByteString -> Session SResponse+testDPath proto =+    request $ flip setRawPathInfo "/d/" defaultRequest+             { requestHeaders = [("X-Forwarded-Proto", proto)]+             , requestHeaderHost = Just "example.com"+             }++location :: IsString ci => ci+location = "Location"

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.8.2+Version:             3.0.9 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -135,6 +135,7 @@                      Network.Wai.Middleware.HttpAuth                      Network.Wai.Middleware.StreamFile                      Network.Wai.Middleware.ForceSSL+                     Network.Wai.Middleware.Routed                      Network.Wai.Parse                      Network.Wai.Request                      Network.Wai.UrlMap@@ -153,6 +154,7 @@                      Network.Wai.RequestSpec                      Network.Wai.Middleware.ApprootSpec                      Network.Wai.Middleware.ForceSSLSpec+                     Network.Wai.Middleware.RoutedSpec                      Network.Wai.Middleware.StripHeadersSpec                      WaiExtraSpec     build-depends:   base                      >= 4        && < 5