diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,20 @@ # ChangeLog / ReleaseNotes +## Version 0.1.1.0 + +* Package is now buildable on Windows. (new) +* Introducing function `validateResourcePoolParams`. (new) +* Introducing internal function `destroyAllConnections`. (new) +* Introducing functions `destroyAllTcpClientConnections` and + `destroyAllTcpClientConnections` both build on top of + `destroyAllConnections`. (new) +* Corrected some typos in documentation and Haddock markup. +* Small documentation enhancements. +* Uploaded to [Hackage][]: + + + ## Version 0.1.0.0 * First public release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,8 @@ Connection Pool =============== -[![Hackage](https://budueba.com/hackage/connection-pool)][Hackage: connection-pool] +[![Hackage](http://img.shields.io/hackage/v/connection-pool.svg) +][Hackage: connection-pool] Description @@ -13,9 +14,10 @@ 1. pool for TCP client connections, 2. and pool for UNIX Sockets client connections. -This package is built on top of [resource-pool][] and [streaming-commons][]. -The later allows us to use [conduit-extra][] package for implementation of TCP -or UNIX Sockets clients. +This package is built on top of [resource-pool][Hackage: resource-pool] and +[streaming-commons][Hackage: streaming-commons]. The later allows us to use +[conduit-extra][Hackage: conduit-extra] package for implementation of TCP or +UNIX Sockets clients. Documentation @@ -25,6 +27,13 @@ [Hackage][Hackage: connection-pool] +Examples +-------- + +Simple code examples, including example from the following section, are +available in [example/](example/) directory. + + TCP Client Example ------------------ @@ -107,6 +116,12 @@ resources. +License +------- + +The BSD 3-Clause License, see [LICENSE](LICENSE) file for details. + + Contributions ------------- @@ -116,11 +131,11 @@ -[conduit-extra]: +[Hackage: conduit-extra]: http://hackage.haskell.org/package/conduit-extra -[connection-pool] +[Hackage: connection-pool]: http://hackage.haskell.org/package/connection-pool -[resource-pool]: +[Hackage: resource-pool]: http://hackage.haskell.org/package/resource-pool -[streaming-commons]: +[Hackage: streaming-commons]: http://hackage.haskell.org/package/streaming-commons diff --git a/connection-pool.cabal b/connection-pool.cabal --- a/connection-pool.cabal +++ b/connection-pool.cabal @@ -1,10 +1,10 @@ name: connection-pool -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Connection pool built on top of resource-pool and streaming-commons. description: Connection poll is a family specialised resource pools. Currently package - provides two + provides two variants: . 1. pool for TCP client connections, . @@ -27,7 +27,7 @@ author: Peter Trško maintainer: peter.trsko@gmail.com copyright: (c) 2014 Peter Trško -category: Data +category: Data, Network build-type: Simple cabal-version: >=1.10 @@ -57,6 +57,8 @@ , DeriveDataTypeable , FlexibleContexts , NoImplicitPrelude + , RecordWildCards + , StandaloneDeriving , TupleSections , TypeFamilies @@ -111,4 +113,4 @@ source-repository this type: git location: git://github.com/trskop/connection-pool.git - tag: v0.1.0.0 + tag: v0.1.1.0 diff --git a/src/Data/ConnectionPool.hs b/src/Data/ConnectionPool.hs --- a/src/Data/ConnectionPool.hs +++ b/src/Data/ConnectionPool.hs @@ -52,16 +52,26 @@ -- -- $constructingConnectionPool , ResourcePoolParams + + -- ** Lenses + -- + -- $resourcePoolParamsLenses , numberOfResourcesPerStripe , numberOfStripes , resourceIdleTimeout + -- ** Validation + -- + -- $resourcePoolParamsValidation + , validateResourcePoolParams + -- * TCP Client Connection Pool , TcpClient , ClientSettings , AppData , createTcpClientPool , withTcpClientConnection + , destroyAllTcpClientConnections #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -72,6 +82,7 @@ , AppDataUnix , createUnixClientPool , withUnixClientConnection + , destroyAllUnixClientConnections #endif -- !WINDOWS ) @@ -110,6 +121,7 @@ import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal ( createConnectionPool , withConnection + , destroyAllConnections ) import qualified Data.ConnectionPool.Internal.ConnectionPoolFamily as Internal ( ConnectionPool(..) @@ -119,6 +131,7 @@ , numberOfResourcesPerStripe , numberOfStripes , resourceIdleTimeout + , validateResourcePoolParams ) import qualified Data.ConnectionPool.Internal.Streaming as Internal ( acquireTcpClientConnection @@ -153,6 +166,19 @@ withTcpClientConnection (Internal.TcpConnectionPool pool) = Internal.withConnection pool . Internal.runTcpApp Nothing +-- | Destroy all TCP connections that might be still open in a connection pool. +-- This is useful when one needs to release all resources at once and not to +-- wait for idle timeout to be reached. +-- +-- For more details see 'Pool.destroyAllResources'. +-- +-- /Since version 0.1.1.0./ +destroyAllTcpClientConnections + :: ConnectionPool TcpClient + -> IO () +destroyAllTcpClientConnections (Internal.TcpConnectionPool pool) = + Internal.destroyAllConnections pool + #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -177,6 +203,19 @@ -> m r withUnixClientConnection (Internal.UnixConnectionPool pool) = Internal.withConnection pool . Internal.runUnixApp + +-- | Destroy all UNIX Sockets connections that might be still open in a +-- connection pool. This is useful when one needs to release all resources at +-- once and not to wait for idle timeout to be reached. +-- +-- For more details see 'Pool.destroyAllResources'. +-- +-- /Since version 0.1.1.0./ +destroyAllUnixClientConnections + :: ConnectionPool UnixClient + -> IO () +destroyAllUnixClientConnections (Internal.UnixConnectionPool pool) = + Internal.destroyAllConnections pool #endif -- !WINDOWS @@ -202,7 +241,10 @@ -- , 'withTcpClientConnection' -- ) -- import Data.Default.Class (Default(def)) --- import Data.Streaming.Network (appWrite, clientSettingsTCP) +-- import Data.Streaming.Network +-- ( 'Data.Streaming.Network.appWrite' +-- , 'Data.Streaming.Network.clientSettingsTCP' +-- ) -- -- -- main :: IO () @@ -210,15 +252,15 @@ -- [port, numStripes, numPerStripe] <- getArgs -- pool <- 'createTcpClientPool' -- (poolParams numStripes numPerStripe) --- (clientSettingsTCP (read port) "127.0.0.1") +-- ('Data.Streaming.Network.clientSettingsTCP' (read port) \"127.0.0.1\") -- void . forkIO . 'withTcpClientConnection' pool $ \\appData -> do -- threadDelay 100 --- appWrite appData "1: I'm alive!\\n" +-- 'Data.Streaming.Network.appWrite' appData \"1: I'm alive!\\n\" -- void . forkIO . 'withTcpClientConnection' pool $ \\appData -> --- appWrite appData "2: I'm alive!\\n" +-- 'Data.Streaming.Network.appWrite' appData \"2: I'm alive!\\n\" -- where -- poolParams m n = --- def & 'numberOfStripes' .~ read m +-- 'Data.Default.Class.def' & 'numberOfStripes' .~ read m -- & 'numberOfResourcesPerStripe' .~ read n -- @ -- @@ -282,7 +324,10 @@ -- , 'withUnixClientConnection' -- ) -- import Data.Default.Class (Default(def)) --- import Data.Streaming.Network (appWrite, clientSettingsUnix) +-- import Data.Streaming.Network +-- ( 'Data.Streaming.Network.appWrite' +-- , 'Data.Streaming.Network.clientSettingsUnix' +-- ) -- -- -- main :: IO () @@ -290,15 +335,15 @@ -- [socket, numStripes, numPerStripe] <- getArgs -- pool <- 'createUnixClientPool' -- (poolParams numStripes numPerStripe) --- (clientSettingsUnix socket) +-- ('Data.Streaming.Network.clientSettingsUnix' socket) -- void . forkIO . 'withUnixClientConnection' pool $ \\appData -> do -- threadDelay 100 --- appWrite appData "1: I'm alive!\\n" +-- 'Data.Streaming.Network.appWrite' appData \"1: I'm alive!\\n\" -- void . forkIO . 'withUnixClientConnection' pool $ \\appData -> --- appWrite appData "2: I'm alive!\\n" +-- 'Data.Streaming.Network.appWrite' appData \"2: I'm alive!\\n\" -- where -- poolParams m n = --- def & 'numberOfStripes' .~ read m +-- 'Data.Default.Class.def' & 'numberOfStripes' .~ read m -- & 'numberOfResourcesPerStripe' .~ read n -- @ -- @@ -345,20 +390,65 @@ -- instance. For TCP clients it's 'createTcpClientPool' and for UNIX Socket -- clients it's 'createUnixClientPool' (not available on Windows). -- +-- In each case two kinds of values need to be provided as parameters to such +-- functions: +-- +-- 1. Parameters of underlying resource pool like how to organize stripes and +-- parameters for algorithm that handles resource releasing, etc. +-- +-- 2. Transport protocol parameters like IP address, port, UNIX Socket file, +-- and similar. +-- -- To simplify things we provide 'ResourcePoolParams' data type that is -- accepted by concrete constructors of 'ConnectionPool' instances and it wraps --- all common connection pool parameters. +-- all common connection pool parameters. And for protocol specific settings +-- this package reuses data types from /streaming-commons/ library. -- --- In example, to specify connection pool with 2 stripes with 8 connections in --- each stripe we can use: +-- As a result, of the above, type signature of function that creates +-- connection pool for some protocol named @MyProtocol@ could look like: -- -- @ --- def & numberOfStripes .~ 2 --- & numberOfResourcesPerStripe .~ 8 +-- createMyProtocolPool +-- :: 'ResourcePoolParams' +-- -> MyProtocolParams +-- -> 'IO' ('ConnectionPool' MyProtocol) -- @ -- --- Functions @&@ and @.~@ are defined by --- package, and 'def' is a --- method of 'Default' type class defined in --- --- package. +-- To further simplify things this package defines default value for +-- 'ResourcePoolParams' using 'Data.Default.Class.Default' type class that has +-- only one method named 'Data.Default.Class.def'. Instance of this class is +-- declared using minimal possible values of each parameter required by +-- underlying resource pool. In example, to specify connection pool with 2 +-- stripes with 8 connections in each stripe, but keeping connection idle +-- timeout on its default value, we can simply use: +-- +-- @ +-- 'Data.Default.Class.def' & 'numberOfStripes' .~ 2 +-- & 'numberOfResourcesPerStripe' .~ 8 +-- @ +-- +-- Where functions @&@ and @.~@ are defined by +-- package. + +-- $resourcePoolParamsLenses +-- +-- For details on how to use leses as these see +-- package where you might find +-- a good starting point documentation for you. + +-- $resourcePoolParamsValidation +-- +-- Sometimes one needs to validate parameters as early as possible, e.g. while +-- parsing command line options. +-- +-- Usage example: +-- +-- @ +-- 'validateResourcePoolParams' $ someParams +-- & 'resourceIdleTimeout' .~ 1 +-- & 'numberOfResourcesPerStripe' .~ 16 +-- @ +-- +-- Most usually one would use 'Data.Default.def' instead of @someParams@. +-- Functions @&@ and @.~@ are defined in +-- package. diff --git a/src/Data/ConnectionPool/Internal/ConnectionPool.hs b/src/Data/ConnectionPool/Internal/ConnectionPool.hs --- a/src/Data/ConnectionPool/Internal/ConnectionPool.hs +++ b/src/Data/ConnectionPool/Internal/ConnectionPool.hs @@ -28,6 +28,7 @@ module Data.ConnectionPool.Internal.ConnectionPool ( ConnectionPool(ConnectionPool) , createConnectionPool + , destroyAllConnections , withConnection ) where @@ -42,7 +43,11 @@ import Network.Socket (Socket) import Data.Pool (Pool) -import Data.Pool as Pool (createPool, withResource) +import qualified Data.Pool as Pool + ( createPool + , destroyAllResources + , withResource + ) import Data.ConnectionPool.Internal.ResourcePoolParams (ResourcePoolParams) import qualified Data.ConnectionPool.Internal.ResourcePoolParams @@ -86,3 +91,13 @@ -> m r withConnection (ConnectionPool pool) f = Pool.withResource pool (uncurry f) + +-- | Destroy all connections that might be still open in a connection pool. +-- This is useful when one needs to release all resources at once and not to +-- wait for idle timeout to be reached. +-- +-- For more details see 'Pool.destroyAllResources'. +-- +-- /Since version 0.1.1.0./ +destroyAllConnections :: ConnectionPool a -> IO () +destroyAllConnections (ConnectionPool pool) = Pool.destroyAllResources pool diff --git a/src/Data/ConnectionPool/Internal/ResourcePoolParams.hs b/src/Data/ConnectionPool/Internal/ResourcePoolParams.hs --- a/src/Data/ConnectionPool/Internal/ResourcePoolParams.hs +++ b/src/Data/ConnectionPool/Internal/ResourcePoolParams.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module: $HEADER$ -- Description: Resource pool construction parameters. @@ -8,7 +9,8 @@ -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: non-portable (NoImplicitPrelude, DeriveDataTypeable) +-- Portability: non-portable (DeriveDataTypeable, NoImplicitPrelude, +-- RecordWildCards) -- -- Internal packages are here to provide access to internal definitions for -- library writers, but they should not be used in application code. @@ -21,7 +23,7 @@ -- Surprisingly this module doesn't depend on -- -- package and it would be good if it stayed that way, but not at the cost of --- cripling functionality. +-- crippling functionality. -- -- Importantly this package should not depend on -- @@ -37,14 +39,24 @@ , numberOfResourcesPerStripe , numberOfStripes , resourceIdleTimeout + + -- ** Validation + , validateResourcePoolParams ) where +import Control.Monad (Monad(return)) +import Data.Bool (otherwise) import Data.Data (Data) +import Data.Either (Either(Left, Right)) +import Data.Function (($)) import Data.Functor (Functor) import Data.Int (Int) +import Data.List ((++)) +import Data.Ord (Ord((<))) import Data.Typeable (Typeable) -import Text.Show (Show) +import Text.Show (Show(show)) +import Data.String (String) import Data.Time.Clock (NominalDiffTime) @@ -99,3 +111,39 @@ -> ResourcePoolParams -> f ResourcePoolParams numberOfResourcesPerStripe = _numberOfResourcesPerStripe ~@@^> \s b -> s {_numberOfResourcesPerStripe = b} + +-- | Check if all parameters for underlying resource pool are valid: +-- +-- * @'numberOfStripes' >= 1@ Number of connection sub-pools. Keeping it set +-- to @1@ is good for most applications. +-- +-- * @'numberOfResourcesPerStripe' >= 1@ Maximum number of connections in each +-- stripe. Totally there can be +-- @'numberOfStripes' * 'numberOfResourcesPerStripe'@ +-- open connections simultaneously. +-- +-- * @'resourceIdleTimeout' >= 0.5@ Property specified for how long connection +-- will be kept alive after it is released by back to the pool before it is +-- automatically closed. Value is in seconds. +-- +-- For more details see 'Data.Pool.createPool'. +-- +-- /Since version 0.1.1.0./ +validateResourcePoolParams + :: ResourcePoolParams + -- ^ Parameters to validate. + -> Either String ResourcePoolParams + -- ^ Either error message or the same value of 'ResourcePoolParams' passed + -- as a first argument. +validateResourcePoolParams params'@ResourcePoolParams{..} = do + failIf _numberOfStripes (< 1) + "Stripe count has to be at least 1" + failIf _resourceIdleTimeout (< 0.5) + "Resource idle time has to be at least 0.5" + failIf _numberOfResourcesPerStripe (< 1) + "There has to be at least 1 resource per stripe" + return params' + where + failIf n p msg + | p n = Left $ msg ++ ", but got " ++ show n ++ "." + | otherwise = Right () diff --git a/src/Data/ConnectionPool/Internal/Streaming.hs b/src/Data/ConnectionPool/Internal/Streaming.hs --- a/src/Data/ConnectionPool/Internal/Streaming.hs +++ b/src/Data/ConnectionPool/Internal/Streaming.hs @@ -57,13 +57,21 @@ import Data.Streaming.Network (getSocketFamilyTCP, safeRecv) import Data.Streaming.Network.Internal ( AppData(AppData) +#ifndef WINDOWS + -- Windows doesn't support UNIX Sockets. , AppDataUnix(AppDataUnix) +#endif + -- !WINDOWS , ClientSettings(ClientSettings) ) import qualified Data.Streaming.Network.Internal as AppData (AppData(appLocalAddr', appRead', appSockAddr', appWrite')) +#ifndef WINDOWS + -- Windows doesn't support UNIX Sockets. import qualified Data.Streaming.Network.Internal as AppDataUnix (AppDataUnix(appReadUnix, appWriteUnix)) +#endif + -- !WINDOWS -- | Wrapper for 'runTcpAppImpl' with a type signature that is more natural -- for implementing a TCP specific