Hello community, here is the log from the commit of package ghc-http-client for openSUSE:Factory checked in at 2015-07-08 06:59:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-client (Old) and /work/SRC/openSUSE:Factory/.ghc-http-client.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-client" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-client/ghc-http-client.changes 2015-06-23 11:59:28.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-client.new/ghc-http-client.changes 2015-07-08 06:59:49.000000000 +0200 @@ -1,0 +2,8 @@ +Mon Jul 6 12:25:51 UTC 2015 - [email protected] + +- update to 0.4.15 +* Support proxy authentication in environment variables +* Ignore empty http_proxy +* Support for auth via url + +------------------------------------------------------------------- Old: ---- http-client-0.4.12.tar.gz New: ---- http-client-0.4.15.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-client.spec ++++++ --- /var/tmp/diff_new_pack.LGOsfx/_old 2015-07-08 06:59:50.000000000 +0200 +++ /var/tmp/diff_new_pack.LGOsfx/_new 2015-07-08 06:59:50.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-http-client -Version: 0.4.12 +Version: 0.4.15 Release: 0 Summary: HTTP client engine, intended as a base layer License: MIT ++++++ http-client-0.4.12.tar.gz -> http-client-0.4.15.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.12/ChangeLog.md new/http-client-0.4.15/ChangeLog.md --- old/http-client-0.4.12/ChangeLog.md 2015-06-17 21:28:00.000000000 +0200 +++ new/http-client-0.4.15/ChangeLog.md 2015-07-02 17:35:06.000000000 +0200 @@ -1,3 +1,15 @@ +## 0.4.15 + +* Support proxy authentication in environment variables [#129](https://github.com/snoyberg/http-client/issues/129) + +## 0.4.14 + +* Ignore empty `http_proxy` [#128](https://github.com/snoyberg/http-client/pull/128) + +## 0.4.13 + +* Support for auth via url [#124](https://github.com/snoyberg/http-client/pull/124) + ## 0.4.12 * Added `IsString RequestBody` instance [#126](https://github.com/snoyberg/http-client/pull/126) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.12/Network/HTTP/Client/Manager.hs new/http-client-0.4.15/Network/HTTP/Client/Manager.hs --- old/http-client-0.4.12/Network/HTTP/Client/Manager.hs 2015-06-17 21:28:00.000000000 +0200 +++ new/http-client-0.4.15/Network/HTTP/Client/Manager.hs 2015-07-02 17:35:06.000000000 +0200 @@ -54,6 +54,7 @@ import Network.HTTP.Client.Types import Network.HTTP.Client.Connection import Network.HTTP.Client.Headers (parseStatusHeaders) +import Network.HTTP.Client.Request (username, password, applyBasicProxyAuth) import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar) import System.Environment (getEnvironment) import qualified Network.URI as U @@ -486,14 +487,11 @@ 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 } + Nothing -> return noEnvProxy + Just "" -> return noEnvProxy Just str -> do let invalid = throwIO $ InvalidProxyEnvironmentVariable name (T.pack str) - p <- maybe invalid return $ do + (p, muserpass) <- maybe invalid return $ do uri <- case U.parseURI str of Just u | U.uriScheme u == "http:" -> return u _ -> U.parseURI $ "http://"; ++ str @@ -504,7 +502,13 @@ guard $ null $ U.uriFragment uri auth <- U.uriAuthority uri - guard $ null $ U.uriUserInfo auth + let muserpass = + if null authInfo + then Nothing + else Just ( S8.pack $ username authInfo + , S8.pack $ password authInfo + ) + authInfo = U.uriUserInfo auth port <- case U.uriPort auth of @@ -515,5 +519,11 @@ _ -> Nothing _ -> Nothing - Just $ Proxy (S8.pack $ U.uriRegName auth) port - return $ \req -> req { proxy = Just p } + Just $ (Proxy (S8.pack $ U.uriRegName auth) port, muserpass) + return $ \req -> + 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 } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.12/Network/HTTP/Client/Request.hs new/http-client-0.4.15/Network/HTTP/Client/Request.hs --- old/http-client-0.4.12/Network/HTTP/Client/Request.hs 2015-06-17 21:28:00.000000000 +0200 +++ new/http-client-0.4.15/Network/HTTP/Client/Request.hs 2015-07-02 17:35:06.000000000 +0200 @@ -23,6 +23,8 @@ , setQueryString , streamFile , observedStreamFile + , username + , password ) where import Data.Int (Int64) @@ -45,7 +47,7 @@ import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Network.HTTP.Types as W -import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI) +import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI, isReserved) import Control.Monad.IO.Class (liftIO) import Control.Exception (Exception, toException, throw, throwIO, IOException) @@ -114,16 +116,37 @@ , uriFragment = "" } +applyAnyUriBasedAuth :: URI -> Request -> Request +applyAnyUriBasedAuth uri req = + if hasAuth + then applyBasicAuth (S8.pack theuser) (S8.pack thepass) req + else req + where + hasAuth = (notEmpty theuser) && (notEmpty thepass) + notEmpty = not . null + theuser = username authInfo + thepass = password authInfo + authInfo = maybe "" uriUserInfo $ uriAuthority uri + +username :: String -> String +username = encode . takeWhile (/=':') . authPrefix + +password :: String -> String +password = encode . takeWhile (/='@') . drop 1 . dropWhile (/=':') + +encode :: String -> String +encode = escapeURIString (not . isReserved) + +authPrefix :: String -> String +authPrefix u = if '@' `elem` u then takeWhile (/= '@') u else "" + -- | Validate a 'URI', then add it to the request. setUri :: MonadThrow m => Request -> URI -> m Request setUri req uri = do sec <- parseScheme uri auth <- maybe (failUri "URL must be absolute") return $ uriAuthority uri - if not . null $ uriUserInfo auth - then failUri "URL auth not supported; use applyBasicAuth instead" - else return () port' <- parsePort sec auth - return req + return $ applyAnyUriBasedAuth uri req { host = S8.pack $ uriRegName auth , port = port' , secure = sec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.12/http-client.cabal new/http-client-0.4.15/http-client.cabal --- old/http-client-0.4.12/http-client.cabal 2015-06-17 21:28:00.000000000 +0200 +++ new/http-client-0.4.15/http-client.cabal 2015-07-02 17:35:06.000000000 +0200 @@ -1,5 +1,5 @@ name: http-client -version: 0.4.12 +version: 0.4.15 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: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client @@ -109,6 +109,7 @@ , blaze-builder , time , network + , network-uri , containers , transformers , deepseq diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.12/test-nonet/Network/HTTP/Client/RequestSpec.hs new/http-client-0.4.15/test-nonet/Network/HTTP/Client/RequestSpec.hs --- old/http-client-0.4.12/test-nonet/Network/HTTP/Client/RequestSpec.hs 2015-06-17 21:28:00.000000000 +0200 +++ new/http-client-0.4.15/test-nonet/Network/HTTP/Client/RequestSpec.hs 2015-07-02 17:35:06.000000000 +0200 @@ -5,9 +5,10 @@ import Control.Applicative ((<$>)) import Control.Monad (join, forM_) import Data.IORef -import Data.Maybe (isJust, fromMaybe) +import Data.Maybe (isJust, fromMaybe, fromJust) import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth) import Network.HTTP.Client.Internal +import Network.URI (URI(..), URIAuth(..)) --(parseURI, relativeTo, escapeURIString, isAllowedInURI) import Test.Hspec spec :: Spec @@ -22,6 +23,20 @@ Nothing -> return () :: IO () Just req -> error $ show req + describe "authentication in url" $ do + it "passes validation" $ do + case parseUrl "http://agent:[email protected]"; of + Nothing -> error "failed" + Just _ -> return () :: IO () + + it "add username/password to headers section" $ do + let request = parseUrl "http://user:[email protected]"; + field = join $ lookup "Authorization" . requestHeaders <$> request + requestHostnameWithoutAuth = "example.com" + (uriRegName $ fromJust $ uriAuthority $ getUri $ fromJust request) `shouldBe` requestHostnameWithoutAuth + field `shouldSatisfy` isJust + field `shouldBe` Just "Basic dXNlcjpwYXNz" + describe "applyBasicProxyAuth" $ do let request = applyBasicProxyAuth "user" "pass" <$> parseUrl "http://example.org"; field = join $ lookup "Proxy-Authorization" . requestHeaders <$> request @@ -30,6 +45,26 @@ it "Should add a proxy-authorization header with the specified username and password." $ do field `shouldBe` Just "Basic dXNlcjpwYXNz" + describe "extract credentials from a URI" $ do + it "fetches non-empty username before the first ':'" $ do + username "agent:[email protected]" `shouldBe` "agent" + + it "extra colons do not delimit username" $ do + username "agent:006:[email protected]" `shouldBe` "agent" + + it "after ':' is considered password" $ do + password "agent007:[email protected]" `shouldBe` "shakenNotStirred" + + it "encodes username special characters per RFC3986" $ do + username "/?#[]!$&'()*+,;=:[email protected]" `shouldBe` "%2F%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D" + + it "encodes password special characters per RFC3986" $ do + password "therealusername:?#[]!$&'()*+,;=/@example.com" `shouldBe` "%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D%2F" + + it "no auth is empty" $ do + username "example.com" `shouldBe` "" + password "example.com" `shouldBe` "" + describe "requestBuilder" $ do it "sends the full request, combining headers and body in the non-streaming case" $ do let Just req = parseUrl "http://localhost"; @@ -83,3 +118,4 @@ case xs of (x:xs') -> (xs', x) [] -> ([], "") +
