diff --git a/Network/HTTP/ReverseProxy.hs b/Network/HTTP/ReverseProxy.hs --- a/Network/HTTP/ReverseProxy.hs +++ b/Network/HTTP/ReverseProxy.hs @@ -9,11 +9,14 @@ , waiProxyTo , defaultOnExc , waiProxyToSettings + , WaiProxyResponse (..) -- ** Settings , WaiProxySettings , def , wpsOnExc , wpsTimeout + , wpsSetIpHeader + , SetIpHeader (..) -- * WAI to Raw , waiToRaw ) where @@ -41,6 +44,7 @@ import Data.Default (Default (def)) import Data.Version (showVersion) import qualified Paths_http_reverse_proxy +import Network.Wai.Logger.Utils (showSockAddr) -- | Host\/port combination to which we want to proxy. data ProxyDest = ProxyDest @@ -99,6 +103,27 @@ [("content-type", "text/plain")] ("Error connecting to gateway:\n\n" ++ TLE.encodeUtf8 (show exc)) +-- | The different responses that could be generated by a @waiProxyTo@ lookup +-- function. +-- +-- Since 0.2.0 +data WaiProxyResponse = WPRResponse WAI.Response + -- ^ Respond with the given WAI Response. + -- + -- Since 0.2.0 + | WPRProxyDest ProxyDest + -- ^ Send to the given destination. + -- + -- Since 0.2.0 + | WPRModifiedRequest WAI.Request ProxyDest + -- ^ Send to the given destination, but use the given + -- modified Request for computing the reverse-proxied + -- request. This can be useful for reverse proxying to + -- a different path than the one specified. By the + -- user. + -- + -- Since 0.2.0 + -- | Creates a WAI 'WAI.Application' which will handle reverse proxies. -- -- Connections to the proxied server will be provided via http-conduit. As @@ -113,7 +138,7 @@ -- Note: This function will use chunked request bodies for communicating with -- the proxied server. Not all servers necessarily support chunked request -- bodies, so please confirm that yours does (Warp, Snap, and Happstack, for example, do). -waiProxyTo :: (WAI.Request -> ResourceT IO (Either WAI.Response ProxyDest)) +waiProxyTo :: (WAI.Request -> ResourceT IO WaiProxyResponse) -- ^ How to reverse proxy. A @Left@ result will be sent verbatim as -- the response, whereas @Right@ will cause a reverse proxy. -> (SomeException -> WAI.Application) @@ -126,26 +151,53 @@ data WaiProxySettings = WaiProxySettings { wpsOnExc :: SomeException -> WAI.Application , wpsTimeout :: Maybe Int + , wpsSetIpHeader :: SetIpHeader + -- ^ Set the X-Real-IP request header with the client's IP address. + -- + -- Default: SIHFromSocket + -- + -- Since 0.2.0 } +-- | How to set the X-Real-IP request header. +-- +-- Since 0.2.0 +data SetIpHeader = SIHNone -- ^ Do not set the header + | SIHFromSocket -- ^ Set it from the socket's address. + | SIHFromHeader -- ^ Set it from either X-Real-IP or X-Forwarded-For, if present + instance Default WaiProxySettings where def = WaiProxySettings { wpsOnExc = defaultOnExc , wpsTimeout = Nothing + , wpsSetIpHeader = SIHFromSocket } -waiProxyToSettings getDest wps manager req = do - edest <- getDest req +waiProxyToSettings getDest wps manager req0 = do + edest' <- getDest req0 + let edest = + case edest' of + WPRResponse res -> Left res + WPRProxyDest pd -> Right (pd, req0) + WPRModifiedRequest req pd -> Right (pd, req) case edest of Left response -> return response - Right (ProxyDest host port) -> do + Right (ProxyDest host port, req) -> do let req' = HC.def { HC.method = WAI.requestMethod req , HC.host = host , HC.port = port , HC.path = WAI.rawPathInfo req , HC.queryString = WAI.rawQueryString req - , HC.requestHeaders = filter (\(key, _) -> not $ key `member` strippedHeaders) $ WAI.requestHeaders req + , HC.requestHeaders = filter (\(key, _) -> not $ key `member` strippedHeaders) $ + (case wpsSetIpHeader wps of + SIHFromSocket -> (("X-Real-IP", S8.pack $ showSockAddr $ WAI.remoteHost req):) + SIHFromHeader -> + case lookup "x-real-ip" (WAI.requestHeaders req) <|> lookup "X-Forwarded-For" (WAI.requestHeaders req) of + Nothing -> id + Just ip -> (("X-Real-IP", ip):) + SIHNone -> id) + $ WAI.requestHeaders req , HC.requestBody = body , HC.redirectCount = 0 #if MIN_VERSION_http_conduit(1, 9, 0) diff --git a/http-reverse-proxy.cabal b/http-reverse-proxy.cabal --- a/http-reverse-proxy.cabal +++ b/http-reverse-proxy.cabal @@ -1,5 +1,5 @@ name: http-reverse-proxy -version: 0.1.1.6 +version: 0.2.0 synopsis: Reverse proxy HTTP requests, either over raw sockets or with WAI description: Provides a simple means of reverse-proxying HTTP requests. The raw approach uses the same technique as leveraged by keter, whereas the WAI approach performs full request/response parsing via WAI and http-conduit. homepage: https://github.com/fpco/http-reverse-proxy @@ -31,6 +31,7 @@ , conduit >= 0.5 , warp >= 1.3.4 , data-default + , wai-logger test-suite test type: exitcode-stdio-1.0 diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -20,12 +20,14 @@ import qualified Data.Conduit.Network import qualified Data.IORef as I import qualified Network.HTTP.Conduit as HC -import Network.HTTP.ReverseProxy (ProxyDest (..), defaultOnExc, - rawProxyTo, waiProxyTo, waiToRaw) +import Network.HTTP.ReverseProxy (ProxyDest (..), + WaiProxyResponse (..), + defaultOnExc, rawProxyTo, + waiProxyTo, waiToRaw) import Network.HTTP.Types (status200) import Network.Socket (sClose) import Network.Wai (Response (ResponseFile, ResponseSource), - responseLBS) + rawPathInfo, responseLBS) import qualified Network.Wai import Network.Wai.Handler.Warp (defaultSettings, run, runSettings, settingsBeforeMainLoop, @@ -81,10 +83,22 @@ let content = "mainApp" in withMan $ \manager -> withWApp (const $ return $ responseLBS status200 [] content) $ \port1 -> - withWApp (waiProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> + withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 lbs `shouldBe` content + it "modified path" $ + let content = "/somepath" + app req = return $ responseLBS status200 [] $ L8.fromChunks [rawPathInfo req] + modReq pdest req = return $ WPRModifiedRequest + (req { rawPathInfo = content }) + pdest + in withMan $ \manager -> + withWApp app $ \port1 -> + withWApp (waiProxyTo (modReq $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> + withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do + lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 + S8.concat (L8.toChunks lbs) `shouldBe` content it "deals with streaming data" $ let app _ = return $ ResponseSource status200 [] $ forever $ do yield $ Chunk $ fromByteString "hello" @@ -92,7 +106,7 @@ liftIO $ threadDelay 10000000 in withMan $ \manager -> withWApp app $ \port1 -> - withWApp (waiProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do + withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do req <- HC.parseUrl $ "http://127.0.0.1:" ++ show port2 mbs <- runResourceT $ timeout 1000000 $ do res <- HC.http req manager @@ -109,7 +123,7 @@ show' (Network.Wai.KnownLength i) = S8.pack $ show i in withMan $ \manager -> withWApp app $ \port1 -> - withWApp (waiProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do + withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do req' <- HC.parseUrl $ "http://127.0.0.1:" ++ show port2 let req = req' { HC.requestBody = HC.RequestBodyBS body