http-proxy 0.1.0.6 → 0.1.1.0
raw patch · 7 files changed
+107/−74 lines, 7 filesdep ~asyncdep ~blaze-builderdep ~bytestring
Dependency ranges changed: async, blaze-builder, bytestring, bytestring-lexing, case-insensitive, conduit, conduit-extra, http-client, http-conduit, http-types, mtl, network, resourcet, streaming-commons, text, tls, transformers, wai, wai-conduit, warp, warp-tls
Files
- ChangeLog.md +3/−0
- Network/HTTP/Proxy.hs +15/−6
- Readme.md +18/−0
- http-proxy.cabal +41/−44
- test/Test/TestServer.hs +8/−5
- test/Test/Util.hs +15/−13
- test/test-io.hs +7/−6
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.1.0++* Make it build with version 1.3.* of conduit.
Network/HTTP/Proxy.hs view
@@ -45,9 +45,12 @@ 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 @@ 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 @@ 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)
+ Readme.md view
@@ -0,0 +1,18 @@+# http-proxy++[](http://travis-ci.org/erikd/http-proxy)++A Haskell library for creating HTTP and HTTPS web proxies.++The aim is to make all proxying operations work in constant space (per+connection) so that memory usage scales linearly with the number of concurrent+connections and is completely independent of the size of either the POST+request body or the response body.++This library relies heavily on the following libraries:++* wai : A common protocol between web servers and clients.+* warp : The web servers the proxy application runs in.+* http-conduit / http-client : Perform the upstream requests.++This is still beta quality.
http-proxy.cabal view
@@ -1,17 +1,18 @@-name: http-proxy-version: 0.1.0.6-license: BSD3-license-file: LICENSE-author: Michael Snoyman, Erik de Castro Lopo-maintainer: erikd@mega-nerd.com-homepage: https://github.com/erikd/http-proxy-bug-reports: https://github.com/erikd/http-proxy/issues-category: Web-build-type: Simple-cabal-version: >= 1.10-stability: Experimental+name: http-proxy+version: 0.1.1.0+license: BSD3+license-file: LICENSE+author: Michael Snoyman, Erik de Castro Lopo+maintainer: erikd@mega-nerd.com+homepage: https://github.com/erikd/http-proxy+bug-reports: https://github.com/erikd/http-proxy/issues+category: Web+build-type: Simple+cabal-version: >= 1.10+stability: Experimental+extra-source-files: ChangeLog.md Readme.md -synopsis: A library for writing HTTP and HTTPS proxies+synopsis: A library for writing HTTP and HTTPS proxies description: http-proxy is a library for writing HTTP and HTTPS proxies.@@ -25,6 +26,10 @@ a functions for exception reporting and request re-writing. Eventually, this capability will be expanded to allow optional logging, disk caching etc. +source-repository head+ type: git+ location: https://github.com/erikd/http-proxy.git+ library default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs@@ -35,35 +40,33 @@ 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.6- , 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.* test-suite test type: exitcode-stdio-1.0- ghc-options: -Wall -fwarn-tabs -threaded+ ghc-options: -Wall -fwarn-tabs -threaded -rtsopts "-with-rtsopts=-H1m -K1m" if os(windows) cpp-options: -DWINDOWS default-language: Haskell2010@@ -104,7 +107,7 @@ test-suite test-io type: exitcode-stdio-1.0- ghc-options: -Wall -fwarn-tabs -threaded+ ghc-options: -Wall -fwarn-tabs -threaded -rtsopts "-with-rtsopts=-H1m -K1m" if os(windows) cpp-options: -DWINDOWS default-language: Haskell2010@@ -142,9 +145,3 @@ , wai-conduit , warp , warp-tls----source-repository head- type: git- location: https://github.com/erikd/http-proxy.git
test/Test/TestServer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} ------------------------------------------------------------ -- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com> -- License : BSD3@@ -10,8 +10,11 @@ ) 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.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 @@ ] -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
test/Test/Util.hs view
@@ -10,8 +10,9 @@ 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 @@ 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 @@ 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 @@ ++ " 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 @@ | otherwise = do let n = fromIntegral $ bytes - count DC.yield $ BS.take n bsbytes- return ()+ pure () blockSize = 8192 :: Int blockSize64 = fromIntegral blockSize :: Int64@@ -224,8 +225,9 @@ openLocalhostListenSocket :: IO (Socket, Port) openLocalhostListenSocket = do sock <- socket AF_INET Stream defaultProtocol- addr <- inet_addr "127.0.0.1"- bind sock (SockAddrInet aNY_PORT addr)+ addr:_ <- getAddrInfo Nothing (Just "127.0.0.1") Nothing+ bind sock (addrAddress addr) listen sock 10 port <- fromIntegral <$> socketPort sock return (sock, port)+
test/test-io.hs view
@@ -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 @@ -- 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 @@ -- 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"