From 35a5fd720c3a8fbc448354b34915a8b234b7a3c9 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 3 Apr 2019 20:12:35 +1100 Subject: [PATCH] Use latest conduit version --- .travis.yml | 3 ++- Network/HTTP/Proxy.hs | 21 ++++++++++++++------ http-proxy.cabal | 44 ++++++++++++++++++++--------------------- test/Test/TestServer.hs | 13 +++++++----- test/Test/Util.hs | 23 ++++++++++----------- test/test-io.hs | 13 ++++++------ 6 files changed, 65 insertions(+), 52 deletions(-) diff --git a/.travis.yml b/.travis.yml index 31e098b..8f5869e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,9 +5,10 @@ os: linux dist: xenial env: - - GHCVER=7.10.3 - GHCVER=8.0.2 - GHCVER=8.2.2 + - GHCVER=8.4.4 + - GHCVER=8.6.4 before_install: - sudo add-apt-repository -y ppa:hvr/ghc diff --git a/Network/HTTP/Proxy.hs b/Network/HTTP/Proxy.hs index e6ea89c..2fcd43c 100644 --- a/Network/HTTP/Proxy.hs +++ b/Network/HTTP/Proxy.hs @@ -45,9 +45,12 @@ import Blaze.ByteString.Builder (fromByteString) import Control.Concurrent.Async (race_) import Control.Exception -- (SomeException, catch, toException) import Data.ByteString.Char8 (ByteString) -import Data.Conduit (Flush (..), Sink, Source, ($$), mapOutput, yield) +import Data.Conduit (ConduitT, Flush (..), (.|), mapOutput, runConduit, yield) import Data.Conduit.Network -import Data.Monoid +#if ! MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif +import Data.Void (Void) import Network.Socket import Network.Wai.Conduit hiding (Request, requestMethod) @@ -194,7 +197,13 @@ doUpstreamRequest settings mgr respond mwreq errorResponse = proxyOnException settings . toException -handleConnect :: Wai.Request -> Source IO BS.ByteString -> Sink BS.ByteString IO () -> IO () +-- handleConnect :: Wai.Request -> ConduitT IO BS.ByteString -> ConduitT BS.ByteString IO () -> IO () + +handleConnect :: Wai.Request + -> ConduitT () ByteString IO () + -> ConduitT ByteString Void IO a + -> IO () + handleConnect wreq fromClient toClient = do let (host, port) = case BS.break (== ':') $ Wai.rawPathInfo wreq of @@ -205,7 +214,7 @@ handleConnect wreq fromClient toClient = do Nothing -> (x, 80) settings = clientSettings port host runTCPClient settings $ \ad -> do - yield "HTTP/1.1 200 OK\r\n\r\n" $$ toClient + _ <- runConduit $ yield "HTTP/1.1 200 OK\r\n\r\n" .| toClient race_ - (fromClient $$ NC.appSink ad) - (NC.appSource ad $$ toClient) + (runConduit $ fromClient .| NC.appSink ad) + (runConduit $ NC.appSource ad .| toClient) diff --git a/http-proxy.cabal b/http-proxy.cabal index 6855ce6..0354d1e 100644 --- a/http-proxy.cabal +++ b/http-proxy.cabal @@ -35,29 +35,27 @@ library Network.HTTP.Proxy.Request build-depends: base >= 4 && < 5 - , async >= 2.0 - , blaze-builder >= 0.4 - , bytestring >= 0.10 - , bytestring-lexing >= 0.4 - , case-insensitive >= 1.2 - , conduit >= 1.2 - , conduit-extra >= 1.1 && < 1.3 - , http-client - -- More recent versions seem to have broken proxy support. - , http-conduit >= 2.1.11 && < 2.2 - , http-types >= 0.8 - , mtl >= 2.1 - , network == 2.7.* - , resourcet >= 1.1 - -- Not used directly but necessary to enforce < 0.2 - , streaming-commons >= 0.1 && < 0.2 - , tls >= 1.2 - , text >= 1.2 - , transformers >= 0.3 - , wai >= 3.2 - , wai-conduit >= 3.0 - , warp >= 3.0 - , warp-tls >= 3.0 + , async == 2.2.* + , blaze-builder == 0.4.* + , bytestring == 0.10.* + , bytestring-lexing == 0.5.* + , case-insensitive == 1.2.* + , conduit == 1.3.* + , conduit-extra == 1.3.* + , http-client == 0.6.* + , http-conduit == 2.3.* + , http-types == 0.12.* + , mtl == 2.2.* + , network == 2.8.* + , resourcet == 1.2.* + , streaming-commons == 0.2.* + , tls == 1.4.* + , text == 1.2.* + , transformers == 0.5.* + , wai == 3.2.* + , wai-conduit == 3.0.* + , warp == 3.2.* + , warp-tls == 3.2.* diff --git a/test/Test/TestServer.hs b/test/Test/TestServer.hs index 2247e2f..52bd434 100644 --- a/test/Test/TestServer.hs +++ b/test/Test/TestServer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} ------------------------------------------------------------ -- Copyright : Erik de Castro Lopo -- License : BSD3 @@ -10,8 +10,11 @@ module Test.TestServer ) where import Data.ByteString (ByteString) +import Data.Conduit (ConduitT) import Data.List (sort) -import Data.Monoid +#if ! MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif import Data.String import Network.HTTP.Types import Network.Wai @@ -20,7 +23,7 @@ import Network.Wai.Handler.Warp import Network.Wai.Handler.WarpTLS import Data.ByteString.Lex.Integral (readDecimal_) -import Data.Conduit (($$)) +import Data.Conduit ((.|)) import Data.Int (Int64) import qualified Data.ByteString.Char8 as BS @@ -97,9 +100,9 @@ responseBody req = ] -largePostCheck :: Int64 -> DC.Source IO ByteString -> IO Response +largePostCheck :: Int64 -> ConduitT () ByteString IO () -> IO Response largePostCheck len rbody = - maybe success failure <$> (rbody $$ byteSink len) + maybe success failure <$> (DC.runConduit $ rbody .| byteSink len) where success = simpleResponse status200 . BS.pack $ "Post-size: " ++ show len failure = simpleResponse status500 diff --git a/test/Test/Util.hs b/test/Test/Util.hs index 0fe9a84..b13c5d5 100644 --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -10,8 +10,9 @@ import Blaze.ByteString.Builder import Control.Concurrent.Async import Control.Exception hiding (assert) import Control.Monad (forM_, when, unless) -import Control.Monad.Trans.Resource +import Control.Monad.Trans.Resource (runResourceT) import Data.ByteString (ByteString) +import Data.Conduit (ConduitT, Flush (..), SealedConduitT) import Data.Int (Int64) import Data.Maybe import Data.String (fromString) @@ -156,14 +157,14 @@ httpRun req = do runResourceT $ do resp <- HC.http (modifyRequest req) mgr let contentLen = readInt64 <$> lookup HT.hContentLength (HC.responseHeaders resp) - bodyText <- checkBodySize (HC.responseBody resp) contentLen + bodyText <- checkBodySize (DC.sealConduitT $ HC.responseBody resp) contentLen return $ Result (HC.secure req) (HT.statusCode $ HC.responseStatus resp) (HC.responseHeaders resp) bodyText where modifyRequest r = r { HC.redirectCount = 0 } -checkBodySize :: (Monad f, Functor f) => DC.ResumableSource f ByteString -> Maybe Int64 -> f ByteString +checkBodySize :: Monad f => SealedConduitT () ByteString f () -> Maybe Int64 -> f ByteString checkBodySize bodySrc Nothing = fmap (BS.concat . LBS.toChunks) $ bodySrc DC.$$+- CB.take 1000 checkBodySize bodySrc (Just len) = do let blockSize = 1000 @@ -172,13 +173,13 @@ checkBodySize bodySrc (Just len) = do else fromMaybe "Success" <$> (bodySrc DC.$$+- byteSink len) -byteSink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString) +byteSink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString) byteSink bytes = sink 0 where - sink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString) + sink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString) sink !count = DC.await >>= maybe (closeSink count) (sinkBlock count) - sinkBlock :: Monad m => Int64 -> ByteString -> DC.Sink ByteString m (Maybe ByteString) + sinkBlock :: Monad m => Int64 -> ByteString -> ConduitT ByteString a m (Maybe ByteString) sinkBlock !count bs = sink (count + fromIntegral (BS.length bs)) closeSink :: Monad m => Int64 -> m (Maybe ByteString) @@ -189,14 +190,14 @@ byteSink bytes = sink 0 ++ " should have been " ++ show bytes ++ "." -builderSource :: Monad m => Int64 -> DC.Source m (DC.Flush Builder) -builderSource = DC.mapOutput (DC.Chunk . fromByteString) . byteSource +builderSource :: Monad m => Int64 -> ConduitT () (Flush Builder) m () +builderSource = DC.mapOutput (Chunk . fromByteString) . byteSource -byteSource :: Monad m => Int64 -> DC.Source m ByteString +byteSource :: Monad m => Int64 -> ConduitT i ByteString m () byteSource bytes = loop 0 where - loop :: Monad m => Int64 -> DC.Source m ByteString + loop :: Monad m => Int64 -> ConduitT i ByteString m () loop !count | count >= bytes = return () | count + blockSize64 < bytes = do @@ -205,7 +206,7 @@ byteSource bytes = loop 0 | otherwise = do let n = fromIntegral $ bytes - count DC.yield $ BS.take n bsbytes - return () + pure () blockSize = 8192 :: Int blockSize64 = fromIntegral blockSize :: Int64 diff --git a/test/test-io.hs b/test/test-io.hs index a83cac0..d81d07d 100644 --- a/test/test-io.hs +++ b/test/test-io.hs @@ -8,10 +8,11 @@ import Control.Concurrent.Async import Control.Exception import Control.Monad -import Control.Monad.Trans.Resource import Data.Conduit import Data.Int (Int64) -import Data.Monoid +#if ! MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif import System.Environment import Test.Hspec @@ -57,12 +58,12 @@ testHelpersTest = -- Test the HTTP and HTTPS servers directly (ie bypassing the Proxy). describe "Test helper functionality:" $ do it "Byte Sink catches short response bodies." $ - runResourceT (byteSource 80 $$ byteSink 100) + runConduit (byteSource 80 .| byteSink 100) `shouldReturn` Just "Error : Body length 80 should have been 100." it "Byte Source and Sink work in constant memory." $ - runResourceT (byteSource oneBillion $$ byteSink oneBillion) `shouldReturn` Nothing + runConduit (byteSource oneBillion .| byteSink oneBillion) `shouldReturn` Nothing it "Byte Sink catches long response bodies." $ - runResourceT (byteSource 110 $$ byteSink 100) + runConduit (byteSource 110 .| byteSink 100) `shouldReturn` Just "Error : Body length 110 should have been 100." it "Client and server can stream GET response." $ do let size = oneBillion @@ -143,7 +144,7 @@ requestTest = describe "Request:" $ do -- Getting a TlsException shows that we have successfully upgraded -- from HTTP to HTTPS. Its not possible to ignore this failure -- because its made by the http-conduit inside the proxy. - BS.takeWhile (/= ' ') (resultBS result) `shouldBe` "TlsExceptionHostPort" + BS.takeWhile (/= ' ') (resultBS result) `shouldBe` "HttpExceptionRequest" it "Can provide a proxy Response." $ withTestProxy proxySettingsProxyResponse $ \ testProxyPort -> do req <- addTestProxy testProxyPort <$> mkGetRequest Http "/whatever"