diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,45 +1,77 @@ # ChangeLog / ReleaseNotes +## Version 0.2 + +* Release has backward compatible API with 0.1 branch. +* Introducing `ConnectionPoolFor` type class which has instances for both + `ConnectionPool TcpClient` and `ConnectionPool UnixClient`. Class is located + in its own module `Data.ConnectionPool.Class`, therefore it is part of stable + API. It provides `withConnection` and `destroyAllConnections` methods which + can be used instead of their more specific equivalents. (**new**) +* `ConnectionPool` data family moved in to its own module + `Data.ConnectionPool.Family`, as a consequence it became part of stable API. + (**change**) +* Introducing `tryWithUnixClientConnection` and `tryWithTcpClientConnection` + functions. (**new**) +* Providing instances of `Generic` and `Show` where ever possible and + reasonable. This is a backwards compatible change. (**new**) +* Internal `ConnectionPool` data type is now more generic because `Socket` + handle isn't hard-coded in it any more. This change breaks packages depending + on internal API. (**change**) +* Internal type class `HasConnectionPool` was introduced to simplify access to + `ConnectionPool` data type wrapped in other types. (**new**) +* Internal modules were heavily reorganized and TCP and UNIX Sockets related + implementations were moved in to their own modules. This change breaks + packages depending on internal API. (**change**) +* Heavy inlining of everything. Purpose is to be safe that this library gets + abstracted away as much as possible. Best result is if only direct references + to resource-pool and streaming-commons remain. (**change**) +* Uploaded to [Hackage][]: + + + ## 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) + [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) + 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) + . (**change**) +* Uploaded to [Hackage][]: + ## Version 0.1.2.1 * Builds also with [streaming-commons][] `>0.1.5 && <0.1.14`. Tested up to [streaming-commons][] version 0.1.13. See also issue #1 - (new) + (**bugfix**) * Uploaded to [Hackage][]: ## Version 0.1.2.0 -* Builds with GHC 7.10 and base 4.8. (new) +* Builds with GHC 7.10 and base 4.8. (**new**) * Builds also with [streaming-commons][] `>0.1.5 && <0.1.13`. Tested up to - [streaming-commons][] version 0.1.12.1. (new) + [streaming-commons][] version 0.1.12.1. (**new**) * Uploaded to [Hackage][]: ## Version 0.1.1.0 -* Package is now buildable on Windows. (new) -* Introducing function `validateResourcePoolParams`. (new) -* Introducing internal function `destroyAllConnections`. (new) +* 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) + `destroyAllConnections`. (**new**) * Corrected some typos in documentation and Haddock markup. * Small documentation enhancements. * Uploaded to [Hackage][]: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,6 +19,8 @@ 1. pool for TCP client connections, 2. and pool for UNIX Sockets client connections. +In addition it can be used to build your own connection pool using provided primitives. + 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 @@ -50,8 +52,14 @@ module Main (main) where -import Control.Monad (void) -import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent + ( forkIO + , newEmptyMVar + , putMVar + , readMVar + , threadDelay + ) +import Control.Monad (void, mapM_) import System.Environment (getArgs) import Control.Lens ((.~), (&)) @@ -71,11 +79,16 @@ pool <- createTcpClientPool (poolParams numStripes numPerStripe) (clientSettingsTCP (read port) "127.0.0.1") + thread1 <- newEmptyMVar + thread2 <- newEmptyMVar void . forkIO . withTcpClientConnection pool $ \appData -> do - threadDelay 100 - appWrite appData "1: I'm alive!\n" - void . forkIO . withTcpClientConnection pool $ \appData -> - appWrite appData "2: I'm alive!\n" + threadDelay 1000 + appWrite appData "1: I'm alive!\n" + putMVar thread1 () + void . forkIO . withTcpClientConnection pool $ \appData -> do + appWrite appData "2: I'm alive!\n" + putMVar thread2 () + mapM_ readMVar [thread1, thread2] where poolParams m n = def & numberOfStripes .~ read m @@ -109,7 +122,7 @@ 2: I'm alive! 1: I'm alive! -The reason for this is that we use `threadDelay 100` in the first executed +The reason for this is that we use `threadDelay 1000` in the first executed thread. So when we have only one stripe and one connection per stripe, then we have only one connection in the pool. Therefore when the first thread executes and acquires a connection, then all the other threads (the other one in above 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.3 +version: 0.2 synopsis: Connection pool built on top of resource-pool and streaming-commons. description: @@ -10,6 +10,9 @@ . 2. and pool for UNIX Sockets client connections. . + In addition it can be used to build your own connection pool using provided + primitives. + . This package is built on top of and . @@ -45,16 +48,22 @@ hs-source-dirs: src exposed-modules: Data.ConnectionPool + , Data.ConnectionPool.Class + , Data.ConnectionPool.Family , Data.ConnectionPool.Internal.ConnectionPool - , Data.ConnectionPool.Internal.ConnectionPoolFamily , Data.ConnectionPool.Internal.HandlerParams , Data.ConnectionPool.Internal.ResourcePoolParams , Data.ConnectionPool.Internal.Streaming + , Data.ConnectionPool.Internal.TCP + if !os(windows) + exposed-modules: Data.ConnectionPool.Internal.Unix + default-language: Haskell2010 other-extensions: CPP , DeriveDataTypeable + , DeriveGeneric , FlexibleContexts , NamedFieldPuns , NoImplicitPrelude @@ -79,11 +88,15 @@ , 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. + , monad-control >= 0.3 + -- Package resource-pool depends on monad-control >=0.2.0.1 since + -- resource-pool version 0.2.0.0, but this package doesn't make the + -- effort to handle changes in monad-control API and therefore it limits + -- its dependencies to >=0.3. , resource-pool >= 0.2.0.0 && < 1 - -- Version 0.2.0.0 was the first that used monad-control package. - -- At the time of writing (version 0.2.3.0) used subset of API is stable. + -- Version 0.2.0.0 of resource-pool was the first that used monad-control + -- package. At the time of writing (version 0.2.3.0) used subset of API + -- is stable. , streaming-commons >= 0.1.3 && < 0.2 -- First version that had getSocketFamilyTCP function and also Earlier -- versions have different definition of ClientSettings. Those two things @@ -95,6 +108,10 @@ -- * Version 0.1.12 introduced appRawSocket' field of AppData. -- * Version 0.1.13 extended ClientSettings with clientReadBufferSize -- field and ClientSettingsUnix with clientReadBufferSizeUnix field. + -- See https://github.com/fpco/streaming-commons/pull/23 for details. + -- * Version 0.1.14 exports HasReadBufferSize type class and it also has + -- instance for ClientSettingsUnix. See + -- https://github.com/fpco/streaming-commons/pull/24 for details. , transformers-base >= 0.4.2 && < 0.5 -- Version bounds taken from latest monad-control package (at the moment -- 0.3.3.0), which is a dependency of resource-pool package. @@ -106,8 +123,17 @@ if impl(ghc >= 7.8.1) cpp-options: -DKIND_POLYMORPHIC_TYPEABLE + if impl(ghc >= 7.10) + -- To be able to use poly-kinded ConnectionPool data family we need two + -- things (i) poly-kinded Typeable class and (ii) compiler that is capable + -- of deriving Typeable instance for poly-kinded data family. Otherwise we + -- would break backward compatibility by not providing Typeable instance. + -- Both of these work on GHC only since version 7.10. + cpp-options: -DKIND_POLYMORPHIC_TYPEABLE_POLYKINDED_DATA_FAMILIES + ghc-options: -Wall if impl(ghc >= 6.8) + -- Newer GHC versions include -fwarn-tabs in -Wall. ghc-options: -fwarn-tabs if flag(pedantic) ghc-options: @@ -122,4 +148,4 @@ source-repository this type: git location: git://github.com/trskop/connection-pool.git - tag: v0.1.3 + tag: v0.2 diff --git a/example/tcp.hs b/example/tcp.hs --- a/example/tcp.hs +++ b/example/tcp.hs @@ -2,13 +2,19 @@ -- | -- Module: Main -- Description: UNIX Sockets client example. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 module Main (main) where -import Control.Monad (void) -import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent + ( forkIO + , newEmptyMVar + , putMVar + , readMVar + , threadDelay + ) +import Control.Monad (void, mapM_) import System.Environment (getArgs) import Control.Lens ((.~), (&)) @@ -28,11 +34,16 @@ pool <- createTcpClientPool (poolParams numStripes numPerStripe) (clientSettingsTCP (read port) "127.0.0.1") + thread1 <- newEmptyMVar + thread2 <- newEmptyMVar void . forkIO . withTcpClientConnection pool $ \appData -> do - threadDelay 100 - appWrite appData "1: I'm alive!\n" - void . forkIO . withTcpClientConnection pool $ \appData -> - appWrite appData "2: I'm alive!\n" + threadDelay 1000 + appWrite appData "1: I'm alive!\n" + putMVar thread1 () + void . forkIO . withTcpClientConnection pool $ \appData -> do + appWrite appData "2: I'm alive!\n" + putMVar thread2 () + mapM_ readMVar [thread1, thread2] where poolParams m n = def & numberOfStripes .~ read m diff --git a/example/unix-sockets.hs b/example/unix-sockets.hs --- a/example/unix-sockets.hs +++ b/example/unix-sockets.hs @@ -2,13 +2,19 @@ -- | -- Module: Main -- Description: UNIX Sockets client example. --- Copyright: (c) 2014 Peter Trsko +-- Copyright: (c) 2014-2015, Peter Trško -- License: BSD3 module Main (main) where -import Control.Concurrent (forkIO, threadDelay) -import Control.Monad (void) +import Control.Concurrent + ( forkIO + , newEmptyMVar + , putMVar + , readMVar + , threadDelay + ) +import Control.Monad (void, mapM_) import System.Environment (getArgs) import Control.Lens ((.~), (&)) @@ -28,11 +34,16 @@ pool <- createUnixClientPool (poolParams numStripes numPerStripe) (clientSettingsUnix socket) + thread1 <- newEmptyMVar + thread2 <- newEmptyMVar void . forkIO . withUnixClientConnection pool $ \appData -> do - threadDelay 100 - appWrite appData "1: I'm alive!\n" - void . forkIO . withUnixClientConnection pool $ \appData -> - appWrite appData "2: I'm alive!\n" + threadDelay 1000 + appWrite appData "1: I'm alive!\n" + putMVar thread1 () + void . forkIO . withUnixClientConnection pool $ \appData -> do + appWrite appData "2: I'm alive!\n" + putMVar thread2 () + mapM_ readMVar [thread1, thread2] where poolParams m n = def & numberOfStripes .~ read m diff --git a/src/Data/ConnectionPool.hs b/src/Data/ConnectionPool.hs --- a/src/Data/ConnectionPool.hs +++ b/src/Data/ConnectionPool.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TupleSections #-} -- | -- Module: $HEADER$ -- Description: Connection pools for various transport protocols. @@ -10,24 +8,25 @@ -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable --- Portability: non-portable (CPP, FlexibleContexts, NoImplicitPrelude, --- TupleSections) +-- Portability: CPP, NoImplicitPrelude -- --- Connection pools for TCP clients and UNIX Socket clients (not supported on --- Windows). +-- Connection pools for TCP clients and UNIX Socket clients, later is not +-- supported on Windows. -- -- This package is built on top of -- and -- -- packages. The later allows us to use --- package --- for implementing TCP and UNIX Sockets clients. Package /conduit-extra/ --- defines @appSource@ and @appSink@ based on abstractions from --- /streaming-commons/ package and they can be therefore reused. Difference --- between using /conduit-extra/ or /streaming-commons/ is that instead of --- using @runTCPClient@ (or its lifted variant @runGeneralTCPClient@ from +-- package for +-- implementing TCP and UNIX Sockets clients. Package /conduit-extra/ defines +-- @appSource@ and @appSink@ based on abstractions from /streaming-commons/ +-- package and they can be therefore reused. Difference between using +-- /conduit-extra/ or /streaming-commons/ is that instead of using +-- @runTCPClient@ (or its lifted variant @runGeneralTCPClient@ from -- /conduit-extra/) one would use 'withTcpClientConnection', and instead of --- @runUnixClient@ it would be 'withUnixClientConnection'. +-- @runUnixClient@ it would be 'withUnixClientConnection'. There is also more +-- generic function named 'withConnection', which takes either 'ConnectionPool' +-- instance. module Data.ConnectionPool ( -- * TCP Client Example @@ -71,6 +70,7 @@ , AppData , createTcpClientPool , withTcpClientConnection + , tryWithTcpClientConnection , destroyAllTcpClientConnections #ifndef WINDOWS @@ -82,50 +82,31 @@ , AppDataUnix , createUnixClientPool , withUnixClientConnection + , tryWithUnixClientConnection , destroyAllUnixClientConnections #endif -- !WINDOWS + + -- * Polymorphic Interface + -- + -- | /Since version 0.2./ + , ConnectionPoolFor(..) ) where -import Control.Applicative ((<$>)) -import Data.Function ((.)) -import Data.Maybe (Maybe(Nothing)) -import System.IO (IO) - -import qualified Network.Socket as Socket (sClose) - -import Control.Monad.Trans.Control (MonadBaseControl) import Data.Streaming.Network ( AppData , ClientSettings #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. - , AppDataUnix , ClientSettingsUnix - , getPath - , getSocketUnix + , AppDataUnix #endif -- !WINDOWS ) -import Data.ConnectionPool.Internal.ConnectionPoolFamily - ( ConnectionPool - , TcpClient -#ifndef WINDOWS - -- Windows doesn't support UNIX Sockets. - , UnixClient -#endif - -- !WINDOWS - ) -import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal - ( createConnectionPool - , withConnection - , destroyAllConnections - ) -import qualified Data.ConnectionPool.Internal.ConnectionPoolFamily as Internal - ( ConnectionPool(..) - ) +import Data.ConnectionPool.Class (ConnectionPoolFor(..)) +import Data.ConnectionPool.Family (ConnectionPool) import Data.ConnectionPool.Internal.ResourcePoolParams ( ResourcePoolParams , numberOfResourcesPerStripe @@ -133,96 +114,26 @@ , resourceIdleTimeout , validateResourcePoolParams ) -import qualified Data.ConnectionPool.Internal.Streaming as Internal - ( acquireTcpClientConnection - , fromClientSettings - , runTcpApp +import Data.ConnectionPool.Internal.TCP + ( TcpClient + , createTcpClientPool + , destroyAllTcpClientConnections + , tryWithTcpClientConnection + , withTcpClientConnection + ) #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. - , fromClientSettingsUnix - , runUnixApp -#endif - -- !WINDOWS +import Data.ConnectionPool.Internal.Unix + ( UnixClient + , createUnixClientPool + , destroyAllUnixClientConnections + , tryWithUnixClientConnection + , withUnixClientConnection ) - - --- | Create connection pool for TCP clients. -createTcpClientPool - :: ResourcePoolParams - -> ClientSettings - -> IO (ConnectionPool TcpClient) -createTcpClientPool poolParams tcpParams = Internal.TcpConnectionPool - <$> 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 --- see 'Data.Pool.withResource'. -withTcpClientConnection - :: MonadBaseControl IO m - => ConnectionPool TcpClient - -> (AppData -> m r) - -> m r -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. - --- | Create connection pool for UNIX Sockets clients. -createUnixClientPool - :: ResourcePoolParams - -> ClientSettingsUnix - -> IO (ConnectionPool UnixClient) -createUnixClientPool poolParams unixParams = Internal.UnixConnectionPool - <$> 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 --- allocated see 'Data.Pool.withResource'. -withUnixClientConnection - :: MonadBaseControl IO m - => ConnectionPool UnixClient - -> (AppDataUnix -> m r) - -> 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 + -- $tcpClientExample -- -- Here is a simple example that demonstrates how TCP client can be created and @@ -233,8 +144,14 @@ -- module Main (main) -- where -- --- import Control.Monad (void) --- import Control.Concurrent (forkIO, threadDelay) +-- import Control.Concurrent +-- ( forkIO +-- , newEmptyMVar +-- , putMVar +-- , readMVar +-- , threadDelay +-- ) +-- import Control.Monad (void, mapM_) -- import System.Environment (getArgs) -- -- import Control.Lens ((.~), (&)) @@ -257,11 +174,16 @@ -- pool <- 'createTcpClientPool' -- (poolParams numStripes numPerStripe) -- ('Data.Streaming.Network.clientSettingsTCP' (read port) \"127.0.0.1\") +-- thread1 <- newEmptyMVar +-- thread2 <- newEmptyMVar -- void . forkIO . 'withTcpClientConnection' pool $ \\appData -> do --- threadDelay 100 +-- threadDelay 1000 -- 'Data.Streaming.Network.appWrite' appData \"1: I'm alive!\\n\" --- void . forkIO . 'withTcpClientConnection' pool $ \\appData -> +-- putMVar thread1 () +-- void . forkIO . 'withTcpClientConnection' pool $ \\appData -> do -- 'Data.Streaming.Network.appWrite' appData \"2: I'm alive!\\n\" +-- putMVar thread2 () +-- mapM_ readMVar [thread1, thread2] -- where -- poolParams m n = -- 'Data.Default.Class.def' & 'numberOfStripes' .~ read m @@ -316,8 +238,14 @@ -- module Main (main) -- where -- --- import Control.Concurrent (forkIO, threadDelay) --- import Control.Monad (void) +-- import Control.Concurrent +-- ( forkIO +-- , newEmptyMVar +-- , putMVar +-- , readMVar +-- , threadDelay +-- ) +-- import Control.Monad (void, mapM_) -- import System.Environment (getArgs) -- -- import Control.Lens ((.~), (&)) @@ -340,11 +268,16 @@ -- pool <- 'createUnixClientPool' -- (poolParams numStripes numPerStripe) -- ('Data.Streaming.Network.clientSettingsUnix' socket) +-- thread1 <- newEmptyMVar +-- thread2 <- newEmptyMVar -- void . forkIO . 'withUnixClientConnection' pool $ \\appData -> do -- threadDelay 100 -- 'Data.Streaming.Network.appWrite' appData \"1: I'm alive!\\n\" --- void . forkIO . 'withUnixClientConnection' pool $ \\appData -> +-- putMVar thread1 () +-- void . forkIO . 'withUnixClientConnection' pool $ \\appData -> do -- 'Data.Streaming.Network.appWrite' appData \"2: I'm alive!\\n\" +-- putMVar thread2 () +-- mapM_ readMVar [thread1, thread2] -- where -- poolParams m n = -- 'Data.Default.Class.def' & 'numberOfStripes' .~ read m diff --git a/src/Data/ConnectionPool/Class.hs b/src/Data/ConnectionPool/Class.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionPool/Class.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + +#ifdef KIND_POLYMORPHIC_TYPEABLE_POLYKINDED_DATA_FAMILIES +-- Since ConnectionPool data family is not poly-kinded on GHC <7.10, then +-- neither can be ConnectionPoolFor type class. +{-# LANGUAGE PolyKinds #-} +#endif + +-- | +-- Module: $HEADER$ +-- Description: Type class for common connection pool operations. +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Maintainer: peter.trsko@gmail.com +-- Stability: unstable +-- Portability: CPP, FlexibleContexts, NoImplicitPrelude, PolyKinds, +-- TypeFamilies +-- +-- Type class for common connection pool operations. +module Data.ConnectionPool.Class + ( ConnectionPoolFor(..) + ) + where + +import Data.Maybe (Maybe) +import System.IO (IO) + +import Control.Monad.Trans.Control (MonadBaseControl) + +import Data.ConnectionPool.Family (ConnectionPool) + + +-- | Type class for common connection pool operations. It intentionally +-- doesn't handle connection pool creation, which is best left to dedicated +-- smart constructors. +-- +-- /Since version 0.2./ +class +#ifdef KIND_POLYMORPHIC_TYPEABLE_POLYKINDED_DATA_FAMILIES + ConnectionPoolFor (protocol :: k) +#else + -- Since ConnectionPool data family is not poly-kinded on GHC <7.10, then + -- neither can be ConnectionPoolFor type class. + ConnectionPoolFor protocol +#endif + where + -- | Data passed to individual connection handler. + type HandlerData protocol + + -- | Temporarily take a connection from a pool, run handler with it, and + -- return it to the pool afterwards. + -- + -- /Since version 0.2./ + withConnection + :: MonadBaseControl IO m + => ConnectionPool protocol + -> (HandlerData protocol -> m r) + -> m r + + -- | Similar to 'withConnection', but only performs action if a connection + -- could be taken from the pool /without blocking./ Otherwise, + -- 'tryWithResource' returns immediately with 'Nothing' (ie. the action + -- function is not called). Conversely, if a connection can be acquired + -- from the pool without blocking, the action is performed and it's result + -- is returned, wrapped in a 'Just'. + -- + -- /Since version 0.2./ + tryWithConnection + :: MonadBaseControl IO m + => ConnectionPool protocol + -> (HandlerData protocol -> m r) + -> m (Maybe r) + + -- | 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. + -- + -- /Since version 0.2./ + destroyAllConnections :: ConnectionPool protocol -> IO () diff --git a/src/Data/ConnectionPool/Family.hs b/src/Data/ConnectionPool/Family.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionPool/Family.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + +#ifdef KIND_POLYMORPHIC_TYPEABLE +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} +#endif + +#ifdef KIND_POLYMORPHIC_TYPEABLE_POLYKINDED_DATA_FAMILIES +-- To be able to use poly-kinded ConnectionPool data family we need two things +-- (i) poly-kinded Typeable class and (ii) compiler that is capable of deriving +-- Typeable instance for poly-kinded data family. Otherwise we would break +-- backward compatibility by not providing Typeable instance. Both of these +-- work on GHC only on >=7.10. +{-# LANGUAGE PolyKinds #-} +#endif + +-- | +-- Module: $HEADER$ +-- Description: Family of connection pools specialized by transport protocol. +-- Copyright: (c) 2014-2015, Peter Trško +-- License: BSD3 +-- +-- Maintainer: peter.trsko@gmail.com +-- Stability: stable +-- Portability: CPP, DeriveDataTypeable, PolyKinds, StandaloneDeriving, +-- NoImplicitPrelude, TypeFamilies +-- +-- Module defines data family of connection pools that is later specialised +-- for various protocols and implementations. +-- +-- This module is intended mostly for library writers, for normal usage just +-- import "Data.ConnectionPool" which re-exports 'ConnectionPool' data family. +-- +-- Notice that this module doesn't depend on any other internal modules nor any +-- other package then . Please, +-- bear this in mind when doing modifications. +module Data.ConnectionPool.Family + ( + -- * Connection Pool Family + ConnectionPool + ) + where + +#ifdef KIND_POLYMORPHIC_TYPEABLE +import Data.Typeable (Typeable) +#endif + +-- | Family of connection pools parametrised by transport protocol. +-- +-- /Definition changed version 0.2 to be kind polymorphic (only on GHC >=/ +-- /7.10) and became part of stable API by being moved in to/ +-- /"Data.ConnectionPool.Family" module./ +data family ConnectionPool +#ifdef KIND_POLYMORPHIC_TYPEABLE_POLYKINDED_DATA_FAMILIES + :: k -> * +#else + :: * -> * + -- To be able to use poly-kinded ConnectionPool data family we need two + -- things (i) poly-kinded Typeable class and (ii) compiler that is capable + -- of deriving Typeable instance for poly-kinded data family. Otherwise we + -- would break backward compatibility by not providing Typeable instance. + -- Both of these work on GHC only on >=7.10. +#endif + +#ifdef KIND_POLYMORPHIC_TYPEABLE +deriving instance Typeable ConnectionPool +#endif 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,5 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} @@ -11,7 +14,8 @@ -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: DeriveDataTypeable, FlexibleContexts, NamedFieldPuns, +-- Portability: DeriveDataTypeable, DeriveGeneric, FunctionalDependencies, +-- FlexibleContexts, MultiParamTypeClasses, NamedFieldPuns, -- NoImplicitPrelude, RecordWildCards -- -- Internal packages are here to provide access to internal definitions for @@ -22,36 +26,48 @@ -- > import qualified Data.ConnectionPool.Internal.ConnectionPool 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. +-- and +-- other non-HaskellPlatform packages with exception of two packages +-- and +-- . Another 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, _handlerParams, _resourcePool) + ( + -- * Data Type For Building Connection Pools + ConnectionPool(ConnectionPool, _handlerParams, _resourcePool) + -- ** Lenses , resourcePool , handlerParams + , HasConnectionPool(connectionPool) + + -- * Lifted Resource Pool Operations + -- + -- | Operations on 'Pool' lifted to work on 'ConnectionPool' data type. , createConnectionPool , destroyAllConnections , withConnection + , tryWithConnection ) where import Data.Function ((.)) import Data.Functor (Functor, (<$>)) +import Data.Maybe (Maybe) import Data.Tuple (fst, uncurry) import Data.Typeable (Typeable) +import GHC.Generics (Generic) 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 , destroyAllResources + , tryWithResource , withResource ) @@ -61,46 +77,79 @@ -- | Simple specialized wrapper for 'Pool'. -data ConnectionPool handlerParams a = ConnectionPool - { _resourcePool :: !(Pool (Socket, a)) +-- +-- /Definition changed in version 0.1.3 and 0.2./ +-- /Instance for 'Generic' introduced in version 0.2./ +data ConnectionPool handlerParams connection connectionInfo = ConnectionPool + { _resourcePool :: !(Pool (connection, connectionInfo)) + -- ^ See 'resourcePool' for details. + -- + -- /Since version 0.1.3; changed in 0.2./ , _handlerParams :: !handlerParams + -- ^ See 'handlerParams' for details. + -- + -- /Since version 0.1.3./ } - deriving (Typeable) + deriving (Generic, Typeable) --- | @since 0.1.3 -instance Show handlerParams => Show (ConnectionPool handlerParams a) where +-- | /Since version 0.1.3./ +instance Show handlerParams => Show (ConnectionPool handlerParams c i) where showsPrec _ ConnectionPool{..} = showString "ConnectionPool {resourcePool = " . shows _resourcePool . showString ", handlerParams = " . shows _handlerParams . showChar '}' +-- | Lens for accessing underlying resource pool @'Pool' (connection, +-- connectionInfo)@. Where @connection@ represents network connection and +-- @connectionInfo@ is a protocol specific information associated with the same +-- network connection as the @connection@ is. +-- +-- /Since version 0.1.3; changed in 0.2./ resourcePool :: Functor f - => (Pool (Socket, a) -> f (Pool (Socket, b))) - -> ConnectionPool handlerParams a -> f (ConnectionPool handlerParams b) + => (Pool (c, i) -> f (Pool (c', i'))) + -> ConnectionPool p c i -> f (ConnectionPool p c' i') resourcePool = _resourcePool ~@@^> \s b -> s{_resourcePool = b} +{-# INLINE resourcePool #-} +-- | Lens for accessing parameters passed down to connection handler. These +-- information will usually be implementation specific. E.g. for +-- >= +-- 1.13 we use this to pass around read buffer size, for more details see +-- module "Data.ConnectionPool.Internal.HandlerParams". +-- +-- /Since version 0.1.3./ handlerParams :: Functor f => (handlerParams -> f handlerParams') - -> ConnectionPool handlerParams c -> f (ConnectionPool handlerParams' c) + -> ConnectionPool handlerParams c i + -> f (ConnectionPool handlerParams' c i) handlerParams = _handlerParams ~@@^> \s b -> s{_handlerParams = b} +{-# INLINE handlerParams #-} -- | Specialized wrapper for 'Pool.createPool', see its documentation for -- details. +-- +-- Definition changed in /version 0.1.3 and version 0.2/. createConnectionPool :: 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 - -- only and aren't passed to release function (see next argument). - -> (Socket -> IO ()) - -- ^ Release a connection which is represented by a 'Socket'. + -- + -- /Since version 0.1.3./ + -> IO (connection, connectionInfo) + -- ^ Acquire a connection which is represented by a @connection@. There + -- might be additional information associated with specific connection that + -- we pass as a sencond value in a tuple. Such information are considered + -- read only and aren't passed to release function (see next argument). + -- + -- /Changed in version 0.2./ + -> (connection -> IO ()) + -- ^ Release a connection which is represented by a @connection@. + -- + -- /Changed in version 0.2./ -> ResourcePoolParams -- ^ Data type representing all 'Pool.createPool' parameters that describe -- internal 'Pool' parameters. - -> IO (ConnectionPool handlerParams a) + -> IO (ConnectionPool handlerParams connection connectionInfo) -- ^ Created connection pool that is parametrised by additional connection -- details. createConnectionPool hParams acquire release params = @@ -115,16 +164,32 @@ { _resourcePool = pool , _handlerParams = hParams } +{-# INLINE createConnectionPool #-} -- | Specialized wrapper for 'Pool.withResource'. +-- +-- /Changed in version 0.2./ withConnection :: MonadBaseControl IO m - => ConnectionPool c a - -> (c -> Socket -> a -> m r) + => ConnectionPool handlerParams connection connectionInfo + -> (handlerParams -> connection -> connectionInfo -> m r) -> m r withConnection ConnectionPool{..} f = Pool.withResource _resourcePool (uncurry (f _handlerParams)) +{-# INLINE withConnection #-} +-- | Specialized wrapper for 'Pool.tryWithResource'. +-- +-- /Since version 0.2./ +tryWithConnection + :: MonadBaseControl IO m + => ConnectionPool handlerParams connection connectionInfo + -> (handlerParams -> connection -> connectionInfo -> m r) + -> m (Maybe r) +tryWithConnection ConnectionPool{..} f = + Pool.tryWithResource _resourcePool (uncurry (f _handlerParams)) +{-# INLINE tryWithConnection #-} + -- | 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. @@ -132,6 +197,15 @@ -- For more details see 'Pool.destroyAllResources'. -- -- /Since version 0.1.1.0./ -destroyAllConnections :: ConnectionPool handlerParams a -> IO () +destroyAllConnections :: ConnectionPool p c i -> IO () destroyAllConnections ConnectionPool{_resourcePool} = Pool.destroyAllResources _resourcePool +{-# INLINE destroyAllConnections #-} + +-- | /Since version 0.2./ +class HasConnectionPool p c i s | s -> p, s -> c, s -> i where + -- | Lens for accessing 'ConnectionPool' wrapped in a data type. + connectionPool + :: Functor f + => (ConnectionPool p c i -> f (ConnectionPool p c i)) + -> s -> f s diff --git a/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs b/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs deleted file mode 100644 --- a/src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE NoImplicitPrelude #-} -#ifdef KIND_POLYMORPHIC_TYPEABLE -{-# LANGUAGE StandaloneDeriving #-} -#endif -{-# LANGUAGE TypeFamilies #-} --- | --- Module: $HEADER$ --- Description: Family of connection pools specialized by transport protocol. --- Copyright: (c) 2014-2015, Peter Trško --- License: BSD3 --- --- Maintainer: peter.trsko@gmail.com --- Stability: unstable (internal module) --- 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 --- 'Internal.ConnectionPool' for various protocols. --- --- 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.ConnectionPoolFamily --- > as Internal --- --- This module doesn't depend on --- and --- other non-HaskellPlatform packages directly and it is only allowed to import --- "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. -module Data.ConnectionPool.Internal.ConnectionPoolFamily - ( - -- * Connection Pool Family - ConnectionPool(..) - - -- * Tags For Specialised Connection Pools - , TcpClient -#ifndef WINDOWS - -- Windows doesn't support UNIX Sockets. - , UnixClient -#endif - -- !WINDOWS - ) - where - -import Data.Typeable (Typeable) - -import Network.Socket (SockAddr) - -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 :: * -> * - -#ifdef KIND_POLYMORPHIC_TYPEABLE -deriving instance Typeable ConnectionPool -#endif - --- | Type tag used to specialize connection pool for TCP clients. -data TcpClient - deriving Typeable - --- | Connection pool for TCP clients. -newtype instance ConnectionPool TcpClient = - TcpConnectionPool (Internal.ConnectionPool Internal.HandlerParams SockAddr) - -#ifndef WINDOWS --- Windows doesn't support UNIX Sockets. - --- | Type tag used to specialize connection pool for UNIX Socket clients. -data UnixClient - deriving Typeable - --- | Connection pool for UNIX Socket clients. -newtype instance ConnectionPool UnixClient = - UnixConnectionPool (Internal.ConnectionPool Internal.HandlerParams ()) -#endif - -- !WINDOWS diff --git a/src/Data/ConnectionPool/Internal/HandlerParams.hs b/src/Data/ConnectionPool/Internal/HandlerParams.hs --- a/src/Data/ConnectionPool/Internal/HandlerParams.hs +++ b/src/Data/ConnectionPool/Internal/HandlerParams.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} -- | -- Module: $HEADER$ @@ -11,8 +10,7 @@ -- -- Maintainer: peter.trsko@gmail.com -- Stability: unstable (internal module) --- Portability: DeriveDataTypeable, NamedFieldPuns, NoImplicitPrelude, --- RecordWildCards +-- Portability: DeriveDataTypeable, DeriveGeneric, NoImplicitPrelude -- -- Internal packages are here to provide access to internal definitions for -- library writers, but they should not be used in application code. @@ -22,11 +20,11 @@ -- > 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. +-- . +-- Another notable thing is that this package is not OS specific. Please, bear +-- this in mind when doing modifications. +-- +-- /Since version 0.1.3./ module Data.ConnectionPool.Internal.HandlerParams ( HandlerParams(HandlerParams, _readBufferSize) , readBufferSize @@ -43,6 +41,10 @@ import Data.Function.Between.Strict ((~@@^>)) +-- | Additional parameters passed to connection handler that aren't part of +-- specific connection context. +-- +-- /Since version 0.1.3./ data HandlerParams = HandlerParams { _readBufferSize :: !Int -- ^ See 'readBufferSize' for details. @@ -60,9 +62,13 @@ def = HandlerParams { _readBufferSize = 32768 } + {-# INLINE def #-} -- | Lens for accessing read buffer size that handler should use when reading -- data from connection. +-- +-- /Since version 0.1.3./ readBufferSize :: Functor f => (Int -> f Int) -> HandlerParams -> f HandlerParams readBufferSize = _readBufferSize ~@@^> \s b -> s{_readBufferSize = b} +{-# INLINE readBufferSize #-} 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,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -55,6 +56,7 @@ import Data.Ord (Ord((<))) import Data.String (String) import Data.Typeable (Typeable) +import GHC.Generics (Generic) import Text.Show (Show(show)) import Data.Time.Clock (NominalDiffTime) @@ -65,12 +67,14 @@ -- | Parameters of resource pool that describe things like its internal -- structure. See 'Data.Pool.createPool' for details. +-- +-- /Instance for 'Generic' introduced in version 0.2./ data ResourcePoolParams = ResourcePoolParams { _numberOfStripes :: !Int , _resourceIdleTimeout :: !NominalDiffTime , _numberOfResourcesPerStripe :: !Int } - deriving (Data, Show, Typeable) + deriving (Data, Generic, Show, Typeable) -- | @ -- 'numberOfStripes' = 1 @@ -83,6 +87,7 @@ , _resourceIdleTimeout = 0.5 , _numberOfResourcesPerStripe = 1 } + {-# INLINE def #-} -- | Lens for accessing stripe count. The number of distinct sub-pools to -- maintain. The smallest acceptable value is 1 (default). @@ -92,6 +97,7 @@ -> ResourcePoolParams -> f ResourcePoolParams numberOfStripes = _numberOfStripes ~@@^> \s b -> s {_numberOfStripes = b} +{-# INLINE numberOfStripes #-} -- | Lens for accessing amount of time for which an unused resource is kept -- open. The smallest acceptable value is 0.5 seconds (default). @@ -101,6 +107,7 @@ -> ResourcePoolParams -> f ResourcePoolParams resourceIdleTimeout = _resourceIdleTimeout ~@@^> \s b -> s {_resourceIdleTimeout = b} +{-# INLINE resourceIdleTimeout #-} -- | Lens for accessing maximum number of resources to keep open per stripe. -- The smallest acceptable value is 1 (default). @@ -110,6 +117,7 @@ -> ResourcePoolParams -> f ResourcePoolParams numberOfResourcesPerStripe = _numberOfResourcesPerStripe ~@@^> \s b -> s {_numberOfResourcesPerStripe = b} +{-# INLINE numberOfResourcesPerStripe #-} -- | Check if all parameters for underlying resource pool are valid: -- 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 @@ -73,14 +73,17 @@ #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) + , ClientSettingsUnix +#if MIN_VERSION_streaming_commons(0,1,13) \ + && !MIN_VERSION_streaming_commons(0,1,14) + -- Until streaming-commons 0.1.13, read buffer size was fixed. + -- ClientSettingsUnix instance for HasReadBufferSize was introduced in + -- streaming-commons version 0.1.14 and it provides much more stable + -- API then accessor. + ( clientReadBufferSizeUnix + ) #endif - -- streaming-commons >= 0.1.13 + -- streaming-commons >=0.1.13 && <= 0.1.14 #endif -- !WINDOWS ) @@ -109,14 +112,20 @@ #endif -- !WINDOWS + -- | Wrapper for 'runTcpAppImpl' with a type signature that is more natural -- for implementing a TCP specific -- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'. +-- +-- /Definition changed in version 0.1.3./ runTcpApp :: MonadBaseControl IO m => Maybe SockAddr -> (AppData -> m r) -> HandlerParams + -- ^ Parameters passed down to connection handler @('AppData' -> m r)@ as + -- part of definition of 'AppData'. + -- /Since version 0.1.3./ -> Socket -> SockAddr -> m r @@ -124,16 +133,20 @@ runTcpAppImpl localAddr sock addr bufSize app where bufSize = _readBufferSize params +{-# INLINE runTcpApp #-} -- | Simplified 'Data.Streaming.Network.runTCPClient' and -- 'Data.Streaming.Network.runTCPServer' that provides only construction of -- 'AppData' and passing it to a callback function. +-- +-- /Definition changed in version 0.1.3./ runTcpAppImpl :: MonadBaseControl IO m => Maybe SockAddr -> Socket -> SockAddr -> Int + -- ^ Buffer size used while reading from socket. /Since version 0.1.3./ -> (AppData -> m r) -> m r runTcpAppImpl localAddr sock addr bufSize app = app AppData @@ -148,6 +161,7 @@ , AppData.appRawSocket' = Just sock -- :: Maybe Socket #endif } +{-# INLINE runTcpAppImpl #-} -- | Wrapper for 'getSocketFamilyTCP' that takes 'ClientSettings' instead of -- individual parameters. @@ -157,7 +171,12 @@ port = clientPort settings host = clientHost settings addrFamily = clientAddrFamily settings +{-# INLINEABLE acquireTcpClientConnection #-} +-- | Construct 'HandlerParams' that are passed to individual TCP connection +-- handlers. +-- +-- /Since version 0.1.3./ fromClientSettings :: ClientSettings -> HandlerParams fromClientSettings _tcpParams = def #if MIN_VERSION_streaming_commons(0,1,13) @@ -165,6 +184,7 @@ { _readBufferSize = getReadBufferSize _tcpParams } #endif +{-# INLINE fromClientSettings #-} #ifndef WINDOWS -- Windows doesn't support UNIX Sockets. @@ -172,38 +192,63 @@ -- | Wrapper for 'runUnixAppImpl' with a type signature that is more natural -- for implementing a UNIX Socket specific -- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'. +-- +-- /Definition changed in version 0.1.3./ runUnixApp :: MonadBaseControl IO m => (AppDataUnix -> m r) -> HandlerParams + -- ^ Parameters passed down to connection handler @('AppDataUnix' -> m r)@ as + -- part of definition of 'AppDataUnix'. + -- /Since version 0.1.3./ -> Socket -> () -> m r runUnixApp app params sock () = runUnixAppImpl sock bufSize app where bufSize = _readBufferSize params +{-# INLINE runUnixApp #-} -- | Simplified 'Data.Streaming.Network.runUnixClient' and -- 'Data.Streaming.Network.runUnixServer' that provides only construction of -- 'AppDataUnix' and passing it to a callback function. +-- +-- /Definition changed in version 0.1.3./ runUnixAppImpl :: MonadBaseControl IO m => Socket -> Int + -- ^ Buffer size used while reading from socket. /Since version 0.1.3./ -> (AppDataUnix -> m r) -> m r runUnixAppImpl sock bufSize app = app AppDataUnix { AppDataUnix.appReadUnix = safeRecv sock bufSize , AppDataUnix.appWriteUnix = sendAll sock } +{-# INLINE runUnixAppImpl #-} +-- | Construct 'HandlerParams' that are passed to individual UNIX socket +-- connection handlers. +-- +-- /Since version 0.1.3./ 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 + { _readBufferSize = +#if MIN_VERSION_streaming_commons(0,1,14) + -- ClientSettingsUnix instance for HasReadBufferSize was introduced in + -- streaming-commons version 0.1.14 and it provides much more stable + -- API then accessor. + getReadBufferSize _unixParams +#else + -- In streaming-commons 0.1.13 we have to use clientReadBufferSizeUnix + -- accessor of ClientSettingsUnix. + clientReadBufferSizeUnix _unixParams +#endif } #endif -- streaming-commons >= 0.1.13 #endif -- !WINDOWS +{-# INLINE fromClientSettingsUnix #-} diff --git a/src/Data/ConnectionPool/Internal/TCP.hs b/src/Data/ConnectionPool/Internal/TCP.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionPool/Internal/TCP.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +#ifdef KIND_POLYMORPHIC_TYPEABLE +{-# LANGUAGE StandaloneDeriving #-} +#endif +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module: $HEADER$ +-- Description: Family of connection pools specialized by transport protocol. +-- Copyright: (c) 2014-2015, Peter Trško +-- License: BSD3 +-- +-- Maintainer: peter.trsko@gmail.com +-- Stability: unstable (internal module) +-- Portability: CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, +-- MultiParamTypeClasses, NoImplicitPrelude, PolyKinds, +-- StandaloneDeriving, TypeFamilies +-- +-- Module defines type family of connection pools that is later specialised +-- using type tags (phantom types) to specialize implementation of underlying +-- 'Internal.ConnectionPool' for various protocols. +-- +-- 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.TCP as Internal +-- +-- /Module introduced in version 0.2./ +module Data.ConnectionPool.Internal.TCP + ( ConnectionPool(..) + , TcpClient + + , createTcpClientPool + , withTcpClientConnection + , tryWithTcpClientConnection + , destroyAllTcpClientConnections + ) + where + +import Data.Function ((.), const) +import Data.Functor ((<$>)) +import Data.Maybe (Maybe(Nothing)) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Text.Show (Show) +import System.IO (IO) + +import Network.Socket (SockAddr, Socket) +import qualified Network.Socket as Socket (sClose) + +import Control.Monad.Trans.Control (MonadBaseControl) +import Data.Function.Between.Strict ((<^@~)) +import Data.Streaming.Network + ( AppData + , ClientSettings + ) + +import Data.ConnectionPool.Class (ConnectionPoolFor(..)) +import Data.ConnectionPool.Family (ConnectionPool) +import Data.ConnectionPool.Internal.ConnectionPool + ( HasConnectionPool(connectionPool) + ) +import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal + ( ConnectionPool + , createConnectionPool + , destroyAllConnections + , tryWithConnection + , withConnection + ) +import Data.ConnectionPool.Internal.HandlerParams (HandlerParams) +import qualified Data.ConnectionPool.Internal.Streaming as Internal + ( acquireTcpClientConnection + , fromClientSettings + , runTcpApp + ) +import Data.ConnectionPool.Internal.ResourcePoolParams (ResourcePoolParams) + + +-- | Type tag used to specialize connection pool for TCP clients. +-- +-- /Instance for 'Generic' introduced in version 0.2./ +data TcpClient + deriving (Generic, Typeable) + +-- | Connection pool for TCP clients. +-- +-- /Definition changed in version 0.1.3 and 0.2./ +-- /Instances for 'Generic' and 'Show' introduced in version 0.2./ +newtype instance ConnectionPool TcpClient = + TcpConnectionPool (Internal.ConnectionPool HandlerParams Socket SockAddr) + deriving (Generic, Show) + +-- | /Since version 0.2./ +instance + HasConnectionPool HandlerParams Socket SockAddr (ConnectionPool TcpClient) + where + connectionPool = const TcpConnectionPool <^@~ \(TcpConnectionPool a) -> a + {-# INLINE connectionPool #-} + +-- | Defined using: +-- +-- @ +-- 'withConnection' = 'withTcpClientConnection' +-- 'destroyAllConnections' = 'destroyAllTcpClientConnections' +-- @ +-- +-- /Since version 0.2./ +instance ConnectionPoolFor TcpClient where + type HandlerData TcpClient = AppData + + withConnection = withTcpClientConnection + {-# INLINE withConnection #-} + + tryWithConnection = tryWithTcpClientConnection + {-# INLINE tryWithConnection #-} + + destroyAllConnections = destroyAllTcpClientConnections + {-# INLINE destroyAllConnections #-} + +-- | Create connection pool for TCP clients. +createTcpClientPool + :: ResourcePoolParams + -> ClientSettings + -> IO (ConnectionPool TcpClient) +createTcpClientPool poolParams tcpParams = TcpConnectionPool + <$> Internal.createConnectionPool handlerParams acquire release poolParams + where + acquire = Internal.acquireTcpClientConnection tcpParams + release = Socket.sClose + handlerParams = Internal.fromClientSettings tcpParams +{-# INLINE createTcpClientPool #-} + +-- | 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 +-- see 'Data.Pool.withResource'. +withTcpClientConnection + :: (MonadBaseControl io m, io ~ IO) + => ConnectionPool TcpClient + -> (AppData -> m r) + -> m r +withTcpClientConnection (TcpConnectionPool pool) = + Internal.withConnection pool . Internal.runTcpApp Nothing +{-# INLINE withTcpClientConnection #-} + +-- | Similar to 'withConnection', but only performs action if a TCP connection +-- could be taken from the pool /without blocking./ Otherwise, +-- 'tryWithResource' returns immediately with 'Nothing' (ie. the action +-- function is not called). Conversely, if a connection can be acquired from +-- the pool without blocking, the action is performed and it's result is +-- returned, wrapped in a 'Just'. +-- +-- /Since version 0.2./ +tryWithTcpClientConnection + :: (MonadBaseControl io m, io ~ IO) + => ConnectionPool TcpClient + -> (AppData -> m r) + -> m (Maybe r) +tryWithTcpClientConnection (TcpConnectionPool pool) = + Internal.tryWithConnection pool . Internal.runTcpApp Nothing +{-# INLINE tryWithTcpClientConnection #-} + +-- | 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 (TcpConnectionPool pool) = + Internal.destroyAllConnections pool +{-# INLINE destroyAllTcpClientConnections #-} diff --git a/src/Data/ConnectionPool/Internal/Unix.hs b/src/Data/ConnectionPool/Internal/Unix.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionPool/Internal/Unix.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +#ifdef KIND_POLYMORPHIC_TYPEABLE +{-# LANGUAGE StandaloneDeriving #-} +#endif +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +-- | +-- Module: $HEADER$ +-- Description: Family of connection pools specialized by transport protocol. +-- Copyright: (c) 2014-2015, Peter Trško +-- License: BSD3 +-- +-- Maintainer: peter.trsko@gmail.com +-- Stability: unstable (internal module) +-- Portability: CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, +-- MultiParamTypeClasses, NoImplicitPrelude, PolyKinds, +-- StandaloneDeriving, TupleSections, TypeFamilies +-- +-- Module defines type family of connection pools that is later specialised +-- using type tags (phantom types) to specialize implementation of underlying +-- 'Internal.ConnectionPool' for various protocols. +-- +-- 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.Unix as Internal +-- +-- This package is OS specific, because Windows doesn't support UNIX Sockets. +-- Please, bear this in mind when doing modifications. +-- +-- /Module introduced in version 0.2./ +module Data.ConnectionPool.Internal.Unix + ( ConnectionPool(..) + , UnixClient + + , createUnixClientPool + , withUnixClientConnection + , tryWithUnixClientConnection + , destroyAllUnixClientConnections + ) + where + +import Data.Function ((.), const) +import Data.Functor ((<$>)) +import Data.Maybe (Maybe) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Text.Show (Show) +import System.IO (IO) + +import Network.Socket (Socket) +import qualified Network.Socket as Socket (sClose) + +import Control.Monad.Trans.Control (MonadBaseControl) +import Data.Function.Between.Strict ((<^@~)) +import Data.Streaming.Network + ( AppDataUnix + , ClientSettingsUnix + , getPath + , getSocketUnix + ) + +import Data.ConnectionPool.Class (ConnectionPoolFor(..)) +import Data.ConnectionPool.Family (ConnectionPool) +import Data.ConnectionPool.Internal.ConnectionPool + ( HasConnectionPool(connectionPool) + ) +import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal + ( ConnectionPool + , createConnectionPool + , destroyAllConnections + , tryWithConnection + , withConnection + ) +import Data.ConnectionPool.Internal.HandlerParams (HandlerParams) +import Data.ConnectionPool.Internal.ResourcePoolParams (ResourcePoolParams) +import qualified Data.ConnectionPool.Internal.Streaming as Internal + ( fromClientSettingsUnix + , runUnixApp + ) + + +-- | Type tag used to specialize connection pool for UNIX Socket clients. +-- +-- /Instance for 'Generic' introduced in version 0.2./ +data UnixClient + deriving (Generic, Typeable) + +-- | Connection pool for UNIX Socket clients. +-- +-- /Definition changed in version 0.1.3 and 0.2./ +-- /Instances for 'Generic' and 'Show' introduced in version 0.2./ +newtype instance ConnectionPool UnixClient = + UnixConnectionPool (Internal.ConnectionPool HandlerParams Socket ()) + deriving (Generic, Show) + +-- | /Since version 0.2./ +instance HasConnectionPool HandlerParams Socket () (ConnectionPool UnixClient) + where + connectionPool = const UnixConnectionPool <^@~ \(UnixConnectionPool a) -> a + {-# INLINE connectionPool #-} + +-- | Defined using: +-- +-- @ +-- 'withConnection' = 'withUnixClientConnection' +-- 'destroyAllConnections' = 'destroyAllUnixClientConnections' +-- @ +-- +-- /Since version 0.2./ +instance ConnectionPoolFor UnixClient where + type HandlerData UnixClient = AppDataUnix + + withConnection = withUnixClientConnection + {-# INLINE withConnection #-} + + tryWithConnection = tryWithUnixClientConnection + {-# INLINE tryWithConnection #-} + + destroyAllConnections = destroyAllUnixClientConnections + {-# INLINE destroyAllConnections #-} + +-- | Create connection pool for UNIX Sockets clients. +createUnixClientPool + :: ResourcePoolParams + -> ClientSettingsUnix + -> IO (ConnectionPool UnixClient) +createUnixClientPool poolParams unixParams = UnixConnectionPool + <$> Internal.createConnectionPool handlerParams acquire release poolParams + where + acquire = (, ()) <$> getSocketUnix (getPath unixParams) + release = Socket.sClose + handlerParams = Internal.fromClientSettingsUnix unixParams +{-# INLINE createUnixClientPool #-} + +-- | 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 +-- allocated see 'Data.Pool.withResource'. +withUnixClientConnection + :: (MonadBaseControl io m, io ~ IO) + => ConnectionPool UnixClient + -> (AppDataUnix -> m r) + -> m r +withUnixClientConnection (UnixConnectionPool pool) = + Internal.withConnection pool . Internal.runUnixApp +{-# INLINE withUnixClientConnection #-} + +-- | Similar to 'withConnection', but only performs action if a UNIX Sockets +-- connection could be taken from the pool /without blocking./ Otherwise, +-- 'tryWithResource' returns immediately with 'Nothing' (ie. the action +-- function is not called). Conversely, if a connection can be acquired from +-- the pool without blocking, the action is performed and it's result is +-- returned, wrapped in a 'Just'. +-- +-- /Since version 0.2./ +tryWithUnixClientConnection + :: (MonadBaseControl io m, io ~ IO) + => ConnectionPool UnixClient + -> (AppDataUnix -> m r) + -> m (Maybe r) +tryWithUnixClientConnection (UnixConnectionPool pool) = + Internal.tryWithConnection pool . Internal.runUnixApp +{-# INLINE tryWithUnixClientConnection #-} + +-- | 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 (UnixConnectionPool pool) = + Internal.destroyAllConnections pool +{-# INLINE destroyAllUnixClientConnections #-}