packages feed

wai-extra 3.1.4.1 → 3.1.5

raw patch · 4 files changed

+194/−2 lines, 4 filesdep ~iproute

Dependency ranges changed: iproute

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for wai-extra +## 3.1.5++* `Network.Wai.Middleware.RealIp`: Add a new middleware to infer the remote IP address from headers [#834](https://github.com/yesodweb/wai/pull/834)+ ## 3.1.4.1  * `Network.Wai.Middleware.Gzip`: Add `Vary: Accept-Encoding` header to responses [#829](https://github.com/yesodweb/wai/pull/829)
+ Network/Wai/Middleware/RealIp.hs view
@@ -0,0 +1,94 @@+-- | Infer the remote IP address using headers+module Network.Wai.Middleware.RealIp+    ( realIp+    , realIpHeader+    , realIpTrusted+    , defaultTrusted+    , ipInRange+    ) where++import qualified Data.ByteString.Char8 as B8 (unpack, split)+import qualified Data.IP as IP+import Data.Maybe (fromMaybe, mapMaybe, listToMaybe)+import Network.HTTP.Types (HeaderName, RequestHeaders)+import Network.Wai+import Text.Read (readMaybe)++-- | Infer the remote IP address from the @X-Forwarded-For@ header,+-- trusting requests from any private IP address. See 'realIpHeader' and+-- 'realIpTrusted' for more information and options.+--+-- @since 3.1.5+realIp :: Middleware+realIp = realIpHeader "X-Forwarded-For"++-- | Infer the remote IP address using the given header, trusting+-- requests from any private IP address. See 'realIpTrusted' for more+-- information and options.+--+-- @since 3.1.5+realIpHeader :: HeaderName -> Middleware+realIpHeader header =+    realIpTrusted header $ \ip -> any (ipInRange ip) defaultTrusted++-- | Infer the remote IP address using the given header, but only if the+-- request came from an IP that is trusted by the provided predicate.+--+-- The last non-trusted address is used to replace the 'remoteHost' in+-- the 'Request', unless all present IP addresses are trusted, in which+-- case the first address is used. Invalid IP addresses are ignored, and+-- the remoteHost value remains unaltered if no valid IP addresses are+-- found.+--+-- Examples:+--+-- @ realIpTrusted "X-Forwarded-For" $ flip ipInRange "10.0.0.0/8" @+--+-- @ realIpTrusted "X-Real-Ip" $ \\ip -> any (ipInRange ip) defaultTrusted @+--+-- @since 3.1.5+realIpTrusted :: HeaderName -> (IP.IP -> Bool) -> Middleware+realIpTrusted header isTrusted app req respond = app req' respond+  where+    req' = fromMaybe req $ do+             (ip, port) <- IP.fromSockAddr (remoteHost req)+             ip' <- if isTrusted ip+                      then findRealIp (requestHeaders req) header isTrusted+                      else Nothing+             Just $ req { remoteHost = IP.toSockAddr (ip', port) }++-- | Standard private IP ranges.+--+-- @since 3.1.5+defaultTrusted :: [IP.IPRange]+defaultTrusted = [ "127.0.0.0/8"+                 , "10.0.0.0/8"+                 , "172.16.0.0/12"+                 , "192.168.0.0/16"+                 , "::1/128"+                 , "fc00::/7"+                 ]++-- | Check if the given IP address is in the given range.+--+-- IPv4 addresses can be checked against IPv6 ranges, but testing an+-- IPv6 address against an IPv4 range is always 'False'.+--+-- @since 3.1.5+ipInRange :: IP.IP -> IP.IPRange -> Bool+ipInRange (IP.IPv4 ip) (IP.IPv4Range r) = ip `IP.isMatchedTo` r+ipInRange (IP.IPv6 ip) (IP.IPv6Range r) = ip `IP.isMatchedTo` r+ipInRange (IP.IPv4 ip) (IP.IPv6Range r) = IP.ipv4ToIPv6 ip `IP.isMatchedTo` r+ipInRange _ _ = False+++findRealIp :: RequestHeaders -> HeaderName -> (IP.IP -> Bool) -> Maybe IP.IP+findRealIp reqHeaders header isTrusted =+    case (nonTrusted, ips) of+      ([], xs) -> listToMaybe xs+      (xs, _)  -> listToMaybe $ reverse xs+  where+    -- account for repeated headers+    headerVals = [ v | (k, v) <- reqHeaders, k == header ]+    ips = mapMaybe (readMaybe . B8.unpack) $ concatMap (B8.split ',') headerVals+    nonTrusted = filter (not . isTrusted) ips
+ test/Network/Wai/Middleware/RealIpSpec.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Middleware.RealIpSpec+    ( spec+    ) where++import Test.Hspec++import qualified Data.ByteString.Lazy.Char8 as B8+import qualified Data.IP as IP+import Network.HTTP.Types (status200, RequestHeaders)+import Network.Wai+import Network.Wai.Middleware.RealIp+import Network.Wai.Test++spec :: Spec+spec = do+    describe "realIp" $ do+        it "does nothing when header is missing" $ do+            resp <- runApp "127.0.0.1" [] realIp+            simpleBody resp `shouldBe` "127.0.0.1"++        it "uses X-Forwarded-For when present" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1")]+            resp <- runApp "127.0.0.1" headers realIp+            simpleBody resp `shouldBe` "1.1.1.1"++        it "ignores X-Forwarded-For from non-trusted ip" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1")]+            resp <- runApp "1.2.3.4" headers realIp+            simpleBody resp `shouldBe` "1.2.3.4"++        it "ignores trusted ip addresses in X-Forwarded-For" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1, 10.0.0.1")]+            resp <- runApp "127.0.0.1" headers realIp+            simpleBody resp `shouldBe` "1.1.1.1"++        it "ignores invalid ip addresses" $ do+            let headers1 = [("X-Forwarded-For", "1.1.1")]+            resp1 <- runApp "127.0.0.1" headers1 realIp+            let headers2 = [("X-Forwarded-For", "1.1.1.1,foo")]+            resp2 <- runApp "127.0.0.1" headers2 realIp++            simpleBody resp1 `shouldBe` "127.0.0.1"+            simpleBody resp2 `shouldBe` "1.1.1.1"++        it "takes the last non-trusted address" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1, 2.2.2.2, 10.0.0.1")]+            resp <- runApp "127.0.0.1" headers realIp+            simpleBody resp `shouldBe` "2.2.2.2"++        it "takes the first address when all are trusted" $ do+            let headers = [("X-Forwarded-For", "192.168.0.1, 10.0.0.2, 10.0.0.1")]+            resp <- runApp "127.0.0.1" headers realIp+            simpleBody resp `shouldBe` "192.168.0.1"++        it "handles repeated headers" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1"), ("X-Forwarded-For", "2.2.2.2")]+            resp <- runApp "127.0.0.1" headers realIp+            simpleBody resp `shouldBe` "2.2.2.2"++        it "handles ipv6 addresses" $ do+            let headers = [("X-Forwarded-For", "2001:db8::ff00:42:8329,10.0.0.1")]+            resp <- runApp "::1" headers realIp+            simpleBody resp `shouldBe` "2001:db8::ff00:42:8329"++    describe "realIpHeader" $ do+        it "uses specified header" $ do+            let headers = [("X-Forwarded-For", "1.1.1.1"), ("X-Real-Ip", "2.2.2.2")]+            resp <- runApp "127.0.0.1" headers $ realIpHeader "X-Real-Ip"+            simpleBody resp `shouldBe` "2.2.2.2"++    describe "realIpTrusted" $ do+        it "uses provided trusted predicate" $ do+            let headers = [("X-Forwarded-For", "10.0.0.1, 1.1.1.1")]+                isTrusted1 ip = any (ipInRange ip) ["127.0.0.1/32", "1.1.1.1/32"]+                isTrusted2 = flip ipInRange "1.1.1.1/32"++            resp1 <- runApp "127.0.0.1" headers $ realIpTrusted "X-Forwarded-For" isTrusted1+            resp2 <- runApp "10.0.0.2" headers $ realIpTrusted "X-Forwarded-For" isTrusted2++            simpleBody resp1 `shouldBe` "10.0.0.1"+            simpleBody resp2 `shouldBe` "10.0.0.2"+++runApp :: IP.IP -> RequestHeaders -> Middleware -> IO SResponse+runApp ip hs mw = runSession+    (request defaultRequest { remoteHost = IP.toSockAddr (ip, 80), requestHeaders = hs }) $ mw app+  where+    app req respond = respond $ responseLBS status200 [] $ renderIp req+    renderIp = B8.pack . maybe "" (show . fst) . IP.fromSockAddr . remoteHost
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.1.4.1+Version:             3.1.5 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -114,7 +114,7 @@                    , vault                    , zlib                    , aeson-                   , iproute+                   , iproute                   >= 1.7.8                    , http2                    , HUnit                    , call-stack@@ -150,6 +150,7 @@                      Network.Wai.Middleware.ForceSSL                      Network.Wai.Middleware.Routed                      Network.Wai.Middleware.Timeout+                     Network.Wai.Middleware.RealIp                      Network.Wai.Parse                      Network.Wai.Request                      Network.Wai.UrlMap@@ -191,6 +192,7 @@                      Network.Wai.Middleware.RoutedSpec                      Network.Wai.Middleware.StripHeadersSpec                      Network.Wai.Middleware.TimeoutSpec+                     Network.Wai.Middleware.RealIpSpec                      WaiExtraSpec     build-depends:   base                      >= 4        && < 5                    , wai-extra@@ -209,6 +211,7 @@                    , case-insensitive                    , http2                    , aeson+                   , iproute     ghc-options:     -Wall     default-language:          Haskell2010