http-client 0.3.6.1 → 0.3.7.1
raw patch · 4 files changed
+77/−32 lines, 4 filesdep +network-uridep ~basedep ~network
Dependencies added: network-uri
Dependency ranges changed: base, network
Files
- Network/HTTP/Client.hs +12/−0
- Network/HTTP/Client/Manager.hs +37/−28
- Network/HTTP/Client/Types.hs +19/−3
- http-client.cabal +9/−1
Network/HTTP/Client.hs view
@@ -23,6 +23,17 @@ -- 'withManager' 'defaultManagerSettings' -- @ --+-- While generally speaking it is a good idea to share a single @Manager@+-- throughout your application, there are cases where it makes more sense to+-- create and destroy @Manager@s more frequently. As an example, if you have an+-- application which will make a large number of requests to different hosts,+-- and will never make more than one connection to a single host, then sharing+-- a @Manager@ will result in idle connections being kept open longer than+-- necessary. In such a situation, it makes sense to use @withManager@ around+-- each new request, to avoid running out of file descriptors. (Note that the+-- 'managerIdleConnectionCount' setting mitigates the risk of leaking too many+-- file descriptors.)+-- -- The next core component is a @Request@, which represents a single HTTP -- request to be sent to a specific server. @Request@s allow for many settings -- to control exact how they function, but usually the simplest approach for@@ -73,6 +84,7 @@ , managerResponseTimeout , managerRetryableException , managerWrapIOException+ , managerIdleConnectionCount -- * Request , parseUrl , applyBasicAuth
Network/HTTP/Client/Manager.hs view
@@ -31,7 +31,7 @@ import qualified Data.Text as T import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad (unless)+import Control.Monad (unless, join) import Control.Exception (mask_, SomeException, bracket, catch, throwIO, fromException, mask, IOException, Exception (..), handle) import Control.Concurrent (forkIO, threadDelay) import Data.Time (UTCTime (..), Day (..), DiffTime, getCurrentTime, addUTCTime)@@ -76,32 +76,42 @@ Just e -> toException $ InternalIOException e Nothing -> se in handle $ throwIO . wrapper+ , managerIdleConnectionCount = 512 } takeSocket :: Manager -> ConnKey -> IO (Maybe Connection) takeSocket man key = I.atomicModifyIORef (mConns man) go where- go Nothing = (Nothing, Nothing)- go (Just m) =+ go ManagerClosed = (ManagerClosed, Nothing)+ go mcOrig@(ManagerOpen idleCount m) = case Map.lookup key m of- Nothing -> (Just m, Nothing)- Just (One a _) -> (Just $ Map.delete key m, Just a)- Just (Cons a _ _ rest) -> (Just $ Map.insert key rest m, Just a)+ Nothing -> (mcOrig, Nothing)+ Just (One a _) ->+ let mc = ManagerOpen (idleCount - 1) (Map.delete key m)+ in mc `seq` (mc, Just a)+ Just (Cons a _ _ rest) ->+ let mc = ManagerOpen (idleCount - 1) (Map.insert key rest m)+ in mc `seq` (mc, Just a) putSocket :: Manager -> ConnKey -> Connection -> IO () putSocket man key ci = do now <- getCurrentTime- msock <- I.atomicModifyIORef (mConns man) (go now)- maybe (return ()) connectionClose msock+ join $ I.atomicModifyIORef (mConns man) (go now) where- go _ Nothing = (Nothing, Just ci)- go now (Just m) =- case Map.lookup key m of- Nothing -> (Just $ Map.insert key (One ci now) m, Nothing)+ go _ ManagerClosed = (ManagerClosed , connectionClose ci)+ go now mc@(ManagerOpen idleCount m)+ | idleCount >= mIdleConnectionCount man = (mc, connectionClose ci)+ | otherwise = case Map.lookup key m of+ Nothing ->+ let cnt' = idleCount + 1+ m' = ManagerOpen cnt' (Map.insert key (One ci now) m)+ in m' `seq` (m', return ()) Just l -> let (l', mx) = addToList now (mMaxConns man) ci l- in (Just $ Map.insert key l' m, mx)+ cnt' = idleCount + maybe 0 (const 1) mx+ m' = ManagerOpen cnt' (Map.insert key l' m)+ in m' `seq` (m', maybe (return ()) connectionClose mx) -- | Add a new element to the list, up to the given maximum number. If we're -- already at the maximum, return the new value as leftover.@@ -128,7 +138,7 @@ rawConnection <- managerRawConnection ms tlsConnection <- managerTlsConnection ms tlsProxyConnection <- managerTlsProxyConnection ms- mapRef <- I.newIORef (Just Map.empty)+ mapRef <- I.newIORef $! ManagerOpen 0 Map.empty wmapRef <- I.mkWeakIORef mapRef $ closeManager' mapRef _ <- forkIO $ reap wmapRef let manager = Manager@@ -140,12 +150,12 @@ , mTlsProxyConnection = tlsProxyConnection , mRetryableException = managerRetryableException ms , mWrapIOException = managerWrapIOException ms+ , mIdleConnectionCount = managerIdleConnectionCount ms } return manager -- | Collect and destroy any stale connections.-reap :: Weak (I.IORef (Maybe (Map.Map ConnKey (NonEmptyList Connection))))- -> IO ()+reap :: Weak (I.IORef ConnsMap) -> IO () reap wmapRef = mask_ loop where@@ -159,16 +169,13 @@ goMapRef mapRef = do now <- getCurrentTime let isNotStale time = 30 `addUTCTime` time >= now- mtoDestroy <- I.atomicModifyIORef mapRef (findStaleWrap isNotStale)- case mtoDestroy of- Nothing -> return () -- manager is closed- Just toDestroy -> do- mapM_ safeConnClose toDestroy- loop- findStaleWrap _ Nothing = (Nothing, Nothing)- findStaleWrap isNotStale (Just m) =+ toDestroy <- I.atomicModifyIORef mapRef (findStaleWrap isNotStale)+ mapM_ safeConnClose toDestroy+ loop+ findStaleWrap _ ManagerClosed = (ManagerClosed, [])+ findStaleWrap isNotStale (ManagerOpen idleCount m) = let (x, y) = findStale isNotStale m- in (Just x, Just y)+ in (ManagerOpen (idleCount - length y) x, y) findStale isNotStale = findStale' id id . Map.toList where@@ -244,11 +251,13 @@ closeManager :: Manager -> IO () closeManager = closeManager' . mConns -closeManager' :: I.IORef (Maybe (Map.Map ConnKey (NonEmptyList Connection)))+closeManager' :: I.IORef ConnsMap -> IO () closeManager' connsRef = mask_ $ do- m <- I.atomicModifyIORef connsRef $ \x -> (Nothing, x)- mapM_ (nonEmptyMapM_ safeConnClose) $ maybe [] Map.elems m+ !m <- I.atomicModifyIORef connsRef $ \x -> (ManagerClosed, x)+ case m of+ ManagerClosed -> return ()+ ManagerOpen _ m -> mapM_ (nonEmptyMapM_ safeConnClose) $ Map.elems m -- | Create, use and close a 'Manager'. --
Network/HTTP/Client/Types.hs view
@@ -22,6 +22,7 @@ , Response (..) , ResponseClose (..) , Manager (..)+ , ConnsMap (..) , ManagerSettings (..) , NonEmptyList (..) , ConnHost (..)@@ -365,7 +366,7 @@ , responseTimeout :: Maybe Int -- ^ Number of microseconds to wait for a response. If -- @Nothing@, will wait indefinitely. Default: use- -- 'managerResponseTimeout' (which by default is 5 seconds).+ -- 'managerResponseTimeout' (which by default is 30 seconds). -- -- Since 0.1.0 , getConnectionWrapper :: Maybe Int@@ -466,7 +467,7 @@ -- ^ Default timeout (in microseconds) to be applied to requests which do -- not provide a timeout value. --- -- Default is 5 seconds+ -- Default is 30 seconds -- -- Since 0.1.0 , managerRetryableException :: SomeException -> Bool@@ -483,6 +484,16 @@ -- Default: wrap all @IOException@s in the @InternalIOException@ constructor. -- -- Since 0.1.0+ , managerIdleConnectionCount :: Int+ -- ^ Total number of idle connection to keep open at a given time.+ --+ -- This limit helps deal with the case where you are making a large number+ -- of connections to different hosts. Without this limit, you could run out+ -- of file descriptors.+ --+ -- Default: 512+ --+ -- Since 0.3.7 } deriving T.Typeable @@ -492,7 +503,7 @@ -- -- Since 0.1.0 data Manager = Manager- { mConns :: I.IORef (Maybe (Map.Map ConnKey (NonEmptyList Connection)))+ { mConns :: I.IORef ConnsMap -- ^ @Nothing@ indicates that the manager is closed. , mMaxConns :: Int -- ^ This is a per-@ConnKey@ value.@@ -503,8 +514,13 @@ , mTlsProxyConnection :: S.ByteString -> (Connection -> IO ()) -> String -> Maybe NS.HostAddress -> String -> Int -> IO Connection , mRetryableException :: SomeException -> Bool , mWrapIOException :: forall a. IO a -> IO a+ , mIdleConnectionCount :: Int } deriving T.Typeable++data ConnsMap+ = ManagerClosed+ | ManagerOpen {-# UNPACK #-} !Int !(Map.Map ConnKey (NonEmptyList Connection)) data NonEmptyList a = One a UTCTime |
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.3.6.1+version: 0.3.7.1 synopsis: An HTTP client engine, intended as a base layer for more user-friendly packages. description: This codebase has been refactored from http-conduit. homepage: https://github.com/snoyberg/http-client@@ -12,6 +12,10 @@ extra-source-files: README.md cabal-version: >=1.10 +flag network-uri+ description: Get Network.URI from the network-uri package+ default: True+ library exposed-modules: Network.HTTP.Client Network.HTTP.Client.MultipartFormData@@ -47,6 +51,10 @@ , random , filepath , mime-types+ if flag(network-uri)+ build-depends: network >= 2.6, network-uri >= 2.6+ else+ build-depends: network < 2.6 default-language: Haskell2010 test-suite spec