http-client 0.7.18 → 0.7.19
raw patch · 3 files changed
+84/−57 lines, 3 filesnew-uploader
Files
- ChangeLog.md +4/−0
- Network/HTTP/Client/Core.hs +79/−56
- http-client.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for http-client +## 0.7.19++* Make mockable via `Network.HTTP.Client.Internal.requestAction` [#554](https://github.com/snoyberg/http-client/pull/554)+ ## 0.7.18 * Add the `managerSetMaxNumberHeaders` function to the `Client` module to configure `managerMaxNumberHeaders` in `ManagerSettings`.
Network/HTTP/Client/Core.hs view
@@ -6,6 +6,7 @@ , httpNoBody , httpRaw , httpRaw'+ , requestAction , getModifiedRequestManager , responseOpen , responseClose@@ -25,11 +26,13 @@ import Network.HTTP.Client.Cookies import Data.Maybe (fromMaybe, isJust) import Data.Time+import Data.IORef import Control.Exception import qualified Data.ByteString.Lazy as L import Data.Monoid import Control.Monad (void) import System.Timeout (timeout)+import System.IO.Unsafe (unsafePerformIO) import Data.KeyedPool import GHC.IO.Exception (IOException(..), IOErrorType(..)) @@ -94,66 +97,86 @@ now <- getCurrentTime return $ insertCookiesIntoRequest req' (evictExpiredCookies cj now) now Nothing -> return (req', Data.Monoid.mempty)- (timeout', mconn) <- getConnectionWrapper- (responseTimeout' req)- (getConn req m)-- -- Originally, we would only test for exceptions when sending the request,- -- not on calling @getResponse@. However, some servers seem to close- -- connections after accepting the request headers, so we need to check for- -- exceptions in both.- ex <- try $ do- cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn)+ res <- makeRequest req m+ case cookieJar req' of+ Just _ -> do+ now' <- getCurrentTime+ let (cookie_jar, _) = updateCookieJar res req now' cookie_jar'+ return (req, res {responseCookieJar = cookie_jar})+ Nothing -> return (req, res) - getResponse (mMaxHeaderLength m) (mMaxNumberHeaders m) timeout' req mconn cont+makeRequest+ :: Request+ -> Manager+ -> IO (Response BodyReader)+makeRequest req m = do+ action <- readIORef requestAction+ action req m - case ex of- -- Connection was reused, and might have been closed. Try again- Left e | managedReused mconn && mRetryableException m e -> do- managedRelease mconn DontReuse- httpRaw' req m- -- Not reused, or a non-retry, so this is a real exception- Left e -> do- -- Explicitly release connection for all real exceptions:- -- https://github.com/snoyberg/http-client/pull/454- managedRelease mconn DontReuse- throwIO e- -- Everything went ok, so the connection is good. If any exceptions get- -- thrown in the response body, just throw them as normal.- Right res -> case cookieJar req' of- Just _ -> do- now' <- getCurrentTime- let (cookie_jar, _) = updateCookieJar res req now' cookie_jar'- return (req, res {responseCookieJar = cookie_jar})- Nothing -> return (req, res)+requestAction :: IORef (Request -> Manager -> IO (Response BodyReader))+{-# NOINLINE requestAction #-}+requestAction = unsafePerformIO (newIORef action) where- getConnectionWrapper mtimeout f =- case mtimeout of- Nothing -> fmap ((,) Nothing) f- Just timeout' -> do- before <- getCurrentTime- mres <- timeout timeout' f- case mres of- Nothing -> throwHttp ConnectionTimeout- Just mConn -> do- now <- getCurrentTime- let timeSpentMicro = diffUTCTime now before * 1000000- remainingTime = round $ fromIntegral timeout' - timeSpentMicro- if remainingTime <= 0- then do- managedRelease mConn DontReuse- throwHttp ConnectionTimeout- else return (Just remainingTime, mConn)+ action+ :: Request+ -> Manager+ -> IO (Response BodyReader)+ action req m = do+ (timeout', mconn) <- getConnectionWrapper+ (responseTimeout' req)+ (getConn req m) - responseTimeout' req =- case responseTimeout req of- ResponseTimeoutDefault ->- case mResponseTimeout m of- ResponseTimeoutDefault -> Just 30000000- ResponseTimeoutNone -> Nothing- ResponseTimeoutMicro u -> Just u- ResponseTimeoutNone -> Nothing- ResponseTimeoutMicro u -> Just u+ -- Originally, we would only test for exceptions when sending the request,+ -- not on calling @getResponse@. However, some servers seem to close+ -- connections after accepting the request headers, so we need to check for+ -- exceptions in both.+ ex <- try $ do+ cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn)++ getResponse (mMaxHeaderLength m) (mMaxNumberHeaders m) timeout' req mconn cont++ case ex of+ -- Connection was reused, and might have been closed. Try again+ Left e | managedReused mconn && mRetryableException m e -> do+ managedRelease mconn DontReuse+ action req m+ -- Not reused, or a non-retry, so this is a real exception+ Left e -> do+ -- Explicitly release connection for all real exceptions:+ -- https://github.com/snoyberg/http-client/pull/454+ managedRelease mconn DontReuse+ throwIO e+ -- Everything went ok, so the connection is good. If any exceptions get+ -- thrown in the response body, just throw them as normal.+ Right res -> return res+ where+ getConnectionWrapper mtimeout f =+ case mtimeout of+ Nothing -> fmap ((,) Nothing) f+ Just timeout' -> do+ before <- getCurrentTime+ mres <- timeout timeout' f+ case mres of+ Nothing -> throwHttp ConnectionTimeout+ Just mConn -> do+ now <- getCurrentTime+ let timeSpentMicro = diffUTCTime now before * 1000000+ remainingTime = round $ fromIntegral timeout' - timeSpentMicro+ if remainingTime <= 0+ then do+ managedRelease mConn DontReuse+ throwHttp ConnectionTimeout+ else return (Just remainingTime, mConn)++ responseTimeout' req =+ case responseTimeout req of+ ResponseTimeoutDefault ->+ case mResponseTimeout m of+ ResponseTimeoutDefault -> Just 30000000+ ResponseTimeoutNone -> Nothing+ ResponseTimeoutMicro u -> Just u+ ResponseTimeoutNone -> Nothing+ ResponseTimeoutMicro u -> Just u -- | The used Manager can be overridden (by requestManagerOverride) and the used -- Request can be modified (through managerModifyRequest). This function allows
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.7.18+version: 0.7.19 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