diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,19 @@ # ChangeLog / ReleaseNotes +## Version 0.1.3 + +* All lenses are now defined as strict, as a consequence lower bound of + [between][] is now `0.10.0.0` instead of `0.9.0.0`. (change) +* Support for user defined read buffer size, this was introduced in + [streaming-commons][] `== 0.1.13`. Non-internal library API is backwards + compatible. (new) +* Default buffer size changed in [streaming-commons][] `== 0.1.13` to 32kiB, + this library uses this value as a default even if it's built with + [streaming-commons][] `< 0.1.13`. For more details see + . (change) + + ## Version 0.1.2.1 * Builds also with [streaming-commons][] `>0.1.5 && <0.1.14`. Tested up to @@ -41,6 +54,9 @@ +[between]: + http://hackage.haskell.org/package/between + "Function combinator 'between' and derived combinators." [Hackage]: http://hackage.haskell.org/ "HackageDB (or just Hackage) is a collection of releases of Haskell packages." diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -117,7 +117,7 @@ then the first thread acquires connection, blocks on `threadDelay` call, but the other thread also acquires connection and prints its output while the first thread is still blocked on `threadDelay`. This example demonstrates how -connection pool behaves if it reached its capacity and when it has onough free +connection pool behaves if it reached its capacity and when it has enough free resources. diff --git a/connection-pool.cabal b/connection-pool.cabal --- a/connection-pool.cabal +++ b/connection-pool.cabal @@ -1,5 +1,5 @@ name: connection-pool -version: 0.1.2.1 +version: 0.1.3 synopsis: Connection pool built on top of resource-pool and streaming-commons. description: @@ -37,8 +37,7 @@ , example/*.hs flag pedantic - description: - Pass additional warning flags including to GHC during compilation. + description: Pass additional warning flags to GHC during compilation. default: False manual: True @@ -48,6 +47,7 @@ Data.ConnectionPool , Data.ConnectionPool.Internal.ConnectionPool , Data.ConnectionPool.Internal.ConnectionPoolFamily + , Data.ConnectionPool.Internal.HandlerParams , Data.ConnectionPool.Internal.ResourcePoolParams , Data.ConnectionPool.Internal.Streaming @@ -56,6 +56,7 @@ CPP , DeriveDataTypeable , FlexibleContexts + , NamedFieldPuns , NoImplicitPrelude , OverloadedStrings , RecordWildCards @@ -75,7 +76,8 @@ -- }}} Packages distributed with HaskellPlatform (or GHC itself) ---------- -- {{{ Other packages ----------------------------------------------------- - , between >= 0.9.0.0 + , between >= 0.10.0.0 + -- ^ This package uses strict API which was introduced in version 0.10.0.0. , data-default-class == 0.0.* , monad-control >= 0.2.0.1 -- Version boundary same as resource-pool (version 0.2.0.0) has. @@ -120,4 +122,4 @@ source-repository this type: git location: git://github.com/trskop/connection-pool.git - tag: v0.1.2.1 + tag: v0.1.3 diff --git a/src/Data/ConnectionPool.hs b/src/Data/ConnectionPool.hs --- a/src/Data/ConnectionPool.hs +++ b/src/Data/ConnectionPool.hs @@ -5,7 +5,7 @@ -- | -- Module: $HEADER$ -- Description: Connection pools for various transport protocols. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com @@ -135,9 +135,11 @@ ) import qualified Data.ConnectionPool.Internal.Streaming as Internal ( acquireTcpClientConnection + , fromClientSettings , runTcpApp #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. + , fromClientSettingsUnix , runUnixApp #endif -- !WINDOWS @@ -150,10 +152,11 @@ -> ClientSettings -> IO (ConnectionPool TcpClient) createTcpClientPool poolParams tcpParams = Internal.TcpConnectionPool - <$> Internal.createConnectionPool acquire release poolParams + <$> Internal.createConnectionPool handlerParams acquire release poolParams where acquire = Internal.acquireTcpClientConnection tcpParams release = Socket.sClose + handlerParams = Internal.fromClientSettings tcpParams -- | Temporarily take a TCP connection from a pool, run client with it, and -- return it to the pool afterwards. For details how connections are allocated @@ -188,10 +191,11 @@ -> ClientSettingsUnix -> IO (ConnectionPool UnixClient) createUnixClientPool poolParams unixParams = Internal.UnixConnectionPool - <$> Internal.createConnectionPool acquire release poolParams + <$> Internal.createConnectionPool handlerParams acquire release poolParams where acquire = (, ()) <$> getSocketUnix (getPath unixParams) release = Socket.sClose + handlerParams = Internal.fromClientSettingsUnix unixParams -- | Temporarily take a UNIX Sockets connection from a pool, run client with -- it, and return it to the pool afterwards. For details how connections are @@ -300,7 +304,7 @@ -- @threadDelay@ call, but the other thread also acquires connection and prints -- its output while the first thread is still blocked on @threadDelay@. This -- example demonstrates how connection pool behaves if it reached its capacity --- and when it has onough free resources. +-- and when it has enough free resources. -- $unixClientExample -- 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 @@ -1,16 +1,18 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module: $HEADER$ -- Description: ConnectionPool data type which is a specialized Pool wrapper. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: non-portable (DeriveDataTypeable, FlexibleContexts, --- NoImplicitPrelude) +-- Portability: DeriveDataTypeable, FlexibleContexts, NamedFieldPuns, +-- NoImplicitPrelude, RecordWildCards -- -- Internal packages are here to provide access to internal definitions for -- library writers, but they should not be used in application code. @@ -26,22 +28,26 @@ -- notable thing is that this package is not OS specific. Please, bear this in -- mind when doing modifications. module Data.ConnectionPool.Internal.ConnectionPool - ( ConnectionPool(ConnectionPool) + ( ConnectionPool(ConnectionPool, _handlerParams, _resourcePool) + , resourcePool + , handlerParams , createConnectionPool , destroyAllConnections , withConnection ) where -import Control.Applicative ((<$>)) import Data.Function ((.)) +import Data.Functor (Functor, (<$>)) import Data.Tuple (fst, uncurry) import Data.Typeable (Typeable) import System.IO (IO) +import Text.Show (Show(showsPrec), showChar, shows, showString) import Control.Monad.Trans.Control (MonadBaseControl) import Network.Socket (Socket) +import Data.Function.Between.Strict ((~@@^>)) import Data.Pool (Pool) import qualified Data.Pool as Pool ( createPool @@ -55,13 +61,36 @@ -- | Simple specialized wrapper for 'Pool'. -newtype ConnectionPool a = ConnectionPool (Pool (Socket, a)) +data ConnectionPool handlerParams a = ConnectionPool + { _resourcePool :: !(Pool (Socket, a)) + , _handlerParams :: !handlerParams + } deriving (Typeable) +-- | @since 0.1.3 +instance Show handlerParams => Show (ConnectionPool handlerParams a) where + showsPrec _ ConnectionPool{..} = + showString "ConnectionPool {resourcePool = " . shows _resourcePool + . showString ", handlerParams = " . shows _handlerParams . showChar '}' + +resourcePool + :: Functor f + => (Pool (Socket, a) -> f (Pool (Socket, b))) + -> ConnectionPool handlerParams a -> f (ConnectionPool handlerParams b) +resourcePool = _resourcePool ~@@^> \s b -> s{_resourcePool = b} + +handlerParams + :: Functor f + => (handlerParams -> f handlerParams') + -> ConnectionPool handlerParams c -> f (ConnectionPool handlerParams' c) +handlerParams = _handlerParams ~@@^> \s b -> s{_handlerParams = b} + -- | Specialized wrapper for 'Pool.createPool', see its documentation for -- details. createConnectionPool - :: IO (Socket, a) + :: handlerParams + -- ^ Data type passed down to individual connection handlers. + -> IO (Socket, a) -- ^ Acquire a connection which is represented by a 'Socket'. There might -- be additional information associated with specific connection that we -- pass as a sencond value in a tuple. Such information are considered read @@ -71,25 +100,30 @@ -> ResourcePoolParams -- ^ Data type representing all 'Pool.createPool' parameters that describe -- internal 'Pool' parameters. - -> IO (ConnectionPool a) + -> IO (ConnectionPool handlerParams a) -- ^ Created connection pool that is parametrised by additional connection -- details. -createConnectionPool acquire release params = - ConnectionPool <$> Pool.createPool +createConnectionPool hParams acquire release params = + mkConnectionPool <$> Pool.createPool acquire (release . fst) (ResourcePoolParams._numberOfStripes params) (ResourcePoolParams._resourceIdleTimeout params) (ResourcePoolParams._numberOfResourcesPerStripe params) + where + mkConnectionPool pool = ConnectionPool + { _resourcePool = pool + , _handlerParams = hParams + } -- | Specialized wrapper for 'Pool.withResource'. withConnection :: MonadBaseControl IO m - => ConnectionPool a - -> (Socket -> a -> m r) + => ConnectionPool c a + -> (c -> Socket -> a -> m r) -> m r -withConnection (ConnectionPool pool) f = - Pool.withResource pool (uncurry f) +withConnection ConnectionPool{..} f = + Pool.withResource _resourcePool (uncurry (f _handlerParams)) -- | 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 @@ -98,5 +132,6 @@ -- For more details see 'Pool.destroyAllResources'. -- -- /Since version 0.1.1.0./ -destroyAllConnections :: ConnectionPool a -> IO () -destroyAllConnections (ConnectionPool pool) = Pool.destroyAllResources pool +destroyAllConnections :: ConnectionPool handlerParams a -> IO () +destroyAllConnections ConnectionPool{_resourcePool} = + Pool.destroyAllResources _resourcePool diff --git a/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs b/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs --- a/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs +++ b/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs @@ -8,13 +8,13 @@ -- | -- Module: $HEADER$ -- Description: Family of connection pools specialized by transport protocol. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: non-portable (CPP, DeriveDataTypeable, StandaloneDeriving, --- NoImplicitPrelude, TypeFamilies) +-- Portability: CPP, DeriveDataTypeable, StandaloneDeriving, +-- NoImplicitPrelude, TypeFamilies -- -- Module defines type family of connection pools that is later specialised -- using type tags (phantom types) to specialize implementation of underlying @@ -31,8 +31,9 @@ -- This module doesn't depend on -- and -- other non-HaskellPlatform packages directly and it is only allowed to import --- "Data.ConnectionPool.Internal.ConnectionPool" internal module and nothing --- else from this module. This package uses CPP to get OS specific things +-- "Data.ConnectionPool.Internal.ConnectionPool" and +-- "Data.ConnectionPool.Internal.HandlerParams" internal module and nothing +-- else from this package. This package uses CPP to get OS specific things -- right. Most importantly Windows doesn't support UNIX Sockets. -- -- Please, bear above in mind when doing modifications. @@ -57,7 +58,8 @@ import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal (ConnectionPool) - +import qualified Data.ConnectionPool.Internal.HandlerParams as Internal + (HandlerParams) -- | Family of connection pools parametrised by transport protocol. data family ConnectionPool :: * -> * @@ -72,7 +74,7 @@ -- | Connection pool for TCP clients. newtype instance ConnectionPool TcpClient = - TcpConnectionPool (Internal.ConnectionPool SockAddr) + TcpConnectionPool (Internal.ConnectionPool Internal.HandlerParams SockAddr) #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -83,6 +85,6 @@ -- | Connection pool for UNIX Socket clients. newtype instance ConnectionPool UnixClient = - UnixConnectionPool (Internal.ConnectionPool ()) + UnixConnectionPool (Internal.ConnectionPool Internal.HandlerParams ()) #endif -- !WINDOWS diff --git a/src/Data/ConnectionPool/Internal/HandlerParams.hs b/src/Data/ConnectionPool/Internal/HandlerParams.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionPool/Internal/HandlerParams.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: HandlerParams data type which is passed to individual +-- connection. +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Maintainer: peter.trsko@gmail.com +-- Stability: unstable (internal module) +-- Portability: DeriveDataTypeable, NamedFieldPuns, NoImplicitPrelude, +-- RecordWildCards +-- +-- Internal packages are here to provide access to internal definitions for +-- library writers, but they should not be used in application code. +-- +-- Preferably use qualified import, e.g.: +-- +-- > import qualified Data.ConnectionPool.Internal.HandlerParams as Internal +-- +-- This module doesn't depend on +-- +-- and other non-HaskellPlatform packages with notable exception of +-- . Another +-- notable thing is that this package is not OS specific. Please, bear this in +-- mind when doing modifications. +module Data.ConnectionPool.Internal.HandlerParams + ( HandlerParams(HandlerParams, _readBufferSize) + , readBufferSize + ) + where + +import Data.Data (Data, Typeable) +import Data.Functor (Functor) +import Data.Int (Int) +import GHC.Generics (Generic) +import Text.Show (Show) + +import Data.Default.Class (Default(def)) +import Data.Function.Between.Strict ((~@@^>)) + + +data HandlerParams = HandlerParams + { _readBufferSize :: !Int + -- ^ See 'readBufferSize' for details. + } + deriving (Data, Generic, Show, Typeable) + +-- | @ +-- 'readBufferSize' = 32768 +-- @ +-- +-- Package streaming-commons < 0.1.13 used value 4096, +-- streaming-commons == 0.1.13 used 32768, which is 8 * 4096, +-- based on: +instance Default HandlerParams where + def = HandlerParams + { _readBufferSize = 32768 + } + +-- | Lens for accessing read buffer size that handler should use when reading +-- data from connection. +readBufferSize + :: Functor f => (Int -> f Int) -> HandlerParams -> f HandlerParams +readBufferSize = _readBufferSize ~@@^> \s b -> s{_readBufferSize = b} 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 @@ -4,13 +4,12 @@ -- | -- Module: $HEADER$ -- Description: Resource pool construction parameters. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014, Peter Trško -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: non-portable (DeriveDataTypeable, NoImplicitPrelude, --- RecordWildCards) +-- Portability: 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. @@ -54,14 +53,14 @@ import Data.Int (Int) import Data.List ((++)) import Data.Ord (Ord((<))) +import Data.String (String) import Data.Typeable (Typeable) import Text.Show (Show(show)) -import Data.String (String) import Data.Time.Clock (NominalDiffTime) import Data.Default.Class (Default(def)) -import Data.Function.Between ((~@@^>)) +import Data.Function.Between.Strict ((~@@^>)) -- | Parameters of resource pool that describe things like its internal @@ -74,9 +73,9 @@ deriving (Data, Show, Typeable) -- | @ --- numberOfStripes = 1 --- resourceIdleTimeout = 0.5 --- numberOfResourcesPerStripe = 1 +-- 'numberOfStripes' = 1 +-- 'resourceIdleTimeout' = 0.5 +-- 'numberOfResourcesPerStripe' = 1 -- @ instance Default ResourcePoolParams where def = ResourcePoolParams 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 @@ -9,7 +9,7 @@ -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: non-portable (CPP, FlexibleContexts, NoImplicitPrelude) +-- Portability: CPP, FlexibleContexts, NoImplicitPrelude -- -- Module defines helper functions that would be ideally provided by -- @@ -24,9 +24,10 @@ -- -- This module doesn't neither depend on -- package nor --- any other module of this package, and it shoud stay that way. This module --- uses CPP to get OS specific things right. Most importantly Windows doesn't --- support UNIX Sockets. +-- any other module of this package, with notable exception of +-- "Data.ConnectionPool.Internal.HandlerParams", and it shoud stay that way. +-- This module uses CPP to get OS specific things right. Most importantly +-- Windows doesn't support UNIX Sockets. -- -- Please, bear above in mind when doing modifications. module Data.ConnectionPool.Internal.Streaming @@ -35,6 +36,7 @@ acquireTcpClientConnection , runTcpApp , runTcpAppImpl + , fromClientSettings #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -42,11 +44,13 @@ -- * Unix Socket , runUnixApp , runUnixAppImpl + , fromClientSettingsUnix #endif -- !WINDOWS ) where +import Data.Int (Int) import Data.Maybe (Maybe(Just)) import System.IO (IO) @@ -54,15 +58,31 @@ import Network.Socket (Socket, SockAddr, sClose) import Network.Socket.ByteString (sendAll) -import Data.Streaming.Network (getSocketFamilyTCP, safeRecv) +import Data.Default.Class (Default(def)) +import Data.Streaming.Network + ( getSocketFamilyTCP + , safeRecv +#if MIN_VERSION_streaming_commons(0,1,13) + -- Until streaming-commons 0.1.13, read buffer size was fixed. + , getReadBufferSize +#endif + ) import Data.Streaming.Network.Internal ( AppData(AppData) + , ClientSettings(clientPort, clientHost, clientAddrFamily) #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. , AppDataUnix(AppDataUnix) +#if MIN_VERSION_streaming_commons(0,1,13) + -- Until streaming-commons 0.1.13, read buffer size was fixed. For some + -- mistifying reason there is no + -- + -- instance HasReadBufferSize ClientSettingsUnix". + , ClientSettingsUnix(clientReadBufferSizeUnix) #endif + -- streaming-commons >= 0.1.13 +#endif -- !WINDOWS - , ClientSettings(clientPort, clientHost, clientAddrFamily) ) import qualified Data.Streaming.Network.Internal as AppData ( AppData @@ -78,6 +98,10 @@ #endif )) +import Data.ConnectionPool.Internal.HandlerParams + ( HandlerParams(_readBufferSize) + ) + #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. import qualified Data.Streaming.Network.Internal as AppDataUnix @@ -92,10 +116,14 @@ :: MonadBaseControl IO m => Maybe SockAddr -> (AppData -> m r) + -> HandlerParams -> Socket -> SockAddr -> m r -runTcpApp localAddr app sock addr = runTcpAppImpl localAddr sock addr app +runTcpApp localAddr app params sock addr = + runTcpAppImpl localAddr sock addr bufSize app + where + bufSize = _readBufferSize params -- | Simplified 'Data.Streaming.Network.runTCPClient' and -- 'Data.Streaming.Network.runTCPServer' that provides only construction of @@ -105,10 +133,11 @@ => Maybe SockAddr -> Socket -> SockAddr + -> Int -> (AppData -> m r) -> m r -runTcpAppImpl localAddr sock addr app = app AppData - { AppData.appRead' = safeRecv sock 4096 -- :: !(IO ByteString) +runTcpAppImpl localAddr sock addr bufSize app = app AppData + { AppData.appRead' = safeRecv sock bufSize -- :: !(IO ByteString) , AppData.appWrite' = sendAll sock -- :: !(ByteString -> IO ()) , AppData.appSockAddr' = addr -- :: !SockAddr , AppData.appLocalAddr' = localAddr -- :: !(Maybe SockAddr) @@ -129,6 +158,14 @@ host = clientHost settings addrFamily = clientAddrFamily settings +fromClientSettings :: ClientSettings -> HandlerParams +fromClientSettings _tcpParams = def +#if MIN_VERSION_streaming_commons(0,1,13) + -- Until streaming-commons 0.1.13, read buffer size was fixed. + { _readBufferSize = getReadBufferSize _tcpParams + } +#endif + #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -138,10 +175,13 @@ runUnixApp :: MonadBaseControl IO m => (AppDataUnix -> m r) + -> HandlerParams -> Socket -> () -> m r -runUnixApp app sock () = runUnixAppImpl sock app +runUnixApp app params sock () = runUnixAppImpl sock bufSize app + where + bufSize = _readBufferSize params -- | Simplified 'Data.Streaming.Network.runUnixClient' and -- 'Data.Streaming.Network.runUnixServer' that provides only construction of @@ -149,11 +189,21 @@ runUnixAppImpl :: MonadBaseControl IO m => Socket + -> Int -> (AppDataUnix -> m r) -> m r -runUnixAppImpl sock app = app AppDataUnix - { AppDataUnix.appReadUnix = safeRecv sock 4096 +runUnixAppImpl sock bufSize app = app AppDataUnix + { AppDataUnix.appReadUnix = safeRecv sock bufSize , AppDataUnix.appWriteUnix = sendAll sock } + +fromClientSettingsUnix :: ClientSettingsUnix -> HandlerParams +fromClientSettingsUnix _unixParams = def +#if MIN_VERSION_streaming_commons(0,1,13) + -- Until streaming-commons 0.1.13, read buffer size was fixed. + { _readBufferSize = clientReadBufferSizeUnix _unixParams + } +#endif + -- streaming-commons >= 0.1.13 #endif -- !WINDOWS