bos / pool Goto Github PK

The current resource-pool depends on monad-control-0.2. Recently, Bas released version 0.3 with a new API. The following gist attempts to make resource-pool compatible with the new monad-control release:

https://gist.github.com/97ce5cef88ededac573a

The NominalDiffTime type is intended for manipulation of universal dates, and it does not always represent the same interval of time. The timeout values on the other hand require exactly an interval of time, which is the case in this library. Such values should be represented by the DiffTime type.

So I've got this use case where I need to connect to a db and the first connection is somewhat expensive, so I'd like to keep a connection always ready to avoid having the user waiting for the app to connect for the first time.

My idea is just like there is the maximum number of resources, there's also a minimum which never gets freed no matter what.

That could also help with #33 because if the user is eager to create the connection that would show an error immediately instead of the first time the pool needs to create a resource.

And maybe it's time to reify the settings for createPool since it starting to have too many parameters (which are similar in types but different in semantics)

Also thanks for writing such a useful library :D

Hi there,

Thanks for creating this library!

I have a question about how to make the following servant example using resource-pool fail immediately when given an invalid connection string: https://haskell-servant.readthedocs.io/en/stable/cookbook/db-postgres-pool/PostgresPool.html

If the main function of the example is modified to only start the server:

main :: IO ()
main = do
  -- you could read this from some configuration file,
  -- environment variable or somewhere else instead.
  -- you will need to either change this connection string OR
  -- set some environment variables (see
  -- https://www.postgresql.org/docs/9.5/static/libpq-envars.html)
  -- to point to a running PostgreSQL server for this example to work.
  let connStr = ""
  pool <- initConnectionPool connStr
  runApp pool

the server will happily start without errors, but throw an exception each time a request is handled (because connStr is invalid).

Shouldn't createPool create a resource pool immediately -- and thus fail at this point -- rather than wait until withResource is called?

There are a few open PRs and issues with no replies, it seems like @bos is not actively contributing since a few years, which is understandable given his current position.

@basvandijk is listed as a maintainer on Hackage, but with little activity on this library.

I know @scrive would be happy to take over maintenance, but perhaps @hasura are interested too? (cc/ @0x777, @Vladciobanu: due to the unpublished fork with recent commits).

From comments in #38 it seems like @Simspace might also be interested (cc/ @asivitz, @mjrussell), or even @parsonsmatt.

The library is very good as it is, and there is not much that needs to change, and it would be best to not have to publish a fork given the usefulness of this library and its widespread use: https://packdeps.haskellers.com/reverse/resource-pool

We're getting a malloc error when using resource-pool-0.2.2.0. With 0.2.1.1 we don't get the error. The error is:

manuel(61832,0x10c181000) malloc: *** error for object 0x7000000000000000: pointer being freed was not allocated
*** set a breakpoint in malloc_error_break to debug

This is on Mac OS X 10.9, using GHC 7.6.3. All other dependencies stay the same, so I'm pretty sure it's resource-pool.

Hey Bryan,

I noticed this here and in your pool in the Riak bindings, but what's the benefit of stripping pools? Why have 10 local pools of 20 connections instead of one pool of 200 connections?

Thanks,
Will

As far as I can tell, the handlers for resource cleanup handle in a regular mask, rather than an uninterruptibleMask. This means the handler can get interrupted and aborted midway if cleanup performs a blocking operation and an async exception arrives during this time. Perhaps resource cleanup should run in uninterruptibleMask? Alternatively, this problem should be documented on the page, so users can take relevant precautions themselves.

It is impossible to tell whether all pool resources are free or not.

Testing without such feature is complicated.

[1 of 1] Compiling Data.Pool ( Data/Pool.hs, dist/dist-sandbox-5e2d4400/build/Data/Pool.o )

Data/Pool.hs:313:26:
Could not deduce (Control.Monad.Trans.Control.StM m (Maybe a0)
~ Control.Monad.Trans.Control.StM m (Maybe b))
from the context (MonadBaseControl IO m)
bound by the type signature for
tryWithResource :: MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m (Maybe b)
at Data/Pool.hs:(300,5)-(304,40)
NB: ‘Control.Monad.Trans.Control.StM’ is a type function, and may not be injective
The type variable ‘a0’ is ambiguous
Expected type: m (Maybe a0)
-> IO (Control.Monad.Trans.Control.StM m (Maybe b))
Actual type: m (Maybe a0)
-> IO (Control.Monad.Trans.Control.StM m (Maybe a0))
Relevant bindings include
runInIO :: Control.Monad.Trans.Control.RunInBase m IO
(bound at Data/Pool.hs:305:39)
act :: a -> m b (bound at Data/Pool.hs:305:22)
tryWithResource :: Pool a -> (a -> m b) -> m (Maybe b)
(bound at Data/Pool.hs:305:1)
In the second argument of ‘(.)’, namely ‘runInIO’
In the expression: restore . runInIO

When using pool to manage a series of PostgreSQL connections (via postgresql-simple), I've found that idle connections are not being reaped. After doing some digging, it appears that the reaper thread is being killed almost immediately, which I've linked to the execution of the finaliser attached to the internal fin IORef. I've no doubt that this is an issue with my code and not pool, but was wondering if I might find some help here. While I've not managed to produce a minimal reproducing test case, I have details about what I'm doing:

• I'm wrapping the pool in a newtype, as in newtype MyPool = MyPool (Pool PG.Connection) and building one with fmap viz.

MyPool <$>
  createPool PG.createConnection PG.closeConnection noOfStripes maxIdleTime perStripe

• The above function results in the following core. To my inexperienced eyes, it doesn't suggest any cheeky unpacking/losing of the IORef by GHC (which to my inexperienced brain is what would trigger a GHC and subsequent finalizer running, no?):

createPostgreSQLConnectionPool
  :: PostgreSQLConfiguration
     -> PostgreSQLConnectionPoolConfiguration
     -> IO PostgreSQLConnectionPool
[GblId, Arity=2, Str=DmdType]
createPostgreSQLConnectionPool =
  \ (ds_doFL :: PostgreSQLConfiguration)
    (ds1_doFM :: PostgreSQLConnectionPoolConfiguration) ->
    case ds_doFL
    of _ [Occ=Dead]
    { PostgreSQLConfiguration ds2_doFN ds3_doFO ds4_doFP ds5_doFQ
                              ds6_doFR ->
    case ds1_doFM
    of _ [Occ=Dead]
    { PostgreSQLConnectionPoolConfiguration ds7_doFS ds8_doFT
                                            ds9_doFU ->
    let {
      closePostgreSQL_anEf :: PG.Connection -> IO ()
      [LclId, Str=DmdType]
      closePostgreSQL_anEf =
        \ (conn_anEg :: PG.Connection) ->
          >>
            @ IO
            GHC.Base.$fMonadIO
            @ ()
            @ ()
            (putStrLn
               (ghc-prim-0.4.0.0:GHC.CString.unpackCString#
                  "[PG] Closing connection"#))
            (PG.close conn_anEg) } in
    let {
      connectToPostgreSQL'_anEe :: IO PG.Connection
      [LclId, Str=DmdType]
      connectToPostgreSQL'_anEe =
        >>
          @ IO
          GHC.Base.$fMonadIO
          @ ()
          @ PG.Connection
          (putStrLn
             (ghc-prim-0.4.0.0:GHC.CString.unpackCString#
                "[PG] Creating connection"#))
          (PG.connect
             (case PG.defaultConnectInfo
              of _ [Occ=Dead]
              { PG.ConnectInfo ds10_doG0 ds11_doG1 ds12_doG2 ds13_doG3
                               ds14_doG4 ->
              Database.PostgreSQL.Simple.Internal.ConnectInfo
                ds2_doFN
                (fromIntegral
                   @ Int
                   @ GHC.Word.Word16
                   GHC.Real.$fIntegralInt
                   GHC.Word.$fNumWord16
                   ds3_doFO)
                ds4_doFP
                ds5_doFQ
                ds6_doFR
              })) } in
    <$>
      @ (Pool.Pool PG.Connection)
      @ PostgreSQLConnectionPool
      @ IO
      GHC.Base.$fFunctorIO
      ((\ (tpl_B1 :: Pool.Pool PG.Connection) -> tpl_B1)
       `cast` (<Pool.Pool PG.Connection>_R
               -> Sym
                    Company.PostgreSQL.Internal.Trans.NTCo:PostgreSQLConnectionPool[0]
               :: (Pool.Pool PG.Connection -> Pool.Pool PG.Connection)
                  ~R# (Pool.Pool PG.Connection -> PostgreSQLConnectionPool)))
      (Pool.createPool
         @ PG.Connection
         connectToPostgreSQL'_anEe
         closePostgreSQL_anEf
         ds7_doFS
         (fromIntegral
            @ Int
            @ time-1.5.0.1:Data.Time.Clock.UTC.NominalDiffTime
            GHC.Real.$fIntegralInt
            time-1.5.0.1:Data.Time.Clock.UTC.$fNumNominalDiffTime
            ds8_doFT)
         ds9_doFU)
    }
    }

• The created pool is being used to run a transformer stack, as in runPostgreSQL pool, and is working just fine in every other regard, so it seems like the fin is the only part of the structure being GC'd (again, assuming that this is the cause of the finaliser's running).
• To be clear, removing the call to mkWeakIORef causes the reaper to work correctly. Furthermore, the local pool finalizers can be left in place without affecting its working. Lastly, using addFinalizer from System.Mem.Weak (as was done in a previous version of this library, I believe) does not help either (again, perhaps it was stupid to assume it would).

Thanks in advance for any advice and apologies for not providing a minimal working example; I am struggling to find out exactly what I'm doing that's causing this. If there is any other information I can provide in the mean time I am happy to oblige to try and crack this.

The definition of destroyResource is:

destroyResource :: Pool a -> LocalPool a -> a -> IO ()
destroyResource Pool{..} LocalPool{..} resource = do
   destroy resource `E.catch` \(_::SomeException) -> return ()
   atomically (modifyTVar_ inUse (subtract 1))

inUse always gets decremented, regardless of if this function has been called multiple times for the same resource. Here is a demonstration of the issue:

#!/usr/bin/env stack
-- stack script --resolver lts-11.4 --package resource-pool --package stm

import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Monad
import Data.Pool

main :: IO ()
main = do
  counter <- newTVarIO 0
  let acquire = do
        k <- atomically $ do
          k <- readTVar counter
          writeTVar counter (k + 1)
          return k
        putStrLn $ "acquire " ++ show k
        return k
      release k = putStrLn $ "release " ++ show k
  pool <- createPool acquire release 1 60 1
  (k, localPool) <- takeResource pool
  destroyResource pool localPool k
  destroyResource pool localPool k
  void $ takeResource pool
  void $ takeResource pool
  putStrLn "Bug: acquired two resources despite the pool having a limit of 1.  Next resource acquire will block."
  void $ takeResource pool

Output:

acquire 0
release 0
release 0
acquire 1
acquire 2
Bug: acquired two resources despite the pool having a limit of 1.  Next resource acquire will block.

The resource-pool library assumes that a corrupted resource will cause an action that uses to it to throw an exception. I do not think this is universally true. I have an action involving a query on a database connection where, if the query throws an exception, the action can catch the exception and still return a meaningful value. However, I still want the connection resource to be destroyed when this happens.

I have written the following function for this, and I would like to propose the adding it to the library.

import Control.Exception (mask, onException)
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl, control)
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import Data.Pool (Pool, destroyResource, putResource, takeResource)

{- | Like 'withResource', but allows the action to explicitly destroy the resource

If the action throws an exception, the resource will be destroyed. If the action returns
normally and does not run the destroy action, the resource will be returned to the pool.
-}
withResource' :: (MonadBaseControl IO m, MonadIO m) =>
    Pool a
    -> (a -> m () -> m b) -- ^ The first argument is the resource; the second
                          --   argument is an action to destroy the resource
    -> m b
withResource' pool action = control $ \runInIO -> mask $ \restore ->
  do
    -- Acquire the resource
    (resource, local) <- takeResource pool

    -- Keep track of whether the resource has been destroyed, to avoid destroying it repeatedly
    destroyedRef <- newIORef False

    -- This action destroys the resource, if it has not already been destroyed
    let destroy = do alreadyDestroyed <- atomicModifyIORef' destroyedRef (\x -> (True, x))
                     unless alreadyDestroyed $ destroyResource pool local resource

    -- Run the user's action; if it throws an exception, destroy the resource
    result <- restore (runInIO (action resource (liftIO destroy))) `onException` destroy

    -- Return the resource to the pool, if it has not been destroyed
    destroyed <- readIORef destroyedRef
    unless destroyed $ putResource local resource

    -- Return the result from the user's action
    return result

to use Pool in a Reader for extensible effects, i need a Typeable instance for Pool. would you kindly add one?

There seems to be no way to delete a pool (i.e. delete all resources in a pool), because there is no way to know how many allocated resources there are in a pool. I could try to apply takeResource/destroyResource over and over, but there's no way to know when to stop. If I could query for the number of allocated resources, then I would know when to stop.

My use case is that the size of the resource pool may change at runtime, so I need to create a new pool and destroy all resources in the old pool. However, if resource-pool supported changing the size at runtime, then I could just use that instead of destroying and creating the pool.

The module-level comments refer to "stripe size," however the createPool function takes a "Stripe count" and a "Maximum number of resources...per stripe." It is unclear which parameter corresponds with the "stripe size" mentioned earlier.

The resource-pool package does not correctly destroy resources when the pool goes out of scope and is garbage collected. There is a finalizer that terminates the reaper thread, but nothing is done to deal with the outstanding resources.

For example, in the following code, the "destroy" is never printed to the screen:

do
  p <- createPool (putStrLn "create") (\() -> putStrLn "destroy") 1 3 5
  withResource p (\() -> return ())

However, if we add a 4-second delay, which makes sure that p stays in scope long enough for the reaper thread to destroy the resource, then we see "destroy" printed on the screen:

do
  p <- createPool (putStrLn "create") (\() -> putStrLn "destroy") 1 3 5
  withResource p (\() -> return ())
  threadDelay (1000*4000)

Shouldn't be too hard to fix.

I'm trying to write a job-queue backed by an RDBMS and have everything up & running, but not designed perfectly. I'm happy to share the entire design/source-code, because I plan to open-source it once it's battle-tested in production, but for now, here's the short version of the question --

How is the following going to behave:

forever $ withResource dbPool $ \conn -> async $ doSomething conn

Will pool be able to track usage of a resource in an async thread and put it back in the pool only when the thread has exited? Under no circumstance, do I want multiple threads sharing the same DB connection!

Matt Russell on Twitter identified that Data.Pool is evidently very slow with a single stripe.

Also the data.pool thing is pretty crazy. With many threads (i.e. any webserver) hitting the same pool the whole thing just locks up. It's doing tons of retries in stm. Single biggest bottleneck as we scaled. Stripes help...but still don't love the performance