diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.4.7 + +* [Support http\_proxy and https\_proxy environment variables](https://github.com/snoyberg/http-client/issues/94) + ## 0.4.6.1 Separate tests not requiring internet access. [#93](https://github.com/snoyberg/http-client/pull/93) diff --git a/Network/HTTP/Client.hs b/Network/HTTP/Client.hs --- a/Network/HTTP/Client.hs +++ b/Network/HTTP/Client.hs @@ -104,6 +104,17 @@ , managerWrapIOException , managerIdleConnectionCount , managerModifyRequest + -- *** Manager proxy settings + , managerSetProxy + , managerSetInsecureProxy + , managerSetSecureProxy + , ProxyOverride + , proxyFromRequest + , noProxy + , useProxy + , proxyEnvironment + , proxyEnvironmentNamed + , defaultProxy -- *** Helpers , rawConnectionModifySocket -- * Request @@ -163,6 +174,7 @@ import Network.HTTP.Client.Response import Network.HTTP.Client.Types +import Data.Text (Text) import Data.IORef (newIORef, writeIORef, readIORef, modifyIORef) import qualified Data.ByteString.Lazy as L import Data.Foldable (Foldable) @@ -235,3 +247,22 @@ withResponseHistory req man = bracket (responseOpenHistory req man) (responseClose . hrFinalResponse) + +-- | Set the proxy override value, only for HTTP (insecure) connections. +-- +-- Since 0.4.7 +managerSetInsecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings +managerSetInsecureProxy po m = m { managerProxyInsecure = po } + +-- | Set the proxy override value, only for HTTPS (secure) connections. +-- +-- Since 0.4.7 +managerSetSecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings +managerSetSecureProxy po m = m { managerProxySecure = po } + +-- | Set the proxy override value, for both HTTP (insecure) and HTTPS +-- (insecure) connections. +-- +-- Since 0.4.7 +managerSetProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings +managerSetProxy po = managerSetInsecureProxy po . managerSetSecureProxy po diff --git a/Network/HTTP/Client/Core.hs b/Network/HTTP/Client/Core.hs --- a/Network/HTTP/Client/Core.hs +++ b/Network/HTTP/Client/Core.hs @@ -72,7 +72,7 @@ -> Manager -> IO (Response BodyReader) httpRaw req0 m = do - req' <- mModifyRequest m req0 + req' <- mModifyRequest m $ mSetProxy m req0 (req, cookie_jar') <- case cookieJar req' of Just cj -> do now <- getCurrentTime diff --git a/Network/HTTP/Client/Manager.hs b/Network/HTTP/Client/Manager.hs --- a/Network/HTTP/Client/Manager.hs +++ b/Network/HTTP/Client/Manager.hs @@ -13,6 +13,12 @@ , failedConnectionException , defaultManagerSettings , rawConnectionModifySocket + , proxyFromRequest + , noProxy + , useProxy + , proxyEnvironment + , proxyEnvironmentNamed + , defaultProxy ) where #if !MIN_VERSION_base(4,6,0) @@ -30,9 +36,10 @@ import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Read (decimal) import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad (unless, join, when, void) +import Control.Monad (unless, join, when, void, mplus) import Control.Exception (mask_, SomeException, bracket, catch, throwIO, fromException, mask, IOException, Exception (..), handle) import Control.Concurrent (forkIO, threadDelay) import Data.Time (UTCTime (..), Day (..), DiffTime, getCurrentTime, addUTCTime) @@ -48,6 +55,9 @@ import Network.HTTP.Client.Connection import Network.HTTP.Client.Headers (parseStatusHeaders) import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar) +import System.Environment (getEnvironment) +import qualified Network.URI as U +import Control.Monad (guard) -- | A value for the @managerRawConnection@ setting, but also allows you to -- modify the underlying @Socket@ to set additional settings. For a motivating @@ -68,7 +78,7 @@ -- | Default value for @ManagerSettings@. -- -- Note that this value does /not/ have support for SSL/TLS. If you need to --- make any https connections, please use the network-client-tls package, which +-- make any https connections, please use the http-client-tls package, which -- provides a @tlsManagerSettings@ value. -- -- Since 0.1.0 @@ -100,6 +110,8 @@ in handle $ throwIO . wrapper , managerIdleConnectionCount = 512 , managerModifyRequest = return + , managerProxyInsecure = defaultProxy + , managerProxySecure = defaultProxy } takeSocket :: Manager -> ConnKey -> IO (Maybe Connection) @@ -165,6 +177,10 @@ mapRef <- I.newIORef $! ManagerOpen 0 Map.empty baton <- newEmptyMVar wmapRef <- I.mkWeakIORef mapRef $ closeManager' mapRef + + httpProxy <- runProxyOverride (managerProxyInsecure ms) False + httpsProxy <- runProxyOverride (managerProxySecure ms) True + _ <- forkIO $ reap baton wmapRef let manager = Manager { mConns = mapRef @@ -178,6 +194,10 @@ , mWrapIOException = managerWrapIOException ms , mIdleConnectionCount = managerIdleConnectionCount ms , mModifyRequest = managerModifyRequest ms + , mSetProxy = \req -> + if secure req + then httpsProxy req + else httpProxy req } return manager @@ -403,3 +423,96 @@ unless (status == status200) $ throwIO $ ProxyConnectException ultHost ultPort $ Left $ S8.pack $ show sh in mTlsProxyConnection m connstr parse (S8.unpack ultHost) + +-- | Get the proxy settings from the @Request@ itself. +-- +-- Since 0.4.7 +proxyFromRequest :: ProxyOverride +proxyFromRequest = ProxyOverride $ const $ return id + +-- | Never connect using a proxy, regardless of the proxy value in the @Request@. +-- +-- Since 0.4.7 +noProxy :: ProxyOverride +noProxy = ProxyOverride $ const $ return $ \req -> req { proxy = Nothing } + +-- | Use the given proxy settings, regardless of the proxy value in the @Request@. +-- +-- Since 0.4.7 +useProxy :: Proxy -> ProxyOverride +useProxy p = ProxyOverride $ const $ return $ \req -> req { proxy = Just p } + +-- | Get the proxy settings from the default environment variable (@http_proxy@ +-- for insecure, @https_proxy@ for secure). If no variable is set, then fall +-- back to the given value. @Nothing@ is equivalent to 'noProxy', @Just@ is +-- equivalent to 'useProxy'. +-- +-- Since 0.4.7 +proxyEnvironment :: Maybe Proxy -- ^ fallback if no environment set + -> ProxyOverride +proxyEnvironment mp = ProxyOverride $ \secure -> + envHelper (envName secure) $ maybe EHNoProxy EHUseProxy mp + +envName :: Bool -- ^ secure? + -> Text +envName False = "http_proxy" +envName True = "https_proxy" + +-- | Same as 'proxyEnvironment', but instead of default environment variable +-- names, allows you to set your own name. +-- +-- Since 0.4.7 +proxyEnvironmentNamed + :: Text -- ^ environment variable name + -> Maybe Proxy -- ^ fallback if no environment set + -> ProxyOverride +proxyEnvironmentNamed name = + ProxyOverride . const . envHelper name + . maybe EHNoProxy EHUseProxy + +-- | The default proxy settings for a manager. In particular: if the @http_proxy@ (or @https_proxy@) environment variable is set, use it. Otherwise, use the values in the @Request@. +-- +-- Since 0.4.7 +defaultProxy :: ProxyOverride +defaultProxy = ProxyOverride $ \secure -> + envHelper (envName secure) EHFromRequest + +data EnvHelper = EHFromRequest + | EHNoProxy + | EHUseProxy Proxy + +envHelper :: Text -> EnvHelper -> IO (Request -> Request) +envHelper name eh = do + env <- getEnvironment + case lookup (T.unpack name) env of + Nothing -> return $ + case eh of + EHFromRequest -> id + EHNoProxy -> \req -> req { proxy = Nothing } + EHUseProxy p -> \req -> req { proxy = Just p } + Just str -> do + let invalid = throwIO $ InvalidProxyEnvironmentVariable name (T.pack str) + p <- maybe invalid return $ do + uri <- case U.parseURI str of + Just u | U.uriScheme u == "http:" -> return u + _ -> U.parseURI $ "http://" ++ str + + guard $ U.uriScheme uri == "http:" + guard $ null (U.uriPath uri) || U.uriPath uri == "/" + guard $ null $ U.uriQuery uri + guard $ null $ U.uriFragment uri + + auth <- U.uriAuthority uri + guard $ null $ U.uriUserInfo auth + + port <- + case U.uriPort auth of + "" -> Just 80 + ':':rest -> + case decimal $ T.pack rest of + Right (p, "") -> Just p + _ -> Nothing + _ -> Nothing + + Just $ Proxy (S8.pack $ U.uriRegName auth) port + return $ \req -> req { proxy = Just p } diff --git a/Network/HTTP/Client/Types.hs b/Network/HTTP/Client/Types.hs --- a/Network/HTTP/Client/Types.hs +++ b/Network/HTTP/Client/Types.hs @@ -27,6 +27,7 @@ , NonEmptyList (..) , ConnHost (..) , ConnKey (..) + , ProxyOverride (..) ) where import qualified Data.Typeable as T (Typeable) @@ -109,6 +110,10 @@ -- ^ -- -- Since 0.3 + | InvalidProxyEnvironmentVariable Text Text + -- ^ Environment name and value + -- + -- Since 0.4.7 deriving (Show, T.Typeable) instance Exception HttpException @@ -515,9 +520,29 @@ -- Default: no modification -- -- Since 0.4.4 + , managerProxyInsecure :: ProxyOverride + -- ^ How HTTP proxy server settings should be discovered. + -- + -- Default: respect the @proxy@ value on the @Request@ itself. + -- + -- Since 0.4.7 + , managerProxySecure :: ProxyOverride + -- ^ How HTTPS proxy server settings should be discovered. + -- + -- Default: respect the @proxy@ value on the @Request@ itself. + -- + -- Since 0.4.7 } deriving T.Typeable +-- | How the HTTP proxy server settings should be discovered. +-- +-- Since 0.4.7 +newtype ProxyOverride = ProxyOverride + { runProxyOverride :: Bool -> IO (Request -> Request) + } + deriving T.Typeable + -- | Keeps track of open connections for keep-alive. -- -- If possible, you should share a single 'Manager' between multiple threads and requests. @@ -543,6 +568,8 @@ , mWrapIOException :: forall a. IO a -> IO a , mIdleConnectionCount :: Int , mModifyRequest :: Request -> IO Request + , mSetProxy :: Request -> Request + -- ^ See 'managerProxy' } deriving T.Typeable diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,3 +4,29 @@ An HTTP client engine, intended as a base layer for more user-friendly packages. This codebase has been refactored from [http-conduit](http://www.stackage.org/package/http-conduit). + +Below is a series of cookbook recipes. A number of recipes exist elsewhere, +including `Network.HTTP.Client` and `Network.HTTP.Conduit`. The goal is to +expand this list over time. + +## Proxy environment variable + +Use the following approach to get proxy settings from the `http_proxy` and +`https_proxy` environment variables. + +```haskell +{-# LANGUAGE OverloadedStrings #-} +import Network.HTTP.Client + +main :: IO () +main = do + let settings = managerSetProxy + (proxyEnvironment Nothing) + defaultManagerSettings + withManager settings $ \man -> do + let req = "http://httpbin.org" + -- Note that the following settings will be completely ignored. + { proxy = Just $ Proxy "localhost" 1234 + } + httpLbs req man >>= print +``` diff --git a/http-client.cabal b/http-client.cabal --- a/http-client.cabal +++ b/http-client.cabal @@ -1,5 +1,5 @@ name: http-client -version: 0.4.6.2 +version: 0.4.7 synopsis: An HTTP client engine, intended as a base layer for more user-friendly packages. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . homepage: https://github.com/snoyberg/http-client