http-client 0.5.6.1 → 0.5.7.0
raw patch · 5 files changed
+393/−64 lines, 5 filesdep +Win32dep +safePVP ok
version bump matches the API change (PVP)
Dependencies added: Win32, safe
API changes (from Hackage documentation)
+ Network.HTTP.Client: InvalidProxySettings :: Text -> HttpExceptionContent
+ Network.HTTP.Client.Internal: InvalidProxySettings :: Text -> HttpExceptionContent
Files
- ChangeLog.md +5/−0
- Network/HTTP/Client/Manager.hs +5/−63
- Network/HTTP/Client/Types.hs +3/−0
- Network/HTTP/Proxy.hs +374/−0
- http-client.cabal +6/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.5.7.0++* Support for Windows system proxy settings+ [#274](https://github.com/snoyberg/http-client/pull/274)+ ## 0.5.6.1 * Revert socks5 and socks5h support from
Network/HTTP/Client/Manager.hs view
@@ -53,6 +53,7 @@ import Network.HTTP.Client.Connection import Network.HTTP.Client.Headers (parseStatusHeaders) import Network.HTTP.Client.Request (applyBasicProxyAuth, extractBasicAuthInfo)+import Network.HTTP.Proxy import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar) import System.Environment (getEnvironment) import qualified Network.URI as U@@ -465,12 +466,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"+ systemProxyHelper Nothing (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp -- | Same as 'proxyEnvironment', but instead of default environment variable -- names, allows you to set your own name.@@ -480,66 +476,12 @@ :: Text -- ^ environment variable name -> Maybe Proxy -- ^ fallback if no environment set -> ProxyOverride-proxyEnvironmentNamed name =- ProxyOverride . const . envHelper name- . maybe EHNoProxy EHUseProxy+proxyEnvironmentNamed name mp = ProxyOverride $ \secure' ->+ systemProxyHelper (Just name) (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp -- | 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- let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env- lookupEnvVar n = lookup (T.unpack n) env <|> Map.lookup n lenv- noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy")- case lookupEnvVar name of- Nothing -> return noEnvProxy- Just "" -> return noEnvProxy- Just str -> do- let invalid = throwHttp $ InvalidProxyEnvironmentVariable name (T.pack str)- (p, muserpass) <- maybe invalid return $ do- let allowedScheme x = x == "http:"- uri <- case U.parseURI str of- Just u | allowedScheme (U.uriScheme u) -> return u- _ -> U.parseURI $ "http://" ++ str-- guard $ allowedScheme $ U.uriScheme uri- guard $ null (U.uriPath uri) || U.uriPath uri == "/"- guard $ null $ U.uriQuery uri- guard $ null $ U.uriFragment uri-- auth <- U.uriAuthority uri- 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', extractBasicAuthInfo uri)- return $ \req ->- if host req `hasDomainSuffixIn` noProxyDomains- then noEnvProxy req- else maybe id (uncurry applyBasicProxyAuth) muserpass- req { proxy = Just p }- where noEnvProxy = case eh of- EHFromRequest -> id- EHNoProxy -> \req -> req { proxy = Nothing }- EHUseProxy p -> \req -> req { proxy = Just p }- prefixed s | S8.head s == '.' = s- | otherwise = S8.cons '.' s- domainSuffixes Nothing = []- domainSuffixes (Just "") = []- domainSuffixes (Just no_proxy) = [prefixed $ S8.dropWhile (== ' ') suffix | suffix <- S8.split ',' (S8.pack (map toLower no_proxy)), not (S8.null suffix)]- hasDomainSuffixIn host' = any (`S8.isSuffixOf` prefixed (S8.map toLower host'))+ systemProxyHelper Nothing (httpProtocol secure') EHFromRequest
Network/HTTP/Client/Types.hs view
@@ -232,6 +232,9 @@ -- ^ Attempted to use a 'Connection' which was already closed -- -- @since 0.5.0+ | InvalidProxySettings Text+ -- ^ Proxy settings are not valid (Windows specific currently)+ -- @since 0.5.7 deriving (Show, T.Typeable) -- Purposely not providing this instance, since we don't want users to
+ Network/HTTP/Proxy.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++{-+Copyright (c) 2002, Warrick Gray+Copyright (c) 2002-2005, Ian Lynagh+Copyright (c) 2003-2006, Bjorn Bringert+Copyright (c) 2004, Andre Furtado+Copyright (c) 2004-2005, Dominic Steinitz+Copyright (c) 2007, Robin Bate Boerop+Copyright (c) 2008-2010, Sigbjorn Finne+Copyright (c) 2009, Eric Kow+Copyright (c) 2010, Antoine Latter+Copyright (c) 2004, 2010-2011, Ganesh Sittampalam+Copyright (c) 2011, Duncan Coutts+Copyright (c) 2011, Matthew Gruen+Copyright (c) 2011, Jeremy Yallop+Copyright (c) 2011, Eric Hesselink+Copyright (c) 2011, Yi Huang+Copyright (c) 2011, Tom Lokhorst+Copyright (c) 2017, Vassil Keremidchiev++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of contributors may not be used to endorse or promote+ products derived from this software without specific prior+ written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}++module Network.HTTP.Proxy( ProxyProtocol(..), EnvHelper(..),+ systemProxyHelper, envHelper,+ httpProtocol,+ ProxySettings ) where++import Control.Applicative ((<$>), (<|>))+import Control.Arrow (first)+import Control.Monad (guard)+import qualified Data.ByteString.Char8 as S8+import Data.Char (toLower)+import qualified Data.Map as Map+import qualified Data.Text as T+import Data.Text.Read (decimal)+import Network.HTTP.Client.Request (applyBasicProxyAuth,+ extractBasicAuthInfo)+import Network.HTTP.Client.Types (HttpExceptionContent (..),+ Proxy (..), Request (..),+ throwHttp)+import qualified Network.URI as U+import System.Environment (getEnvironment)++#if defined(mingw32_HOST_OS)+import Control.Exception (IOException, bracket, catch, try)+import Control.Monad (join, liftM, mplus, when)+import Data.List (isInfixOf, isPrefixOf)+import Foreign (Storable (peek, sizeOf), alloca,+ castPtr, toBool)+import Network.URI (parseAbsoluteURI)+import Safe (readDef)+import System.IO+import System.Win32.Registry (hKEY_CURRENT_USER, rEG_DWORD,+ regCloseKey, regOpenKey,+ regQueryValue, regQueryValueEx)+import System.Win32.Types (DWORD, HKEY)+#endif++type EnvName = T.Text+type HostAddress = S8.ByteString+type UserName = S8.ByteString+type Password = S8.ByteString++-- There are other proxy protocols like SOCKS, FTP, etc.+data ProxyProtocol = HTTPProxy | HTTPSProxy++instance Show ProxyProtocol where+ show HTTPProxy = "http"+ show HTTPSProxy = "https"++data ProxySettings = ProxySettings { proxyHost :: Proxy,+ proxyAuth :: Maybe (UserName, Password) }+ deriving Show++httpProtocol :: Bool -> ProxyProtocol+httpProtocol True = HTTPSProxy+httpProtocol False = HTTPProxy++data EnvHelper = EHFromRequest+ | EHNoProxy+ | EHUseProxy Proxy++headJust :: [Maybe a] -> Maybe a+headJust [] = Nothing+headJust (Nothing:xs) = headJust xs+headJust ((y@(Just x)):_) = y++systemProxyHelper :: Maybe T.Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)+systemProxyHelper envOveride prot eh = do+ let envName' Nothing = envName prot+ envName' (Just name) = name++ modifier <- envHelper (envName' envOveride)++-- Under Windows try first env. variables override then Windows proxy settings+#if defined(mingw32_HOST_OS)+ modifier' <- systemProxy prot+ let modifiers = [modifier, modifier']+#else+ let modifiers = [modifier]+#endif++ let chooseMod :: Request -> Maybe ProxySettings+ chooseMod req = headJust . map (\m -> m . host $ req) $ modifiers++ noEnvProxy = case eh of+ EHFromRequest -> id+ EHNoProxy -> \req -> req { proxy = Nothing }+ EHUseProxy p -> \req -> req { proxy = Just p }++ let result req = toRequest . chooseMod $ req where+ toRequest Nothing = noEnvProxy req+ toRequest (Just (ProxySettings p muserpass)) = maybe id (uncurry applyBasicProxyAuth) muserpass+ req { proxy = Just p }+ return result+++#if defined(mingw32_HOST_OS)+windowsProxyString :: ProxyProtocol -> IO (Maybe (String, String))+windowsProxyString proto = do+ mProxy <- registryProxyString+ return $ do+ (proxies, exceptions) <- mProxy+ protoProxy <- parseWindowsProxy proto proxies+ return (protoProxy, exceptions)++registryProxyLoc :: (HKEY,String)+registryProxyLoc = (hive, path)+ where+ -- some sources say proxy settings should be at+ -- HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows+ -- \CurrentVersion\Internet Settings\ProxyServer+ -- but if the user sets them with IE connection panel they seem to+ -- end up in the following place:+ hive = hKEY_CURRENT_USER+ path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"++-- read proxy settings from the windows registry; this is just a best+-- effort and may not work on all setups.+registryProxyString :: IO (Maybe (String, String))+registryProxyString = catch+ (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do+ enable <- toBool . maybe 0 id <$> regQueryValueDWORD hkey "ProxyEnable"+ if enable+ then do+ server <- regQueryValue hkey (Just "ProxyServer")+ exceptions <- try $ regQueryValue hkey (Just "ProxyOverride") :: IO (Either IOException String)+ return $ Just (server, either (const "") id exceptions)+ else return Nothing)+ hideError where+ hideError :: IOException -> IO (Maybe (String, String))+ hideError _ = return Nothing++-- the proxy string is in the format "http=x.x.x.x:yyyy;https=...;ftp=...;socks=..."+-- even though the following article indicates otherwise+-- https://support.microsoft.com/en-us/kb/819961+--+-- to be sure, parse strings where each entry in the ';'-separated list above is+-- either in the format "protocol=..." or "protocol://..."+parseWindowsProxy :: ProxyProtocol -> String -> Maybe String+parseWindowsProxy proto s =+ case proxies of+ x:_ -> Just x+ _ -> Nothing+ where+ parts = split ';' s+ pr x = case break (== '=') x of+ (p, []) -> p -- might be in format http://+ (p, u) -> p ++ "://" ++ drop 1 u++ protoPrefix = (show proto) ++ "://"+ proxies = filter (isPrefixOf protoPrefix) . map pr $ parts++ split :: Eq a => a -> [a] -> [[a]]+ split _ [] = []+ split a xs = case break (a ==) xs of+ (ys, []) -> [ys]+ (ys, _:zs) -> ys:split a zs++-- Extract proxy settings from Windows registry. This is a standard way in Windows OS.+systemProxy :: ProxyProtocol -> IO (HostAddress -> Maybe ProxySettings)+systemProxy proto = do+ let isURLlocal "127.0.0.1" = True+ isURLlocal "localhost" = True+ isURLlocal _ = False++ hasLocal exceptions = "<local>" `isInfixOf` exceptions++ settings <- fetchProxy proto+ return $ \url -> do+ (proxy, exceptions) <- settings++ -- Skip proxy for local hosts if it's enabled in IE settings+ -- TODO Implement skipping for address patterns, like (*.google.com)+ if (isURLlocal url && hasLocal exceptions) || (url `S8.isInfixOf` (S8.pack exceptions)) then Nothing+ else Just proxy++-- | @fetchProxy flg@ gets the local proxy settings and parse the string+-- into a @Proxy@ value.+-- Proxy settings are sourced from IE/WinInet's proxy+-- setting in the Registry.+fetchProxy :: ProxyProtocol -> IO (Maybe (ProxySettings, String))+fetchProxy proto = do+ mstr <- windowsProxyString proto+ case mstr of+ Nothing -> return Nothing+ Just (proxy, except) -> case parseProxy proto proxy of+ Just p -> return $ Just (p, except)+ Nothing ->+ throwHttp . InvalidProxySettings . T.pack . unlines $+ [ "Invalid http proxy uri: " ++ show proxy+ , "proxy uri must be http with a hostname"+ , "ignoring http proxy, trying a direct connection"+ ]++-- | @parseProxy str@ translates a proxy server string into a @ProxySettings@ value;+-- returns @Nothing@ if not well-formed.+parseProxy :: ProxyProtocol -> String -> Maybe ProxySettings+parseProxy proto str = join+ . fmap (uri2proxy proto)+ $ parseHttpURI str+ `mplus` parseHttpURI (protoPrefix ++ str)+ where+ protoPrefix = (show proto) ++ "://"+ parseHttpURI str' =+ case parseAbsoluteURI str' of+ Just uri@U.URI{U.uriAuthority = Just{}} -> Just (fixUserInfo uri)+ _ -> Nothing++ -- Note: we need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@+ -- which lack the @\"http://\"@ URI scheme. The problem is that+ -- @\"wwwcache.example.com:80\"@ is in fact a valid URI but with scheme+ -- @\"wwwcache.example.com:\"@, no authority part and a path of @\"80\"@.+ --+ -- So our strategy is to try parsing as normal uri first and if it lacks the+ -- 'uriAuthority' then we try parsing again with a @\"http://\"@ prefix.+ --++-- | @dropWhileTail p ls@ chops off trailing elements from @ls@+-- until @p@ returns @False@.+dropWhileTail :: (a -> Bool) -> [a] -> [a]+dropWhileTail f ls =+ case foldr chop Nothing ls of { Just xs -> xs; Nothing -> [] }+ where+ chop x (Just xs) = Just (x:xs)+ chop x _+ | f x = Nothing+ | otherwise = Just [x]++-- | @chopAtDelim elt ls@ breaks up @ls@ into two at first occurrence+-- of @elt@; @elt@ is elided too. If @elt@ does not occur, the second+-- list is empty and the first is equal to @ls@.+chopAtDelim :: Eq a => a -> [a] -> ([a],[a])+chopAtDelim elt xs =+ case break (==elt) xs of+ (_,[]) -> (xs,[])+ (as,_:bs) -> (as,bs)++-- | tidy up user portion, don't want the trailing "\@".+fixUserInfo :: U.URI -> U.URI+fixUserInfo uri = uri{ U.uriAuthority = f `fmap` U.uriAuthority uri }+ where+ f a@U.URIAuth{U.uriUserInfo=s} = a{U.uriUserInfo=dropWhileTail (=='@') s}++defaultHTTPport :: ProxyProtocol -> Int+defaultHTTPport HTTPProxy = 80+defaultHTTPport HTTPSProxy = 443++uri2proxy :: ProxyProtocol -> U.URI -> Maybe ProxySettings+uri2proxy proto uri@U.URI{ U.uriAuthority = Just (U.URIAuth auth' hst prt) } =+ if (show proto ++ ":") == U.uriScheme uri then+ Just (ProxySettings (Proxy (S8.pack hst) (port prt)) auth) else Nothing+ where+ port (':':xs) = readDef (defaultHTTPport proto) xs+ port _ = (defaultHTTPport proto)++ auth =+ case auth' of+ [] -> Nothing+ as -> Just ((S8.pack . U.unEscapeString $ usr), (S8.pack . U.unEscapeString $ pwd))+ where+ (usr,pwd) = chopAtDelim ':' as++uri2proxy _ _ = Nothing++regQueryValueDWORD :: HKEY -> String -> IO (Maybe DWORD)+regQueryValueDWORD hkey name = alloca $ \ptr -> do+ key <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))+ if key == rEG_DWORD then+ Just <$> peek ptr+ else return Nothing++-- defined(mingw32_HOST_OS)+#endif++envName :: ProxyProtocol -> EnvName+envName proto = T.pack $ show proto ++ "_proxy"++-- Extract proxy settings from environment variables. This is a standard way in Linux.+envHelper :: EnvName -> IO (HostAddress -> Maybe ProxySettings)+envHelper name = do+ env <- getEnvironment+ let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env+ lookupEnvVar n = lookup (T.unpack n) env <|> Map.lookup n lenv+ noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy")++ case lookupEnvVar name of+ Nothing -> return . const $ Nothing+ Just "" -> return . const $ Nothing+ Just str -> do+ let invalid = throwHttp $ InvalidProxyEnvironmentVariable name (T.pack str)+ (p, muserpass) <- maybe invalid return $ do+ let allowedScheme x = x == "http:"+ uri <- case U.parseURI str of+ Just u | allowedScheme (U.uriScheme u) -> return u+ _ -> U.parseURI $ "http://" ++ str++ guard $ allowedScheme $ U.uriScheme uri+ guard $ null (U.uriPath uri) || U.uriPath uri == "/"+ guard $ null $ U.uriQuery uri+ guard $ null $ U.uriFragment uri++ auth <- U.uriAuthority uri+ 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', extractBasicAuthInfo uri)+ return $ \hostRequest ->+ if hostRequest `hasDomainSuffixIn` noProxyDomains+ then Nothing+ else Just $ ProxySettings p muserpass+ where prefixed s | S8.head s == '.' = s+ | otherwise = S8.cons '.' s+ domainSuffixes Nothing = []+ domainSuffixes (Just "") = []+ domainSuffixes (Just no_proxy) = [prefixed $ S8.dropWhile (== ' ') suffix | suffix <- S8.split ',' (S8.pack (map toLower no_proxy)), not (S8.null suffix)]+ hasDomainSuffixIn host' = any (`S8.isSuffixOf` prefixed (S8.map toLower host'))
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.5.6.1+version: 0.5.7.0 synopsis: An HTTP client engine description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client@@ -31,6 +31,7 @@ Network.HTTP.Client.Response Network.HTTP.Client.Types Network.HTTP.Client.Util+ Network.HTTP.Proxy Network.PublicSuffixList.Lookup Network.PublicSuffixList.Types Network.PublicSuffixList.Serialize@@ -59,6 +60,10 @@ build-depends: network >= 2.6, network-uri >= 2.6 else build-depends: network < 2.6++ if os(mingw32)+ build-depends: Win32, safe+ default-language: Haskell2010 test-suite spec