diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.1.2.0 + +* Update dependencies. + ## 0.1.1.0 * Make it build with version 1.3.* of conduit. diff --git a/Network/HTTP/Proxy.hs b/Network/HTTP/Proxy.hs --- a/Network/HTTP/Proxy.hs +++ b/Network/HTTP/Proxy.hs @@ -41,7 +41,7 @@ ) where -import Blaze.ByteString.Builder (fromByteString) +import Data.ByteString.Builder (byteString) import Control.Concurrent.Async (race_) import Control.Exception -- (SomeException, catch, toException) import Data.ByteString.Char8 (ByteString) @@ -105,22 +105,36 @@ -- -- > defaultProxySettings { proxyPort = 3128 } data Settings = Settings - { proxyPort :: Int -- ^ Port to listen on. Default value: 3100 - , proxyHost :: HostPreference -- ^ Default value: HostIPv4 - , proxyOnException :: SomeException -> Wai.Response -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr. - , proxyTimeout :: Int -- ^ Timeout value in seconds. Default value: 30 - , proxyRequestModifier :: Request -> IO (Either Response Request) -- ^ A function that allows the request to be modified before being run. Default: 'return . Right'. - , proxyLogger :: ByteString -> IO () -- ^ A function for logging proxy internal state. Default: 'return ()'. - , proxyUpstream :: Maybe UpstreamProxy -- ^ Optional upstream proxy. + { proxyPort :: Int + -- ^ Port to listen on. Default value: 3100 + , proxyHost :: HostPreference + -- ^ Default value: HostIPv4 + , proxyOnException :: SomeException -> Wai.Response + -- ^ What to do with exceptions thrown by either the application or server. + -- Default: ignore server-generated exceptions (see 'InvalidRequest') and print + -- application-generated applications to stderr. + , proxyTimeout :: Int + -- ^ Timeout value in seconds. Default value: 30 + , proxyHttpRequestModifier :: Request -> IO (Either Response Request) + -- ^ A function that allows the request to be modified before being run. Default: 'return . Right'. + -- This only works for unencrypted HTTP requests (eg to upgrade the request to HTTPS) because + -- HTTPS requests are encrypted. + , proxyLogger :: ByteString -> IO () + -- ^ A function for logging proxy internal state. Default: 'return ()'. + , proxyUpstream :: Maybe UpstreamProxy + -- ^ Optional upstream proxy. } -- | A http-proxy can be configured to use and upstream proxy by providing the -- proxy name, the port it listens to and an option username and password for -- proxy authorisation. data UpstreamProxy = UpstreamProxy - { upstreamHost :: ByteString -- ^ The upstream proxy's hostname. - , upstreamPort :: Int -- ^ The upstream proxy's port number. - , upstreamAuth :: Maybe (ByteString, ByteString) -- ^ Optional username and password to use with upstream proxy. + { upstreamHost :: ByteString + -- ^ The upstream proxy's hostname. + , upstreamPort :: Int + -- ^ The upstream proxy's port number. + , upstreamAuth :: Maybe (ByteString, ByteString) + -- ^ Optional username and password to use with upstream proxy. } @@ -140,23 +154,23 @@ , proxyHost = "*" , proxyOnException = defaultExceptionResponse , proxyTimeout = 30 - , proxyRequestModifier = return . Right + , proxyHttpRequestModifier = return . Right , proxyLogger = const $ return () , proxyUpstream = Nothing } defaultExceptionResponse :: SomeException -> Wai.Response defaultExceptionResponse e = - Wai.responseLBS HT.internalServerError500 - [ (HT.hContentType, "text/plain; charset=utf-8") ] - $ LBS.fromChunks [BS.pack $ show e] + Wai.responseLBS HT.internalServerError500 + [ (HT.hContentType, "text/plain; charset=utf-8") ] + $ LBS.fromChunks [BS.pack $ show e] -- ----------------------------------------------------------------------------- -- Application == Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived httpProxyApp :: Settings -> HC.Manager -> Application httpProxyApp settings mgr wreq respond = do - mwreq <- proxyRequestModifier settings $ proxyRequest wreq + mwreq <- proxyHttpRequestModifier settings $ proxyRequest wreq either respond (doUpstreamRequest settings mgr respond . waiRequest wreq) mwreq @@ -183,7 +197,7 @@ } handle (respond . errorResponse) $ HC.withResponse hreq mgr $ \res -> do - let body = mapOutput (Chunk . fromByteString) . HCC.bodyReaderSource $ HC.responseBody res + let body = mapOutput (Chunk . byteString) . HCC.bodyReaderSource $ HC.responseBody res headers = (CI.mk "X-Via-Proxy", "yes") : filter dropResponseHeader (HC.responseHeaders res) respond $ responseSource (HC.responseStatus res) headers body where @@ -197,13 +211,7 @@ errorResponse = proxyOnException settings . toException --- 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 :: 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 diff --git a/Network/HTTP/Proxy/Request.hs b/Network/HTTP/Proxy/Request.hs --- a/Network/HTTP/Proxy/Request.hs +++ b/Network/HTTP/Proxy/Request.hs @@ -15,7 +15,7 @@ where import Data.ByteString.Char8 (ByteString) -import Data.Maybe +import Data.Maybe (fromMaybe) import Network.HTTP.Types (Method) import qualified Network.HTTP.Types as HT diff --git a/examples/request-rewrite-proxy.hs b/examples/request-rewrite-proxy.hs new file mode 100644 --- /dev/null +++ b/examples/request-rewrite-proxy.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.ByteString.Char8 as BS + +import Network.HTTP.Proxy (Settings (..), Request (..)) +import qualified Network.HTTP.Proxy as Proxy +import Network.URI (URI (..), URIAuth (..), parseURI) +import Network.Wai.Internal (Response) + +main :: IO () +main = + Proxy.runProxySettings $ + Proxy.defaultProxySettings + { proxyPort = 31081 + , proxyHttpRequestModifier = secureGoogle + } + +-- Modifying the request like this is only possible for unencrypted HTTP connections +-- by my be useful for eg redirecting HTTP to HTTPS. +-- HTTPS cnnections cannot be modified like this because the for HTTPS connections +-- even the request itself is encrypted. + +secureGoogle :: Request -> IO (Either Response Request) +secureGoogle req = do + case parseURI $ BS.unpack (requestPath req) of + Nothing -> do + putStrLn $ "Not able to parse: " ++ show (requestPath req) + -- Not much to be done other than just return the Request unmodified. + pure $ Right req + Just uri -> + pure . Right $ req { requestPath = BS.pack $ show (modifyURI uri) } + +modifyURI :: URI -> URI +modifyURI uri = + uri + { uriAuthority = modifyUriAthority <$> uriAuthority uri + , uriScheme = modifyUriScheme (uriScheme uri) + } + where + modifyUriAthority :: URIAuth -> URIAuth + modifyUriAthority auth = + if uriRegName auth == "www.google.com" + then auth { uriRegName = "encrypted.google.com", uriPort = "" } + else auth + + modifyUriScheme :: String -> String + modifyUriScheme scheme = + if scheme =="http:" then "https:" else scheme diff --git a/examples/simple-proxy.hs b/examples/simple-proxy.hs new file mode 100644 --- /dev/null +++ b/examples/simple-proxy.hs @@ -0,0 +1,10 @@ + +import Network.HTTP.Proxy (runProxy) + +-- The simplest possible HTTP/HTTPS proxy. +main :: IO () +main = do + putStrLn "Proxy running on port 31081. Ctrl-C to quit." + runProxy 31081 + + diff --git a/http-proxy.cabal b/http-proxy.cabal --- a/http-proxy.cabal +++ b/http-proxy.cabal @@ -1,5 +1,5 @@ name: http-proxy -version: 0.1.1.0 +version: 0.1.2.0 license: BSD3 license-file: LICENSE author: Michael Snoyman, Erik de Castro Lopo @@ -41,26 +41,25 @@ build-depends: base >= 4 && < 5 , async == 2.2.* - , blaze-builder == 0.4.* - , bytestring == 0.10.* - , bytestring-lexing == 0.5.* - , case-insensitive == 1.2.* + , bytestring >= 0.10.8 + , bytestring-lexing >= 0.5 + , case-insensitive >= 1.2 , conduit == 1.3.* , conduit-extra == 1.3.* - , http-client == 0.6.* + , http-client == 0.7.* , http-conduit == 2.3.* , http-types == 0.12.* , mtl == 2.2.* - , network == 2.8.* + , network >= 3.1 , resourcet == 1.2.* , streaming-commons == 0.2.* - , tls == 1.4.* + , tls == 1.5.* , text == 1.2.* , transformers == 0.5.* , wai == 3.2.* , wai-conduit == 3.0.* - , warp == 3.2.* - , warp-tls == 3.2.* + , warp == 3.3.* + , warp-tls == 3.3.* @@ -145,3 +144,24 @@ , wai-conduit , warp , warp-tls + +executable request-rewrite-proxy + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -threaded -rtsopts "-with-rtsopts=-H1m -K1m" + hs-source-dirs: examples + main-is: request-rewrite-proxy.hs + + build-depends: base + , bytestring + , http-proxy + , network-uri + , wai + +executable simple-proxy + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -threaded -rtsopts "-with-rtsopts=-H1m -K1m" + hs-source-dirs: examples + main-is: simple-proxy.hs + + build-depends: base + , http-proxy diff --git a/test/test-io.hs b/test/test-io.hs --- a/test/test-io.hs +++ b/test/test-io.hs @@ -173,14 +173,14 @@ proxySettingsAddHeader :: Settings proxySettingsAddHeader = defaultProxySettings - { proxyRequestModifier = \ req -> return . Right $ req + { proxyHttpRequestModifier = \ req -> return . Right $ req { requestHeaders = (CI.mk "X-Test-Header", "Blah") : requestHeaders req } } proxySettingsHttpsUpgrade :: Settings proxySettingsHttpsUpgrade = defaultProxySettings - { proxyRequestModifier = \ req -> return . Right $ req { requestPath = httpsUpgrade $ requestPath req } + { proxyHttpRequestModifier = \ req -> return . Right $ req { requestPath = httpsUpgrade $ requestPath req } } where httpsUpgrade bs = @@ -191,7 +191,7 @@ proxySettingsProxyResponse :: Settings proxySettingsProxyResponse = defaultProxySettings - { proxyRequestModifier = const . return $ Left proxyResponse + { proxyHttpRequestModifier = const . return $ Left proxyResponse } where proxyResponse :: Wai.Response