http-reverse-proxy 0.5.0.1 → 0.6.0
raw patch · 4 files changed
+56/−64 lines, 4 filesdep +unliftiodep −asyncdep −data-default-classdep −lifted-basedep ~conduitdep ~http-conduitPVP ok
version bump matches the API change (PVP)
Dependencies added: unliftio
Dependencies removed: async, data-default-class, lifted-base, monad-control
Dependency ranges changed: conduit, http-conduit
API changes (from Hackage documentation)
- Network.HTTP.ReverseProxy: def :: Default a => a
- Network.HTTP.ReverseProxy: instance Data.Default.Class.Default Network.HTTP.ReverseProxy.LocalWaiProxySettings
- Network.HTTP.ReverseProxy: instance Data.Default.Class.Default Network.HTTP.ReverseProxy.WaiProxySettings
+ Network.HTTP.ReverseProxy: defaultWaiProxySettings :: WaiProxySettings
- Network.HTTP.ReverseProxy: rawProxyTo :: (MonadBaseControl IO m, MonadIO m) => (RequestHeaders -> m (Either (AppData -> m ()) ProxyDest)) -> AppData -> m ()
+ Network.HTTP.ReverseProxy: rawProxyTo :: MonadUnliftIO m => (RequestHeaders -> m (Either (AppData -> m ()) ProxyDest)) -> AppData -> m ()
- Network.HTTP.ReverseProxy: rawTcpProxyTo :: (MonadBaseControl IO m, MonadIO m) => ProxyDest -> AppData -> m ()
+ Network.HTTP.ReverseProxy: rawTcpProxyTo :: MonadIO m => ProxyDest -> AppData -> m ()
- Network.HTTP.ReverseProxy: wpsProcessBody :: WaiProxySettings -> Request -> Response () -> Maybe (Conduit ByteString IO (Flush Builder))
+ Network.HTTP.ReverseProxy: wpsProcessBody :: WaiProxySettings -> Request -> Response () -> Maybe (ConduitT ByteString (Flush Builder) IO ())
Files
- ChangeLog.md +5/−0
- Network/HTTP/ReverseProxy.hs +25/−33
- http-reverse-proxy.cabal +7/−8
- test/main.hs +19/−23
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.6.0++* Switch over to `unliftio` and conduit 1.3+* Drop dependency on `data-default-class`, drop `Default` instances+ ## 0.5.0.1 * Support http-conduit 2.3 in test suite [#26](https://github.com/fpco/http-reverse-proxy/issues/26)
Network/HTTP/ReverseProxy.hs view
@@ -19,7 +19,7 @@ , WaiProxyResponse (..) -- ** Settings , WaiProxySettings- , def+ , defaultWaiProxySettings , wpsOnExc , wpsTimeout , wpsSetIpHeader@@ -40,15 +40,7 @@ import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString) import Control.Applicative ((<$>), (<|>))-import Control.Concurrent.Async (concurrently)-import Control.Concurrent.Lifted (fork, killThread)-import Control.Concurrent.MVar.Lifted (newEmptyMVar, putMVar,- takeMVar)-import Control.Exception (bracket)-import Control.Exception.Lifted (SomeException, finally, try)-import Control.Monad (unless, void)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad (unless) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8@@ -57,7 +49,6 @@ import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Network as DCN-import Data.Default.Class (Default (..), def) import Data.Functor.Identity (Identity (..)) import Data.IORef import Data.Maybe (fromMaybe, listToMaybe)@@ -76,7 +67,7 @@ import qualified Network.HTTP.Types as HT import qualified Network.Wai as WAI import Network.Wai.Logger (showSockAddr)-import System.Timeout.Lifted (timeout)+import UnliftIO (MonadIO, liftIO, MonadUnliftIO, timeout, SomeException, try, bracket, concurrently_) -- | Host\/port combination to which we want to proxy. data ProxyDest = ProxyDest@@ -98,7 +89,7 @@ -- 4. Pass all bytes across the wire unchanged. -- -- If you need more control, such as modifying the request or response, use 'waiProxyTo'.-rawProxyTo :: (MonadBaseControl IO m, MonadIO m)+rawProxyTo :: MonadUnliftIO m => (HT.RequestHeaders -> m (Either (DCN.AppData -> m ()) ProxyDest)) -- ^ How to reverse proxy. A @Left@ result will run the given -- 'DCN.Application', whereas a @Right@ will reverse proxy to the@@ -124,9 +115,9 @@ where fromClient = DCN.appSource appdata toClient = DCN.appSink appdata- withServer rsrc appdataServer = void $ concurrently+ withServer rsrc appdataServer = concurrently_ (rsrc $$+- toServer)- (fromServer $$ toClient)+ (runConduit $ fromServer .| toClient) where fromServer = DCN.appSource appdataServer toServer = DCN.appSink appdataServer@@ -143,16 +134,16 @@ -- If you need more control, such as modifying the request or response, use 'waiProxyTo'. -- -- Since 0.4.4-rawTcpProxyTo :: (MonadBaseControl IO m, MonadIO m)+rawTcpProxyTo :: MonadIO m => ProxyDest -> AppData -> m () rawTcpProxyTo (ProxyDest host port) appdata = liftIO $ DCN.runTCPClient (DCN.clientSettings port host) withServer where- withServer appdataServer = void $ concurrently- (DCN.appSource appdata $$ DCN.appSink appdataServer)- (DCN.appSource appdataServer $$ DCN.appSink appdata )+ withServer appdataServer = concurrently_+ (runConduit $ DCN.appSource appdata .| DCN.appSink appdataServer)+ (runConduit $ DCN.appSource appdataServer .| DCN.appSink appdata ) -- | Sends a simple 502 bad gateway error message with the contents of the -- exception.@@ -213,7 +204,7 @@ -- simple 502 error page, use 'defaultOnExc'. -> HC.Manager -- ^ connection manager to utilize -> WAI.Application-waiProxyTo getDest onError = waiProxyToSettings getDest def { wpsOnExc = onError }+waiProxyTo getDest onError = waiProxyToSettings getDest defaultWaiProxySettings { wpsOnExc = onError } data LocalWaiProxySettings = LocalWaiProxySettings { lpsTimeBound :: Maybe Int@@ -223,14 +214,12 @@ -- -- Since 0.4.2 }-instance Default LocalWaiProxySettings where- def = LocalWaiProxySettings Nothing -- | Default value for 'LocalWaiProxySettings', same as 'def' but with a more explicit name. -- -- Since 0.4.2 defaultLocalWaiProxySettings :: LocalWaiProxySettings-defaultLocalWaiProxySettings = def+defaultLocalWaiProxySettings = LocalWaiProxySettings Nothing -- | Allows to specify the maximum time allowed for the conection on per request basis. --@@ -249,7 +238,7 @@ -- Default: SIHFromSocket -- -- Since 0.2.0- , wpsProcessBody :: WAI.Request -> HC.Response () -> Maybe (Conduit ByteString IO (Flush Builder))+ , 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.@@ -280,8 +269,11 @@ | 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+-- | Default value for 'WaiProxySettings'+--+-- @since 0.6.0+defaultWaiProxySettings :: WaiProxySettings+defaultWaiProxySettings = WaiProxySettings { wpsOnExc = defaultOnExc , wpsTimeout = Nothing , wpsSetIpHeader = SIHFromSocket@@ -326,9 +318,9 @@ loop toClient' = awaitForever $ liftIO . toClient headers = renderHeaders req $ fixReqHeaders wps req- in void $ concurrently- (fromClient $$ toServer)- (fromServer $$ toClient')+ in concurrently_+ (runConduit $ fromClient .| toServer)+ (runConduit $ fromServer .| toClient') | otherwise = fallback where backup = WAI.responseLBS HT.status500 [("Content-Type", "text/plain")]@@ -365,7 +357,7 @@ waiProxyToSettings getDest wps' manager req0 sendResponse = do let wps = wps'{wpsGetDest = wpsGetDest wps' <|> Just (fmap (LocalWaiProxySettings $ wpsTimeout wps',) . getDest)} (lps, edest') <- fromMaybe- (const $ return (def, WPRResponse $ WAI.responseLBS HT.status500 [] "proxy not setup"))+ (const $ return (defaultLocalWaiProxySettings, WPRResponse $ WAI.responseLBS HT.status500 [] "proxy not setup")) (wpsGetDest wps) req0 let edest =@@ -422,7 +414,7 @@ sendResponse $ WAI.responseStream (HC.responseStatus res) (filter (\(key, _) -> not $ key `Set.member` strippedHeaders) $ HC.responseHeaders res)- (\sendChunk flush -> src $= conduit $$ CL.mapM_ (\mb ->+ (\sendChunk flush -> runConduit $ src .| conduit .| CL.mapM_ (\mb -> case mb of Flush -> flush Chunk b -> sendChunk b))@@ -431,7 +423,7 @@ -- consumed bytes as leftovers. Has built-in limits on how many bytes it will -- consume (specifically, will not ask for another chunked after it receives -- 1000 bytes).-getHeaders :: Monad m => Sink ByteString m HT.RequestHeaders+getHeaders :: Monad m => ConduitT ByteString o m HT.RequestHeaders getHeaders = toHeaders <$> go id where@@ -492,7 +484,7 @@ } -} -bodyReaderSource :: MonadIO m => BodyReader -> Source m ByteString+bodyReaderSource :: MonadIO m => BodyReader -> ConduitT i ByteString m () bodyReaderSource br = loop where
http-reverse-proxy.cabal view
@@ -1,5 +1,5 @@ name: http-reverse-proxy-version: 0.5.0.1+version: 0.6.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@@ -15,9 +15,9 @@ library exposed-modules: Network.HTTP.ReverseProxy other-modules: Paths_http_reverse_proxy+ if impl(ghc < 8)+ buildable: False build-depends: base >= 4.6 && < 5- , monad-control >= 0.3- , lifted-base >= 0.1 , text >= 0.11 , bytestring >= 0.9 , case-insensitive >= 0.4@@ -27,13 +27,12 @@ , http-client >= 0.3 , wai >= 3.0 , network- , conduit >= 1.1+ , conduit >= 1.3 , conduit-extra- , data-default-class , wai-logger , resourcet , containers- , async+ , unliftio >= 0.2 , transformers , streaming-commons @@ -52,9 +51,9 @@ , conduit-extra , blaze-builder , transformers- , lifted-base+ , unliftio , network- , http-conduit+ , http-conduit >= 2.3 , resourcet , streaming-commons
test/main.hs view
@@ -15,8 +15,8 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Char (toUpper)-import Data.Conduit (await, yield, ($$),- ($$+-), (=$), awaitForever)+import Data.Conduit (await, yield, (.|), runConduit,+ awaitForever) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.Network (ServerSettings,@@ -32,18 +32,18 @@ defaultOnExc, rawProxyTo, rawTcpProxyTo, WaiProxySettings (..), SetIpHeader (..),- def,+ defaultWaiProxySettings, waiProxyToSettings, waiProxyTo) import Network.HTTP.Types (status200, status500)-import Network.Socket (sClose)+import qualified Network.Socket import Network.Wai (rawPathInfo, responseLBS, responseStream, requestHeaders) import qualified Network.Wai import Network.Wai.Handler.Warp (defaultSettings, runSettings, setBeforeMainLoop, setPort) import System.IO.Unsafe (unsafePerformIO)-import System.Timeout.Lifted (timeout)+import UnliftIO (timeout) import Test.Hspec (describe, hspec, it, shouldBe) nextPort :: I.IORef Int@@ -57,7 +57,7 @@ case esocket of Left (_ :: IOException) -> getPort Right socket -> do- sClose socket+ Network.Socket.close socket return port withWApp :: Network.Wai.Application -> (Int -> IO ()) -> IO ()@@ -123,14 +123,10 @@ in withMan $ \manager -> withWApp app $ \port1 -> 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+ req <- HC.parseUrlThrow $ "http://127.0.0.1:" ++ show port2 mbs <- runResourceT $ timeout 1000000 $ do res <- HC.http req manager-#if MIN_VERSION_http_conduit(1, 3, 0)- HC.responseBody res $$ await-#else- HC.responseBody res $$+- await-#endif+ runConduit $ HC.responseBody res .| await mbs `shouldBe` Just (Just "hello") it "passes on body length" $ let app req f = f $ responseLBS@@ -143,7 +139,7 @@ in withMan $ \manager -> withWApp app $ \port1 -> 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+ req' <- HC.parseUrlThrow $ "http://127.0.0.1:" ++ show port2 let req = req' { HC.requestBody = HC.RequestBodyBS body }@@ -160,23 +156,23 @@ bs <- liftIO src unless (S8.null bs) $ yield bs >> src' sink' = awaitForever $ liftIO . sink- src' $$ CL.iterM print =$ CL.map (S8.map toUpper) =$ sink'+ runConduit $ src' .| CL.iterM print .| CL.map (S8.map toUpper) .| sink' fallback = responseLBS status500 [] "fallback used" in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> runTCPClient (clientSettings port2 "127.0.0.1") $ \ad -> do- yield "GET / HTTP/1.1\r\nUpgrade: websockET\r\n\r\n" $$ appSink ad- yield "hello" $$ appSink ad- (appSource ad $$ CB.take 5) >>= (`shouldBe` "HELLO")+ runConduit $ yield "GET / HTTP/1.1\r\nUpgrade: websockET\r\n\r\n" .| appSink ad+ runConduit $ yield "hello" .| appSink ad+ (runConduit $ appSource ad .| CB.take 5) >>= (`shouldBe` "HELLO") it "get real ip" $ let getRealIp req = L8.fromStrict $ fromMaybe "" $ lookup "x-real-ip" (requestHeaders req) httpWithForwardedFor url = liftIO $ do man <- HC.newManager HC.tlsManagerSettings- oreq <- liftIO $ HC.parseUrl url+ oreq <- liftIO $ HC.parseUrlThrow url let req = oreq { HC.requestHeaders = [("X-Forwarded-For", "127.0.1.1, 127.0.0.1"), ("Connection", "close")] } HC.responseBody <$> HC.httpLbs req man- waiProxyTo' getDest onError = waiProxyToSettings getDest def { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader }+ waiProxyTo' getDest onError = waiProxyToSettings getDest defaultWaiProxySettings { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader } in withMan $ \manager -> withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 ->@@ -188,10 +184,10 @@ let getRealIp req = L8.fromStrict $ fromMaybe "" $ lookup "x-real-ip" (requestHeaders req) httpWithForwardedFor url = liftIO $ do man <- HC.newManager HC.tlsManagerSettings- oreq <- liftIO $ HC.parseUrl url+ oreq <- liftIO $ HC.parseUrlThrow url let req = oreq { HC.requestHeaders = [("X-Forwarded-For", "127.0.1.1"), ("Connection", "close")] } HC.responseBody <$> HC.httpLbs req man- waiProxyTo' getDest onError = waiProxyToSettings getDest def { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader }+ waiProxyTo' getDest onError = waiProxyToSettings getDest defaultWaiProxySettings { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader } in withMan $ \manager -> withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 ->@@ -203,10 +199,10 @@ let getRealIp req = L8.fromStrict $ fromMaybe "" $ lookup "x-real-ip" (requestHeaders req) httpWithForwardedFor url = liftIO $ do man <- HC.newManager HC.tlsManagerSettings- oreq <- liftIO $ HC.parseUrl url+ oreq <- liftIO $ HC.parseUrlThrow url let req = oreq { HC.requestHeaders = [("Connection", "close")] } HC.responseBody <$> HC.httpLbs req man- waiProxyTo' getDest onError = waiProxyToSettings getDest def { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader }+ waiProxyTo' getDest onError = waiProxyToSettings getDest defaultWaiProxySettings { wpsOnExc = onError, wpsSetIpHeader = SIHFromHeader } in withMan $ \manager -> withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 ->