http-client 0.4.27 → 0.4.27.1

raw patch · 5 files changed

+37/−49 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/HTTP/Client/Manager.hs +3/−11
• Network/HTTP/Client/Request.hs +16/−24
• http-client.cabal +1/−1
• test-nonet/Network/HTTP/Client/RequestSpec.hs +13/−13

@@ -1,3 +1,7 @@+## 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)

@@ -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

@@ -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)@@ -121,27 +120,20 @@  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)+    case extractBasicAuthInfo uri of+        Just auth -> uncurry applyBasicAuth auth req+        Nothing -> req -authPrefix :: String -> String-authPrefix u = if '@' `elem` u then takeWhile (/= '@') u else ""+-- | 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+    toLiteral = S8.pack . unEscapeString  -- | Validate a 'URI', then add it to the request. setUri :: MonadThrow m => Request -> URI -> m Request

@@ -1,5 +1,5 @@ name:                http-client-version:             0.4.27+version:             0.4.27.1 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

@@ -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@example.com" `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@example.com" `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