connection-pool 0.1.2.1 → 0.1.3

raw patch · 9 files changed

+230/−54 lines, 9 filesdep ~betweenPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: between

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• README.md +1/−1
• connection-pool.cabal +7/−5
• src/Data/ConnectionPool.hs +8/−4
• src/Data/ConnectionPool/Internal/ConnectionPool.hs +51/−16
• src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs +10/−8
• src/Data/ConnectionPool/Internal/HandlerParams.hs +68/−0
• src/Data/ConnectionPool/Internal/ResourcePoolParams.hs +7/−8
• src/Data/ConnectionPool/Internal/Streaming.hs +62/−12

@@ -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+  <https://github.com/fpco/streaming-commons/issues/22>. (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."

@@ -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.  

@@ -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

@@ -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 --

@@ -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

@@ -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 -- <http://hackage.haskell.org/package/streaming-commons streaming-commons> 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

@@ -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+-- <http://hackage.haskell.org/package/streaming-commons streaming-commons>+-- and other non-HaskellPlatform packages with notable exception of+-- <http://hackage.haskell.org/package/resource-pool resource-pool>. 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: <https://github.com/fpco/streaming-commons/issues/22 issue #22>+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}

@@ -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

@@ -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 -- <http://hackage.haskell.org/package/streaming-commons streaming-commons>@@ -24,9 +24,10 @@ -- -- This module doesn't neither depend on -- <http://hackage.haskell.org/package/resource-pool resource-pool> 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