http-reverse-proxy 0.6.0 → 0.6.0.1
raw patch · 4 files changed
+123/−25 lines, 4 filesdep ~basenew-uploaderPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Network.HTTP.ReverseProxy: wpsLogRequest :: WaiProxySettings -> Request -> IO ()
Files
- ChangeLog.md +9/−0
- Network/HTTP/ReverseProxy.hs +84/−21
- http-reverse-proxy.cabal +6/−4
- test/main.hs +24/−0
ChangeLog.md view
@@ -1,3 +1,12 @@+## 0.6.0.2++* Add `wpsLogRequest` function which provides the ability to log the+ constructed `Request`.++## 0.6.0.1++* Introduce a "semi cached body" to let the beginning of a request body be retried [#34](https://github.com/fpco/http-reverse-proxy/issues/34)+ ## 0.6.0 * Switch over to `unliftio` and conduit 1.3
Network/HTTP/ReverseProxy.hs view
@@ -26,6 +26,7 @@ , wpsProcessBody , wpsUpgradeToRaw , wpsGetDest+ , wpsLogRequest , SetIpHeader (..) -- *** Local settings , LocalWaiProxySettings@@ -51,6 +52,8 @@ import qualified Data.Conduit.Network as DCN import Data.Functor.Identity (Identity (..)) import Data.IORef+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe, listToMaybe) import Data.Monoid (mappend, mconcat, (<>)) import Data.Set (Set)@@ -133,7 +136,7 @@ -- -- If you need more control, such as modifying the request or response, use 'waiProxyTo'. ----- Since 0.4.4+-- @since 0.4.4 rawTcpProxyTo :: MonadIO m => ProxyDest -> AppData@@ -156,15 +159,15 @@ -- | The different responses that could be generated by a @waiProxyTo@ lookup -- function. ----- Since 0.2.0+-- @since 0.2.0 data WaiProxyResponse = WPRResponse WAI.Response -- ^ Respond with the given WAI Response. --- -- Since 0.2.0+ -- @since 0.2.0 | WPRProxyDest ProxyDest -- ^ Send to the given destination. --- -- Since 0.2.0+ -- @since 0.2.0 | WPRProxyDestSecure ProxyDest -- ^ Send to the given destination via HTTPS. | WPRModifiedRequest WAI.Request ProxyDest@@ -173,15 +176,18 @@ -- request. This can be useful for reverse proxying to -- a different path than the one specified. By the -- user.+ -- The path will be taken from rawPathInfo while+ -- the queryString from rawQueryString of the+ -- request. --- -- Since 0.2.0+ -- @since 0.2.0 | WPRModifiedRequestSecure WAI.Request ProxyDest -- ^ Same as WPRModifiedRequest but send to the -- given destination via HTTPS. | WPRApplication WAI.Application -- ^ Respond with the given WAI Application. --- -- Since 0.4.0+ -- @since 0.4.0 -- | Creates a WAI 'WAI.Application' which will handle reverse proxies. --@@ -212,12 +218,12 @@ -- -- Default: no timeouts --- -- Since 0.4.2+ -- @since 0.4.2 } -- | Default value for 'LocalWaiProxySettings', same as 'def' but with a more explicit name. ----- Since 0.4.2+-- @since 0.4.2 defaultLocalWaiProxySettings :: LocalWaiProxySettings defaultLocalWaiProxySettings = LocalWaiProxySettings Nothing @@ -225,7 +231,7 @@ -- -- Default: no timeouts ----- Since 0.4.2+-- @since 0.4.2 setLpsTimeBound :: Maybe Int -> LocalWaiProxySettings -> LocalWaiProxySettings setLpsTimeBound x s = s { lpsTimeBound = x } @@ -237,13 +243,13 @@ -- -- Default: SIHFromSocket --- -- Since 0.2.0+ -- @since 0.2.0 , wpsProcessBody :: WAI.Request -> HC.Response () -> Maybe (ConduitT ByteString (Flush Builder) IO ()) -- ^ Post-process the response body returned from the host. -- The API for this function changed to include the extra 'WAI.Request' -- parameter in version 0.5.0. --- -- Since 0.2.1+ -- @since 0.2.1 , wpsUpgradeToRaw :: WAI.Request -> Bool -- ^ Determine if the request should be upgraded to a raw proxy connection, -- as is needed for WebSockets. Requires WAI 2.1 or higher and a WAI@@ -251,7 +257,7 @@ -- -- Default: check if the upgrade header is websocket. --- -- Since 0.3.1+ -- @since 0.3.1 , wpsGetDest :: Maybe (WAI.Request -> IO (LocalWaiProxySettings, WaiProxyResponse)) -- ^ Allow to override proxy settings for each request. -- If you supply this field it will take precedence over@@ -259,12 +265,18 @@ -- -- Default: have one global setting --- -- Since 0.4.2+ -- @since 0.4.2+ , wpsLogRequest :: HC.Request -> IO ()+ -- ^ Function provided to log the 'Request' that is constructed.+ --+ -- Default: no op+ --+ -- @since 0.6.0.2 } -- | How to set the X-Real-IP request header. ----- Since 0.2.0+-- @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@@ -281,6 +293,7 @@ , wpsUpgradeToRaw = \req -> (CI.mk <$> lookup "upgrade" (WAI.requestHeaders req)) == Just "websocket" , wpsGetDest = Nothing+ , wpsLogRequest = const (pure ()) } renderHeaders :: WAI.Request -> HT.RequestHeaders -> Builder@@ -375,6 +388,12 @@ case edest of Left app -> maybe id timeBound (lpsTimeBound lps) $ app req0 sendResponse Right (ProxyDest host port, req, secure) -> tryWebSockets wps host port req sendResponse $ do+ scb <- semiCachedBody (WAI.requestBody req)+ let body =+ case WAI.requestBodyLength req of+ WAI.KnownLength i -> HC.RequestBodyStream (fromIntegral i) scb+ WAI.ChunkedBody -> HC.RequestBodyStreamChunked scb+ let req' = #if MIN_VERSION_http_client(0, 5, 0) HC.defaultRequest@@ -395,14 +414,10 @@ , HC.requestBody = body , HC.redirectCount = 0 }- body =- case WAI.requestBodyLength req of- WAI.KnownLength i -> HC.RequestBodyStream- (fromIntegral i)- ($ WAI.requestBody req)- WAI.ChunkedBody -> HC.RequestBodyStreamChunked ($ WAI.requestBody req) bracket- (try $ HC.responseOpen req' manager)+ (try $ do+ liftIO $ wpsLogRequest wps' req'+ HC.responseOpen req' manager) (either (const $ return ()) HC.responseClose) $ \case Left e -> wpsOnExc wps e req sendResponse@@ -418,6 +433,54 @@ case mb of Flush -> flush Chunk b -> sendChunk b))++-- | Introduce a minor level of caching to handle some basic+-- retry cases inside http-client. But to avoid a DoS attack,+-- don't cache more than 65535 bytes (the theoretical max TCP packet size).+--+-- See: <https://github.com/fpco/http-reverse-proxy/issues/34#issuecomment-719136064>+semiCachedBody :: IO ByteString -> IO (HC.GivesPopper ())+semiCachedBody orig = do+ ref <- newIORef $ SCBCaching 0 []+ pure $ \needsPopper -> do+ let fromChunks len chunks =+ case NE.nonEmpty (reverse chunks) of+ Nothing -> SCBCaching len chunks+ Just toDrain -> SCBDraining len chunks toDrain+ state0 <- readIORef ref >>=+ \case+ SCBCaching len chunks -> pure $ fromChunks len chunks+ SCBDraining len chunks _ -> pure $ fromChunks len chunks+ SCBTooMuchData -> error "Cannot retry this request body, need to force a new request"+ writeIORef ref $! state0+ let popper :: IO ByteString+ popper = do+ readIORef ref >>=+ \case+ SCBDraining len chunks (next:|rest) -> do+ writeIORef ref $!+ case rest of+ [] -> SCBCaching len chunks+ x:xs -> SCBDraining len chunks (x:|xs)+ pure next+ SCBTooMuchData -> orig+ SCBCaching len chunks -> do+ bs <- orig+ let newLen = len + S.length bs+ writeIORef ref $!+ if newLen > maxCache+ then SCBTooMuchData+ else SCBCaching newLen (bs:chunks)+ pure bs++ needsPopper popper+ where+ maxCache = 65535++data SCB+ = SCBCaching !Int ![ByteString]+ | SCBDraining !Int ![ByteString] !(NonEmpty ByteString)+ | SCBTooMuchData -- | Get the HTTP headers for the first request on the stream, returning on -- consumed bytes as leftovers. Has built-in limits on how many bytes it will
http-reverse-proxy.cabal view
@@ -1,5 +1,5 @@ name: http-reverse-proxy-version: 0.6.0+version: 0.6.0.1 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@@ -9,15 +9,16 @@ maintainer: michael@fpcomplete.com category: Web build-type: Simple-cabal-version: >=1.8+cabal-version: >=1.10 extra-source-files: README.md ChangeLog.md library+ default-language: Haskell2010 exposed-modules: Network.HTTP.ReverseProxy other-modules: Paths_http_reverse_proxy if impl(ghc < 8) buildable: False- build-depends: base >= 4.6 && < 5+ build-depends: base >= 4.11 && < 5 , text >= 0.11 , bytestring >= 0.9 , case-insensitive >= 0.4@@ -37,10 +38,11 @@ , streaming-commons test-suite test+ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test- build-depends: base+ build-depends: base < 10 , http-reverse-proxy , wai , http-types
test/main.hs view
@@ -44,6 +44,7 @@ setBeforeMainLoop, setPort) import System.IO.Unsafe (unsafePerformIO) import UnliftIO (timeout)+import UnliftIO.IORef import Test.Hspec (describe, hspec, it, shouldBe) nextPort :: I.IORef Int@@ -210,6 +211,29 @@ withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port4 lbs `shouldBe` "127.0.0.1"+ it "performs log action" $+ let ioref :: IO (IORef Int)+ ioref = newIORef 1+ performLogAction :: IORef Int -> IO ()+ performLogAction ref = writeIORef ref 2+ waiProxyTo' getDest onError manager ref =+ waiProxyToSettings+ getDest+ defaultWaiProxySettings+ { wpsOnExc = onError,+ wpsSetIpHeader = SIHFromHeader,+ wpsLogRequest = const (performLogAction ref)+ }+ manager+ in withMan $ \manager ->+ withWApp (\_ f -> f $ responseLBS status200 [] "works") $ \port1 -> do+ ref <- ioref+ withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager ref) $ \port2 ->+ withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 ->+ withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do+ _ <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port4+ lhs <- liftIO $ readIORef ref+ lhs `shouldBe` 2 {- FIXME describe "waiToRaw" $ do it "works" $ do