http-conduit 1.9.2.2 → 1.9.3
raw patch · 5 files changed
+59/−10 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.HTTP.Conduit: managerResponseTimeout :: ManagerSettings -> Maybe Int
Files
- Network/HTTP/Conduit.hs +13/−5
- Network/HTTP/Conduit/Manager.hs +24/−3
- Network/HTTP/Conduit/Request.hs +9/−1
- http-conduit.cabal +1/−1
- test/main.hs +12/−0
Network/HTTP/Conduit.hs view
@@ -24,8 +24,8 @@ -- > main = do -- > request <- parseUrl "http://google.com/" -- > withManager $ \manager -> do--- > Response _ _ _ src <- http request manager--- > src C.$$+- sinkFile "google.html"+-- > response <- http request manager+-- > responseBody response C.$$+- sinkFile "google.html" -- -- The following headers are automatically set by this module, and should not -- be added to 'requestHeaders':@@ -156,6 +156,7 @@ , managerConnCount , managerCheckCerts , managerCertStore+ , managerResponseTimeout -- *** Defaults , defaultCheckCerts -- * Cookies@@ -290,7 +291,7 @@ Nothing -> return (req', def) (timeout', (connRelease, ci, isManaged)) <- getConnectionWrapper req- (responseTimeout req)+ (responseTimeout' req) (failedConnectionException req) (getConn req m) let src = connSource ci@@ -321,12 +322,19 @@ Nothing -> return res where + responseTimeout' req+ | rt == useDefaultTimeout = mResponseTimeout m+ | otherwise = rt+ where+ rt = responseTimeout req+ -- Exceptions for which we should retry our request if we were reusing an -- already open connection. In the case of IOExceptions, for example, we -- assume that the connection was closed on the server and therefore open a -- new one.- isRetryableException e =- case fromException e of+ isRetryableException e+ | ((fromException e)::(Maybe TLS.TLSError))==Just TLS.Error_EOF = True+ | otherwise = case fromException e of Just (_ :: IOException) -> True _ -> case fromException e of
Network/HTTP/Conduit/Manager.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE BangPatterns #-} module Network.HTTP.Conduit.Manager ( Manager+ , mResponseTimeout , ManagerSettings (..) , ConnKey (..) , ConnHost (..)@@ -75,6 +76,13 @@ -- ^ Check if the server certificate is valid. Only relevant for HTTPS. , managerCertStore :: IO CertificateStore -- ^ Load up the certificate store. By default uses the system store.+ , managerResponseTimeout :: Maybe Int+ -- ^ Default timeout (in microseconds) to be applied to requests which do+ -- not provide a timeout value.+ --+ -- Default is 5 seconds+ --+ -- Since 1.9.3 } type X509Encoded = L.ByteString@@ -84,6 +92,7 @@ { managerConnCount = 10 , managerCheckCerts = defaultCheckCerts , managerCertStore = getSystemCertificateStore+ , managerResponseTimeout = Just 5000000 } -- | Check certificates using the operating system's certificate checker.@@ -105,6 +114,8 @@ , mCertCache :: !(I.IORef (Map.Map S8.ByteString (Map.Map X509Encoded UTCTime))) -- ^ Cache of validated certificates. The @UTCTime@ gives the expiration -- time for the validity of the certificate. The @Ascii@ is the hostname.+ , mResponseTimeout :: !(Maybe Int)+ -- ^ Copied from 'managerResponseTimeout' } data NonEmptyList a =@@ -174,7 +185,13 @@ mapRef <- I.newIORef (Just Map.empty) certCache <- I.newIORef Map.empty _ <- forkIO $ reap mapRef certCache- return $ Manager mapRef (managerConnCount ms) (\x y -> getCertStore >>= \cs -> managerCheckCerts ms cs x y) certCache+ return Manager+ { mConns = mapRef+ , mMaxConns = managerConnCount ms+ , mCheckCerts = \x y -> getCertStore >>= \cs -> managerCheckCerts ms cs x y+ , mCertCache = certCache+ , mResponseTimeout = managerResponseTimeout ms+ } -- | Collect and destroy any stale connections. reap :: I.IORef (Maybe (Map.Map ConnKey (NonEmptyList ConnInfo)))@@ -286,8 +303,12 @@ (_, manager) <- allocate (newManager s) closeManager f manager --- | Close all connections in a 'Manager'. Afterwards, the--- 'Manager' can be reused if desired.+-- | Close all connections in a 'Manager'. Afterwards, the 'Manager'+-- can be reused if desired.+--+-- Note that this doesn't affect currently in-flight connections,+-- meaning you can safely use it without hurting any queries you may+-- have concurrently running. closeManager :: Manager -> IO () closeManager manager = mask_ $ do m <- I.atomicModifyIORef (mConns manager) $ \x -> (Nothing, x)
Network/HTTP/Conduit/Request.hs view
@@ -21,6 +21,7 @@ , urlEncodedBody , needsGunzip , requestBuilder+ , useDefaultTimeout ) where import Data.Maybe (fromMaybe, isJust)@@ -157,6 +158,13 @@ , "}" ] +-- | Magic value to be placed in a 'Request' to indicate that we should use the+-- timeout value in the @Manager@.+--+-- Since 1.9.3+useDefaultTimeout :: Maybe Int+useDefaultTimeout = Just (-3425)+ instance Default (Request m) where def = Request { host = "localhost"@@ -178,7 +186,7 @@ if 200 <= sci && sci < 300 then Nothing else Just $ toException $ StatusCodeException s hs cookie_jar- , responseTimeout = Just 5000000+ , responseTimeout = useDefaultTimeout , getConnectionWrapper = \mtimeout exc f -> case mtimeout of Nothing -> fmap ((,) Nothing) f
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.9.2.2+version: 1.9.3 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/main.hs view
@@ -285,6 +285,18 @@ res <- withManager $ httpLbs req responseBody res @?= "homepage for example.com" + describe "managerResponseTimeout" $ do+ it "works" $ withApp app $ \port -> do+ req1 <- parseUrl $ "http://localhost:" ++ show port+ let req2 = req1 { responseTimeout = Just 5000000 }+ withManagerSettings def { managerResponseTimeout = Just 1 } $ \man -> do+ eres1 <- try $ httpLbs req1 man+ case eres1 of+ Left (FailedConnectionException _ _) -> return ()+ _ -> error "Did not time out"+ _ <- httpLbs req2 man+ return ()+ withCApp :: Data.Conduit.Network.Application IO -> (Int -> IO ()) -> IO () withCApp app' f = do port <- getPort