{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns, RecordWildCards,
ScopedTypeVariables #-}-- |-- Module: Network.Riak.Connection.Pool-- Copyright: (c) 2011 MailRank, Inc.-- License: Apache-- Maintainer: Bryan O'Sullivan <bos@mailrank.com>-- Stability: experimental-- Portability: portable---- A high-performance striped pooling abstraction for managing-- connections to a Riak cluster.---- \"Striped\" means that a single 'Pool' consists of several-- sub-pools, each managed independently. A stripe size of 1 is fine-- for many applications, and probably what you should choose by-- default. Larger stripe sizes will lead to reduced contention in-- high-performance multicore applications, at a trade-off of causing-- the maximum number of simultaneous connections to grow.moduleNetwork.Riak.Connection.Pool(Pool,client,create,idleTime,maxConnections,numStripes,withConnection)whereimportControl.Applicative((<$>))importControl.Concurrent(forkIO,killThread,myThreadId,threadDelay)importControl.Concurrent.STMimportControl.Exception(SomeException,catch,onException)importControl.Monad(forM_,forever,join,liftM2,unless,when)importData.Hashable(hash)importData.List(partition)importData.Time.Clock(NominalDiffTime,UTCTime,diffUTCTime,getCurrentTime)importData.Typeable(Typeable)importNetwork.Riak.Connection.Internal(connect,disconnect,makeClientID)importNetwork.Riak.Debug(debug)importNetwork.Riak.Types(Client(clientID),Connection)importPreludehiding(catch)importSystem.Mem.Weak(addFinalizer)importqualifiedData.VectorasV-- | A single connection pool entry.dataEntry=Entry{connection::Connection,lastUse::UTCTime-- ^ Time of last return.}-- | A single striped pool.dataLocalPool=LocalPool{connected::TVarInt-- ^ Count of open connections (both idle and in use).,entries::TVar[Entry]-- ^ Idle entries.}-- | A pool of connections to a Riak server.---- This pool is \"striped\", i.e. it consists of several sub-pools-- that are managed independently.---- The total number of connections that can possibly be open at once-- is 'maxConnections' * 'numStripes'.dataPool=Pool{client::Client-- ^ Client specification. The client ID is ignored, and always-- regenerated automatically for each new connection.,numStripes::Int-- ^ Stripe count. The number of distinct sub-pools to maintain.-- The smallest acceptable value is 1.,idleTime::NominalDiffTime-- ^ Amount of time for which an unused connection is kept open.-- The smallest acceptable value is 0.5 seconds.---- The elapsed time before closing may be a little longer than-- requested, as the reaper thread wakes at 2-second intervals.,maxConnections::Int-- ^ Maximum number of connections to keep open per stripe. The-- smallest acceptable value is 1.-- -- Requests for connections will block if this limit is reached on-- a single stripe, even if other stripes have idle connections-- available.,localPools::V.VectorLocalPool-- ^ Per-capability connection pools.}deriving(Typeable)instanceShowPoolwhereshowPool{..}="Pool { client = "++showclient++", "++"numStripes = "++shownumStripes++", "++"idleTime = "++showidleTime++", "++"maxConnections = "++showmaxConnections++"}"instanceEqPoolwherea==b=clienta==clientb&&numStripesa==numStripesb&&idleTimea==idleTimeb&&maxConnectionsa==maxConnectionsb-- | Create a new connection pool.create::Client-- ^ Client configuration. The client ID is ignored, and-- always regenerated automatically for each new connection.->Int-- ^ Stripe count. The number of distinct sub-pools to-- maintain. The smallest acceptable value is 1.->NominalDiffTime-- ^ Amount of time for which an unused connection is kept-- open. The smallest acceptable value is 0.5 seconds.---- The elapsed time before closing may be a little longer than-- requested, as the reaper thread wakes at 2-second intervals.->Int-- ^ Maximum number of connections to keep open per stripe.-- The smallest acceptable value is 1.-- -- Requests for connections will block if this limit is reached-- on a single stripe, even if other stripes have idle-- connections available.->IOPoolcreateclientnumStripesidleTimemaxConnections=dowhen(numStripes<1)$modError"pool "$"invalid stripe count "++shownumStripeswhen(idleTime<0.5)$modError"pool "$"invalid idle time "++showidleTimewhen(maxConnections<1)$modError"pool "$"invalid maximum connection count "++showmaxConnectionslocalPools<-atomically.V.replicateMnumStripes$liftM2LocalPool(newTVar0)(newTVar[])reaperId<-forkIO$reaperidleTimelocalPoolsletp=Pool{client,numStripes,idleTime,maxConnections,localPools}addFinalizerp$killThreadreaperIdreturnp-- | Periodically go through all pools, closing any connections that-- have been left idle for too long.reaper::NominalDiffTime->V.VectorLocalPool->IO()reaperidleTimepools=forever$dothreadDelay(2*1000000)now<-getCurrentTimeletisStaleEntry{..}=now`diffUTCTime`lastUse>idleTimeV.forM_pools$\LocalPool{..}->doconns<-atomically$do(stale,fresh)<-partitionisStale<$>readTVarentriesunless(nullstale)$dowriteTVarentriesfreshmodifyTVar_connected(subtract(lengthstale))return(mapconnectionstale)forM_conns$\conn->dodebug"reaper""closing idle connection"disconnectconn`catch`\(_::SomeException)->return()-- | Temporarily take a connection from a 'Pool', perform an action-- with it, and return it to the pool afterwards.---- * If the pool has a connection available, it is used-- immediately.---- * Otherwise, if the maximum number of connections has not been-- reached, a new connection is created and used.---- * If the maximum number of connections has been reached, this-- function blocks until a connection becomes available, then that-- connection is used.---- If the action throws an exception of any type, the 'Connection' is-- destroyed, and not returned to the pool.---- It probably goes without saying that you should never call-- 'disconnect' on a connection, as doing so will cause a subsequent-- user, expecting the connection to be valid, to throw an exception.withConnection::Pool->(Connection->IOa)->IOawithConnectionPool{..}act=doi<-((`mod`numStripes).hash)<$>myThreadIdletLocalPool{..}=localPoolsV.!iconn<-join.atomically$doents<-readTVarentriescaseentsof(Entry{..}:es)->writeTVarentrieses>>return(returnconnection)[]->doinUse<-readTVarconnectedwhen(inUse==maxConnections)retrywriteTVarconnected$!inUse+1return$docid<-makeClientIDconnectclient{clientID=cid}`onException`atomically(modifyTVar_connected(subtract1))ret<-actconn`onException`dodisconnectconn`catch`\(_::SomeException)->return()atomically(modifyTVar_connected(subtract1))now<-getCurrentTimeatomically$modifyTVar_entries(Entryconnnow:)returnretmodifyTVar_::TVara->(a->a)->STM()modifyTVar_vf=readTVarv>>=\a->writeTVarv$!famodError::String->String->amodErrorfuncmsg=error$"Network.Riak.Connection.Pool."++func++": "++msg