diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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) diff --git a/Network/HTTP/ReverseProxy.hs b/Network/HTTP/ReverseProxy.hs --- a/Network/HTTP/ReverseProxy.hs +++ b/Network/HTTP/ReverseProxy.hs @@ -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 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.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 diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -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 ->