[Haskell-cafe] Database connection pool

[Bas van Dijk]

On Thu, May 6, 2010 at 7:48 PM, Bas van Dijk <v.dijk.bas at gmail.com> wrote:
> On Thu, May 6, 2010 at 3:24 PM, Michael Snoyman <michael at snoyman.com> wrote:
>>
>>
>> On Thu, May 6, 2010 at 9:13 AM, Bryan O'Sullivan <bos at serpentine.com> wrote:
>>>
>>> On Wed, May 5, 2010 at 10:51 PM, Michael Snoyman <michael at snoyman.com>
>>> wrote:
>>>>
>>>> * When a connection is released, is goes to the end of the pool, so
>>>> connections get used evenly (not sure if this actually matters in practice).
>>>
>>> In practice, you're better off letting idle connections stay that way,
>>> because then your DB server can close connections and free up resources. In
>>> other words, when you're done with a connection, put it at the front of the
>>> reuse queue, not the back.
>>> You'll also want to handle the possibility that a connection that you grab
>>> from the pool has been closed by the server. Many connection pooling
>>> implementations I've seen get this wrong in subtle or expensive ways.
>>
>> Thanks for the feedback. I've gone ahead and implemented a simple resource
>> pool module. Since I need it to work with monad transformer stacks, I've
>> built it on top of MonadCatchIO-transformers. I've put the code up in a gist
>> on github[1]. I would appreciate if anyone could review this, especially to
>> make sure the exception handling code is correct. block and unblock in
>> particular concern me.
>> Thanks,
>> Michael
>> [1] http://gist.github.com/392078
>
> I also have a suggestion for your design. (Note however that I don't
> have much experience with resource pools.)
>
> In your current design a Pool has a fixed maximum number of opened
> resources. I can imagine situations where the maximum number of opened
> resources can change dynamically. For example due to plugging in (or
> out) a new blade server at run-time which will increase (or decrease)
> the maximum number of resources that can be handled.
>
> So what about changing:
>
> createPool :: IO a -> Int -> IO (Pool a)
> to:
> createPool :: IO (Maybe a) -> IO (Pool a)
>
> so, instead of statically storing the maximum number of  opened
> resources (Int), the resource creation function will decide itself
> when it has created enough (Maybe a).
>
> Regards,
>
> Bas
>

How about something like this:

--------------------------------------------------------------------------------
{-# LANGUAGE NoImplicitPrelude #-} -- (I like to be explicit)

module Pool (Pool, new, withPool) where

import Data.Function               ( ($), (.) )
import Data.Maybe                  ( Maybe(Nothing,Just), maybe )
import Data.Functor                ( (<$>) )
import Control.Monad               ( return, (>>=), (>>), (=<<), fail,
join, liftM )
import Control.Monad.STM           ( atomically )
import Control.Concurrent.STM.TVar ( TVar, newTVarIO, readTVar, writeTVar )
import Control.Monad.CatchIO       ( MonadCatchIO, block, finally )
import Control.Monad.IO.Class      ( liftIO )

newtype Pool r = Pool (TVar [r])

new :: MonadCatchIO m => m (Pool r)
new = liftIO $ Pool <$> newTVarIO []

withPool :: MonadCatchIO m => Pool r -> m (Maybe r) -> (r -> m a) -> m (Maybe a)
withPool (Pool tv) mk f = block $ join $ liftIO $ atomically $ do
  rrs <- readTVar tv
  case rrs of
    [] -> return $ mk >>= maybe (return Nothing) with
    r:rs -> writeTVar tv rs >> return (with r)
    where
      with r = liftM Just (f r)
                `finally`
                  liftIO (atomically $ writeTVar tv . (r:) =<< readTVar tv)
--------------------------------------------------------------------------------

Note that I don't store the resource creation action (m (Maybe r))
inside the pool. It's just passed as an argument to withPool.

Regards,

Bas