Hello community, here is the log from the commit of package ghc-http-client for openSUSE:Factory checked in at 2016-04-22 16:25:02 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 2016-01-28 17:24:43.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-http-client.new/ghc-http-client.changes 2016-04-22 16:25:22.000000000 +0200 @@ -1,0 +2,14 @@ +Sat Apr 16 07:00:55 UTC 2016 - mimi.vx@gmail.com + +- update to 0.4.28 +* Add support for including request method in URL +* requestManagerOverride +* RequestBodyIO + +------------------------------------------------------------------- +Tue Apr 12 09:50:06 UTC 2016 - mimi.vx@gmail.com + +- update to 0.4.27.1 +* Incorrect idle connection count in HTTP manager + +------------------------------------------------------------------- Old: ---- http-client-0.4.27.tar.gz New: ---- http-client-0.4.28.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-client.spec ++++++ --- /var/tmp/diff_new_pack.UcPg8e/_old 2016-04-22 16:25:23.000000000 +0200 +++ /var/tmp/diff_new_pack.UcPg8e/_new 2016-04-22 16:25:23.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-http-client -Version: 0.4.27 +Version: 0.4.28 Release: 0 Summary: HTTP client engine, intended as a base layer License: MIT ++++++ http-client-0.4.27.tar.gz -> http-client-0.4.28.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/ChangeLog.md new/http-client-0.4.28/ChangeLog.md --- old/http-client-0.4.27/ChangeLog.md 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/ChangeLog.md 2016-04-15 10:51:33.000000000 +0200 @@ -1,3 +1,13 @@ +## 0.4.28 + +* Add support for including request method in URL +* `requestManagerOverride` +* `RequestBodyIO` + +## 0.4.27.1 + +* Incorrect idle connection count in HTTP manager [#185](https://github.com/snoyberg/http-client/issues/185) + ## 0.4.27 * Enable managerModifyRequest to modify checkStatus [#179](https://github.com/snoyberg/http-client/pull/179) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/Network/HTTP/Client/Core.hs new/http-client-0.4.28/Network/HTTP/Client/Core.hs --- old/http-client-0.4.27/Network/HTTP/Client/Core.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/Network/HTTP/Client/Core.hs 2016-04-15 10:51:33.000000000 +0200 @@ -163,13 +163,15 @@ -- -- Since 0.1.0 responseOpen :: Request -> Manager -> IO (Response BodyReader) -responseOpen req0 manager = handle addTlsHostPort $ mWrapIOException manager $ do +responseOpen req0 manager' = handle addTlsHostPort $ mWrapIOException manager $ do (req, res) <- if redirectCount req0 == 0 then httpRaw' req0 manager else go (redirectCount req0) req0 maybe (return res) throwIO =<< applyCheckStatus req (checkStatus req) res where + manager = fromMaybe manager' (requestManagerOverride req0) + addTlsHostPort (TlsException e) = throwIO $ TlsExceptionHostPort e (host req0) (port req0) addTlsHostPort e = throwIO e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/Network/HTTP/Client/Manager.hs new/http-client-0.4.28/Network/HTTP/Client/Manager.hs --- old/http-client-0.4.27/Network/HTTP/Client/Manager.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/Network/HTTP/Client/Manager.hs 2016-04-15 10:51:33.000000000 +0200 @@ -61,7 +61,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 Network.HTTP.Client.Request (applyBasicProxyAuth, extractBasicAuthInfo) import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar) import System.Environment (getEnvironment) import qualified Network.URI as U @@ -153,7 +153,7 @@ in m' `seq` (m', return ()) Just l -> let (l', mx) = addToList now (mMaxConns man) ci l - cnt' = idleCount + maybe 0 (const 1) mx + cnt' = idleCount + maybe 1 (const 0) mx m' = ManagerOpen cnt' (Map.insert key l' m) in m' `seq` (m', maybe (return ()) connectionClose mx) @@ -528,14 +528,6 @@ guard $ null $ U.uriFragment uri auth <- U.uriAuthority uri - 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 "" -> Just 80 @@ -545,7 +537,7 @@ _ -> Nothing _ -> Nothing - Just $ (Proxy (S8.pack $ U.uriRegName auth) port, muserpass) + Just $ (Proxy (S8.pack $ U.uriRegName auth) port, extractBasicAuthInfo uri) return $ \req -> if host req `hasDomainSuffixIn` noProxyDomains then noEnvProxy req diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/Network/HTTP/Client/Request.hs new/http-client-0.4.28/Network/HTTP/Client/Request.hs --- old/http-client-0.4.27/Network/HTTP/Client/Request.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/Network/HTTP/Client/Request.hs 2016-04-15 10:51:33.000000000 +0200 @@ -23,8 +23,7 @@ , setQueryString , streamFile , observedStreamFile - , username - , password + , extractBasicAuthInfo ) where import Data.Int (Int64) @@ -33,7 +32,7 @@ import Data.String (IsString(..)) import Data.Char (toLower) import Control.Applicative ((<$>)) -import Control.Monad (when, unless) +import Control.Monad (when, unless, guard) import Numeric (showHex) import Data.Default.Class (Default (def)) @@ -47,7 +46,7 @@ import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Network.HTTP.Types as W -import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI, isReserved) +import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, unEscapeString, isAllowedInURI, isReserved) import Control.Monad.IO.Class (liftIO) import Control.Exception (Exception, toException, throw, throwIO, IOException) @@ -65,6 +64,7 @@ import Data.IORef import System.IO (withBinaryFile, hTell, hFileSize, Handle, IOMode (ReadMode)) +import Control.Monad (liftM) -- | Convert a URL into a 'Request'. -- @@ -74,14 +74,32 @@ -- Since this function uses 'MonadThrow', the return monad can be anything that is -- an instance of 'MonadThrow', such as 'IO' or 'Maybe'. -- +-- You can place the request method at the beginning of the URL separated by a +-- space, e.g.: +-- +-- @@@ +-- parseUrl "POST http://httpbin.org/post" +-- @@@ +-- +-- Note that the request method must be provided as all capital letters. +-- -- Since 0.1.0 parseUrl :: MonadThrow m => String -> m Request -parseUrl s = +parseUrl s' = case parseURI (encode s) of - Just uri -> setUri def uri + Just uri -> liftM setMethod (setUri def uri) Nothing -> throwM $ InvalidUrlException s "Invalid URL" where encode = escapeURIString isAllowedInURI + (mmethod, s) = + case break (== ' ') s' of + (x, ' ':y) | all (\c -> 'A' <= c && c <= 'Z') x -> (Just x, y) + _ -> (Nothing, s') + + setMethod req = + case mmethod of + Nothing -> req + Just m -> req { method = S8.pack m } -- | Add a 'URI' to the request. If it is absolute (includes a host name), add -- it as per 'setUri'; if it is relative, merge it with the existing request. @@ -121,27 +139,20 @@ applyAnyUriBasedAuth :: URI -> Request -> Request applyAnyUriBasedAuth uri req = - if hasAuth - then applyBasicAuth (S8.pack theuser) (S8.pack thepass) req - else req + case extractBasicAuthInfo uri of + Just auth -> uncurry applyBasicAuth auth req + Nothing -> req + +-- | Extract basic access authentication info in URI. +-- Return Nothing when there is no auth info in URI. +extractBasicAuthInfo :: URI -> Maybe (S8.ByteString, S8.ByteString) +extractBasicAuthInfo uri = do + userInfo <- uriUserInfo <$> uriAuthority uri + guard (':' `elem` userInfo) + let (username, ':':password) = break (==':') . takeWhile (/='@') $ userInfo + return (toLiteral username, toLiteral password) 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 "" + toLiteral = S8.pack . unEscapeString -- | Validate a 'URI', then add it to the request. setUri :: MonadThrow m => Request -> URI -> m Request @@ -248,6 +259,7 @@ case E.fromException se of Just (_ :: IOException) -> return () Nothing -> throwIO se + , requestManagerOverride = Nothing } instance IsString Request where @@ -326,50 +338,49 @@ && decompress req (fromMaybe "" $ lookup "content-type" hs') requestBuilder :: Request -> Connection -> IO (Maybe (IO ())) -requestBuilder req Connection {..} - | expectContinue = flushHeaders >> return (Just (checkBadSend sendLater)) - | otherwise = sendNow >> return Nothing +requestBuilder req Connection {..} = do + (contentLength, sendNow, sendLater) <- toTriple (requestBody req) + if expectContinue + then flushHeaders contentLength >> return (Just (checkBadSend sendLater)) + else sendNow >> return Nothing where expectContinue = Just "100-continue" == lookup "Expect" (requestHeaders req) checkBadSend f = f `E.catch` onRequestBodyException req writeBuilder = toByteStringIO connectionWrite - writeHeadersWith = writeBuilder . (builder `mappend`) - flushHeaders = writeHeadersWith flush + writeHeadersWith contentLength = writeBuilder . (builder contentLength `mappend`) + flushHeaders contentLength = writeHeadersWith contentLength flush - (contentLength, sendNow, sendLater) = - case requestBody req of - RequestBodyLBS lbs -> - let body = fromLazyByteString lbs - now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just (L.length lbs), now, later) - - RequestBodyBS bs -> - let body = fromByteString bs - now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just (fromIntegral $ S.length bs), now, later) - - RequestBodyBuilder len body -> - let now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just len, now, later) - - -- See https://github.com/snoyberg/http-client/issues/74 for usage - -- of flush here. - RequestBodyStream len stream -> - let body = writeStream False stream - -- Don't check for a bad send on the headers themselves. - -- Ideally, we'd do the same thing for the other request body - -- types, but it would also introduce a performance hit since - -- we couldn't merge request headers and bodies together. - now = flushHeaders >> checkBadSend body - in (Just len, now, body) - - RequestBodyStreamChunked stream -> - let body = writeStream True stream - now = flushHeaders >> checkBadSend body - in (Nothing, now, body) + toTriple (RequestBodyLBS lbs) = do + let body = fromLazyByteString lbs + len = Just $ L.length lbs + now = checkBadSend $ writeHeadersWith len body + later = writeBuilder body + return (len, now, later) + toTriple (RequestBodyBS bs) = do + let body = fromByteString bs + len = Just $ fromIntegral $ S.length bs + now = checkBadSend $ writeHeadersWith len body + later = writeBuilder body + return (len, now, later) + toTriple (RequestBodyBuilder len body) = do + let now = checkBadSend $ writeHeadersWith (Just len) body + later = writeBuilder body + return (Just len, now, later) + toTriple (RequestBodyStream len stream) = do + -- See https://github.com/snoyberg/http-client/issues/74 for usage + -- of flush here. + let body = writeStream False stream + -- Don't check for a bad send on the headers themselves. + -- Ideally, we'd do the same thing for the other request body + -- types, but it would also introduce a performance hit since + -- we couldn't merge request headers and bodies together. + now = flushHeaders (Just len) >> checkBadSend body + return (Just len, now, body) + toTriple (RequestBodyStreamChunked stream) = do + let body = writeStream True stream + now = flushHeaders Nothing >> checkBadSend body + return (Nothing, now, body) + toTriple (RequestBodyIO mbody) = mbody >>= toTriple writeStream isChunked withStream = withStream loop @@ -421,14 +432,15 @@ Nothing -> ("Host", hh) : x Just{} -> x - headerPairs :: W.RequestHeaders - headerPairs = hostHeader + headerPairs :: Maybe Int64 -> W.RequestHeaders + headerPairs contentLength + = hostHeader $ acceptEncodingHeader $ contentLengthHeader contentLength $ requestHeaders req - builder :: Builder - builder = + builder :: Maybe Int64 -> Builder + builder contentLength = fromByteString (method req) <> fromByteString " " <> requestHostname @@ -449,7 +461,7 @@ <> foldr (\a b -> headerPairToBuilder a <> b) (fromByteString "\r\n") - headerPairs + (headerPairs contentLength) headerPairToBuilder (k, v) = fromByteString (CI.original k) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/Network/HTTP/Client/Types.hs new/http-client-0.4.28/Network/HTTP/Client/Types.hs --- old/http-client-0.4.27/Network/HTTP/Client/Types.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/Network/HTTP/Client/Types.hs 2016-04-15 10:51:33.000000000 +0200 @@ -222,6 +222,11 @@ | RequestBodyBuilder Int64 Builder | RequestBodyStream Int64 (GivesPopper ()) | RequestBodyStreamChunked (GivesPopper ()) + | RequestBodyIO (IO RequestBody) + -- ^ Allows creation of a @RequestBody@ inside the @IO@ monad, which is + -- useful for making easier APIs (like @setRequestBodyFile@). + -- + -- @since 0.4.28 deriving T.Typeable -- | -- @@ -446,6 +451,13 @@ -- Default: ignore @IOException@s, rethrow all other exceptions. -- -- Since: 0.4.6 + + , requestManagerOverride :: Maybe Manager + -- ^ A 'Manager' value that should override whatever @Manager@ value was + -- passed in to the HTTP request function manually. This is useful when + -- dealing with implicit global managers, such as in @Network.HTTP.Simple@ + -- + -- @since 0.4.28 } deriving T.Typeable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/Network/HTTP/Client.hs new/http-client-0.4.28/Network/HTTP/Client.hs --- old/http-client-0.4.27/Network/HTTP/Client.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/Network/HTTP/Client.hs 2016-04-15 10:51:33.000000000 +0200 @@ -3,7 +3,20 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} --- | This is the main entry point for using http-client. Used by itself, this +-- | +-- +-- = Simpler API +-- +-- The API below is rather low-level. The @Network.HTTP.Simple@ module (from +-- the @http-conduit@ package) provides a higher-level API with built-in +-- support for things like JSON request and response bodies. For most users, +-- this will be an easier place to start. You can read the tutorial at: +-- +-- https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md +-- +-- = Lower-level API +-- +-- This is the main entry point for using http-client. Used by itself, this -- module provides low-level access for streaming request and response bodies, -- and only non-secure HTTP connections. Helper packages such as http-conduit -- provided higher level streaming approaches, while other helper packages like diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/README.md new/http-client-0.4.28/README.md --- old/http-client-0.4.27/README.md 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/README.md 2016-04-15 10:51:33.000000000 +0200 @@ -1,10 +1,17 @@ http-client =========== +Full tutorial docs are available at: +https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md + 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). +Note that, if you want to make HTTPS secure connections, you should use +[http-client-tls](https://www.stackage.org/package/http-client-tls) in addition +to this library. + 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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/http-client.cabal new/http-client-0.4.28/http-client.cabal --- old/http-client-0.4.27/http-client.cabal 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/http-client.cabal 2016-04-15 10:51:33.000000000 +0200 @@ -1,5 +1,5 @@ name: http-client -version: 0.4.27 +version: 0.4.28 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/test/Network/HTTP/ClientSpec.hs new/http-client-0.4.28/test/Network/HTTP/ClientSpec.hs --- old/http-client-0.4.27/test/Network/HTTP/ClientSpec.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/test/Network/HTTP/ClientSpec.hs 2016-04-15 10:51:33.000000000 +0200 @@ -4,7 +4,7 @@ import Control.Exception (toException) import Network (withSocketsDo) import Network.HTTP.Client -import Network.HTTP.Types (status200) +import Network.HTTP.Types (status200, status405) import Test.Hspec import Data.ByteString.Lazy.Char8 () -- orphan instance @@ -19,6 +19,22 @@ res <- httpLbs req man responseStatus res `shouldBe` status200 + describe "method in URL" $ do + it "success" $ withSocketsDo $ do + req <- parseUrl "POST http://httpbin.org/post" + man <- newManager defaultManagerSettings + res <- httpLbs req man + responseStatus res `shouldBe` status200 + + it "failure" $ withSocketsDo $ do + req' <- parseUrl "PUT http://httpbin.org/post" + let req = req' + { checkStatus = \_ _ _ -> Nothing + } + man <- newManager defaultManagerSettings + res <- httpLbs req man + responseStatus res `shouldBe` status405 + it "managerModifyRequest" $ do let modify req = return req { port = 80 } settings = defaultManagerSettings { managerModifyRequest = modify } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-client-0.4.27/test-nonet/Network/HTTP/Client/RequestSpec.hs new/http-client-0.4.28/test-nonet/Network/HTTP/Client/RequestSpec.hs --- old/http-client-0.4.27/test-nonet/Network/HTTP/Client/RequestSpec.hs 2016-01-21 08:59:31.000000000 +0100 +++ new/http-client-0.4.28/test-nonet/Network/HTTP/Client/RequestSpec.hs 2016-04-15 10:51:33.000000000 +0200 @@ -3,12 +3,13 @@ import Blaze.ByteString.Builder (fromByteString) import Control.Applicative ((<$>)) -import Control.Monad (join, forM_) +import Control.Monad (join, forM_, (<=<)) import Data.IORef import Data.Maybe (isJust, fromMaybe, fromJust) +import qualified Data.ByteString.Char8 as S8 import Network.HTTP.Client (parseUrl, requestHeaders, applyBasicProxyAuth) import Network.HTTP.Client.Internal -import Network.URI (URI(..), URIAuth(..)) --(parseURI, relativeTo, escapeURIString, isAllowedInURI) +import Network.URI (URI(..), URIAuth(..), parseURI) import Test.Hspec spec :: Spec @@ -46,24 +47,23 @@ field `shouldBe` Just "Basic dXNlcjpwYXNz" describe "extract credentials from a URI" $ do + let username = return . fst <=< extractBasicAuthInfo <=< parseURI + password = return . snd <=< extractBasicAuthInfo <=< parseURI it "fetches non-empty username before the first ':'" $ do - username "agent:secret@example.com" `shouldBe` "agent" - - it "extra colons do not delimit username" $ do - username "agent:006:supersecret@example.com" `shouldBe` "agent" + username "http://agent:secret@example.com" `shouldBe` Just "agent" it "after ':' is considered password" $ do - password "agent007:shakenNotStirred@example.com" `shouldBe` "shakenNotStirred" + password "http://agent007:shakenNotStirred@example.com" `shouldBe` Just "shakenNotStirred" - it "encodes username special characters per RFC3986" $ do - username "/?#[]!$&'()*+,;=:therealpassword@example.com" `shouldBe` "%2F%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D" + it "decodes username special characters per RFC3986" $ do + username "http://%2F%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D:therealpassword@exam..." `shouldBe` Just "/?#[]!$&'()*+,;=" - 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 "decodes password special characters per RFC3986" $ do + password "http://therealusername:%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D%2F@exam..." `shouldBe` Just "?#[]!$&'()*+,;=/" it "no auth is empty" $ do - username "example.com" `shouldBe` "" - password "example.com" `shouldBe` "" + username "http://example.com" `shouldBe` Nothing + password "http://example.com" `shouldBe` Nothing describe "requestBuilder" $ do it "sends the full request, combining headers and body in the non-streaming case" $ do