connection-pool (empty) → 0.1.0.0

raw patch · 12 files changed

+1135/−0 lines, 12 filesdep +basedep +betweendep +data-default-classsetup-changed

Dependencies added: base, between, data-default-class, monad-control, network, resource-pool, streaming-commons, time, transformers-base

Files

• ChangeLog.md +14/−0
• LICENSE +30/−0
• README.md +126/−0
• Setup.hs +2/−0
• connection-pool.cabal +114/−0
• example/tcp.hs +39/−0
• example/unix-sockets.hs +39/−0
• src/Data/ConnectionPool.hs +364/−0
• src/Data/ConnectionPool/Internal/ConnectionPool.hs +88/−0
• src/Data/ConnectionPool/Internal/ConnectionPoolFamily.hs +88/−0
• src/Data/ConnectionPool/Internal/ResourcePoolParams.hs +101/−0
• src/Data/ConnectionPool/Internal/Streaming.hs +130/−0

@@ -0,0 +1,14 @@+# ChangeLog / ReleaseNotes+++## Version 0.1.0.0++* First public release.+* Uploaded to [Hackage][]:+  <http://hackage.haskell.org/package/connection-pool-0.1.0.0>++++[Hackage]:+  http://hackage.haskell.org/+  "HackageDB (or just Hackage) is a collection of releases of Haskell packages."

@@ -0,0 +1,30 @@+Copyright (c) 2014, Peter Trško++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Peter Trško nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,126 @@+Connection Pool+===============++[![Hackage](https://budueba.com/hackage/connection-pool)][Hackage: connection-pool]+++Description+-----------++Connection poll is a family specialised resource pools. Currently package+provides two++1. pool for TCP client connections,+2. and pool for UNIX Sockets client connections.++This package is built on top of [resource-pool][] and [streaming-commons][].+The later allows us to use [conduit-extra][] package for implementation of TCP+or UNIX Sockets clients.+++Documentation+-------------++Stable releases with API documentation are available on+[Hackage][Hackage: connection-pool]+++TCP Client Example+------------------++Here is a simple example that demonstrates how TCP client can be created and+how connection pool behaves.++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main (main)+  where++import Control.Monad (void)+import Control.Concurrent (forkIO, threadDelay)+import System.Environment (getArgs)++import Control.Lens ((.~), (&))+import Data.ConnectionPool+    ( createTcpClientPool+    , numberOfResourcesPerStripe+    , numberOfStripes+    , withTcpClientConnection+    )+import Data.Default.Class (Default(def))+import Data.Streaming.Network (appWrite, clientSettingsTCP)+++main :: IO ()+main = do+    [port, numStripes, numPerStripe] <- getArgs+    pool <- createTcpClientPool+        (poolParams numStripes numPerStripe)+        (clientSettingsTCP (read port) "127.0.0.1")+    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"+  where+    poolParams m n =+        def & numberOfStripes .~ read m+            & numberOfResourcesPerStripe .~ read n+```++To test it we can use `socat` or some `netcat` like application. Our test will+require two terminals, in one we will execute `socat` as a server listenting on+UNIX socket and in the other one we execute above example.++Simple TCP server listening on port `8001` that prints what it receives to+stdout:++    $ socat TCP4-LISTEN:8001,bind=127.0.0.1,fork -++The `fork` parameter in the above example is important, otherwise `socat` would+terminate when client closes its connection.++If we run above example as:++    $ runghc tcp-example.hs 8001 1 1++We can see that `socat` received following text:++    1: I'm alive!+    2: I'm alive!++But if we increment number of stripes or number of connections (resources) per+stripe, then we will get:++    2: I'm alive!+    1: I'm alive!++The reason for this is that we use `threadDelay 100` 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+example) will block. If we have more then one connection available in our pool,+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+resources.+++Contributions+-------------++Contributions, pull requests and bug reports are welcome! Please don't be+afraid to contact author using GitHub or by e-mail (see `.cabal` file for+that).++++[conduit-extra]:+  http://hackage.haskell.org/package/conduit-extra+[connection-pool]+  http://hackage.haskell.org/package/connection-pool+[resource-pool]:+  http://hackage.haskell.org/package/resource-pool+[streaming-commons]:+  http://hackage.haskell.org/package/streaming-commons

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,114 @@+name:                   connection-pool+version:                0.1.0.0+synopsis:+  Connection pool built on top of resource-pool and streaming-commons.+description:+  Connection poll is a family specialised resource pools. Currently package+  provides two+  .+  1. pool for TCP client connections,+  .+  2. and pool for UNIX Sockets client connections.+  .+  This package is built on top of+  <http://hackage.haskell.org/package/resource-pool resource-pool> and+  <http://hackage.haskell.org/package/streaming-commons streaming-commons>.+  The later allows us to use+  <http://hackage.haskell.org/package/conduit-extra conduit-extra> package+  for implementation of TCP or UNIX Sockets clients.+  .+  For examples and other details see documentation in "Data.ConnectionPool"+  module.++homepage:               https://github.com/trskop/connection-pool+bug-reports:            https://github.com/trskop/connection-pool/issues+license:                BSD3+license-file:           LICENSE+author:                 Peter Trško+maintainer:             peter.trsko@gmail.com+copyright:              (c) 2014 Peter Trško+category:               Data+build-type:             Simple+cabal-version:          >=1.10++extra-source-files:+    README.md+  , ChangeLog.md+  , example/*.hs++flag pedantic+  description:+    Pass additional warning flags including -Werror to GHC during compilation.+  default: False+  manual: True++library+  hs-source-dirs:       src++  exposed-modules:+      Data.ConnectionPool+    , Data.ConnectionPool.Internal.ConnectionPool+    , Data.ConnectionPool.Internal.ConnectionPoolFamily+    , Data.ConnectionPool.Internal.ResourcePoolParams+    , Data.ConnectionPool.Internal.Streaming++  other-extensions:+      CPP+    , DeriveDataTypeable+    , FlexibleContexts+    , NoImplicitPrelude+    , TupleSections+    , TypeFamilies++  build-depends:+    -- Packages distributed with HaskellPlatform (or GHC itself):+      base >=4.6 && <4.8+    , network >= 2.2.3+      -- Version 2.2.3 introduced module "Network.Socket.ByteString".+    , time >= 1.0+      -- Version 1.0 is the oldest available version of time on Hackage and it+      -- defines NominalDiffTime. Package -- resource-pool doesn't define any+      -- version boundaries on this package.++    -- Other packages:+    , between >= 0.9.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.+    , 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.+    , streaming-commons >= 0.1.3+      -- First version that had getSocketFamilyTCP function and also Earlier+      -- versions have different definition of ClientSettings. Those two things+      -- are actually related. At the time of writing (version 0.1.4.2) used+      -- subset of API is stable.+    , 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.++  default-language:     Haskell2010++  if os(windows)+    cpp-options:        -DWINDOWS++  if impl(ghc >= 7.8.1)+    cpp-options:        -DKIND_POLYMORPHIC_TYPEABLE++  ghc-options:          -Wall+  if impl(ghc >= 6.8)+    ghc-options:        -fwarn-tabs+  if flag(pedantic)+    ghc-options:+      -fwarn-implicit-prelude+      -fwarn-missing-import-lists+      -Werror++source-repository head+  type:                 git+  location:             git://github.com/trskop/connection-pool.git++source-repository this+  type:                 git+  location:             git://github.com/trskop/connection-pool.git+  tag:                  v0.1.0.0

@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module:       Main+-- Description:  UNIX Sockets client example.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+module Main (main)+  where++import Control.Monad (void)+import Control.Concurrent (forkIO, threadDelay)+import System.Environment (getArgs)++import Control.Lens ((.~), (&))+import Data.ConnectionPool+    ( createTcpClientPool+    , numberOfResourcesPerStripe+    , numberOfStripes+    , withTcpClientConnection+    )+import Data.Default.Class (Default(def))+import Data.Streaming.Network (appWrite, clientSettingsTCP)+++main :: IO ()+main = do+    [port, numStripes, numPerStripe] <- getArgs+    pool <- createTcpClientPool+        (poolParams numStripes numPerStripe)+        (clientSettingsTCP (read port) "127.0.0.1")+    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"+  where+    poolParams m n =+        def & numberOfStripes .~ read m+            & numberOfResourcesPerStripe .~ read n

@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module:       Main+-- Description:  UNIX Sockets client example.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+module Main (main)+  where++import Control.Concurrent (forkIO, threadDelay)+import Control.Monad (void)+import System.Environment (getArgs)++import Control.Lens ((.~), (&))+import Data.ConnectionPool+    ( createUnixClientPool+    , numberOfResourcesPerStripe+    , numberOfStripes+    , withUnixClientConnection+    )+import Data.Default.Class (Default(def))+import Data.Streaming.Network (appWrite, clientSettingsUnix)+++main :: IO ()+main = do+    [socket, numStripes, numPerStripe] <- getArgs+    pool <- createUnixClientPool+        (poolParams numStripes numPerStripe)+        (clientSettingsUnix socket)+    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"+  where+    poolParams m n =+        def & numberOfStripes .~ read m+            & numberOfResourcesPerStripe .~ read n

@@ -0,0 +1,364 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections #-}+-- |+-- Module:       $HEADER$+-- Description:  Connection pools for various transport protocols.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+--+-- Maintainer:   peter.trsko@gmail.com+-- Stability:    unstable+-- Portability:  non-portable (CPP, FlexibleContexts, NoImplicitPrelude,+--               TupleSections)+--+-- Connection pools for TCP clients and UNIX Socket clients (not supported on+-- Windows).+--+-- This package is built on top of+-- <http://hackage.haskell.org/package/resource-pool resource-pool> and+-- <http://hackage.haskell.org/package/streaming-commons streaming-commons>+-- packages. The later allows us to use+-- <http://hackage.haskell.org/package/conduit-extra conduit-extra> 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'.+module Data.ConnectionPool+    (+    -- * TCP Client Example+    --+    -- $tcpClientExample++#ifndef WINDOWS+    -- Windows doesn't support UNIX Sockets.++    -- * Unix Client Example+    --+    -- $unixClientExample+#endif+    -- !WINDOWS++    -- * Connection Pool+    --+    -- $connectionPool+      ConnectionPool++    -- * Constructing Connection Pool+    --+    -- $constructingConnectionPool+    , ResourcePoolParams+    , numberOfResourcesPerStripe+    , numberOfStripes+    , resourceIdleTimeout++    -- * TCP Client Connection Pool+    , TcpClient+    , ClientSettings+    , AppData+    , createTcpClientPool+    , withTcpClientConnection++#ifndef WINDOWS+    -- Windows doesn't support UNIX Sockets.++    -- * UNIX Client Connection Pool+    , UnixClient+    , ClientSettingsUnix+    , AppDataUnix+    , createUnixClientPool+    , withUnixClientConnection+#endif+    -- !WINDOWS+    )+  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+#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+    )+import qualified Data.ConnectionPool.Internal.ConnectionPoolFamily as Internal+    ( ConnectionPool(..)+    )+import Data.ConnectionPool.Internal.ResourcePoolParams+    ( ResourcePoolParams+    , numberOfResourcesPerStripe+    , numberOfStripes+    , resourceIdleTimeout+    )+import qualified Data.ConnectionPool.Internal.Streaming as Internal+    ( acquireTcpClientConnection+    , runTcpApp+#ifndef WINDOWS+    -- Windows doesn't support UNIX Sockets.+    , runUnixApp+#endif+    -- !WINDOWS+    )+++-- | Create connection pool for TCP clients.+createTcpClientPool+    :: ResourcePoolParams+    -> ClientSettings+    -> IO (ConnectionPool TcpClient)+createTcpClientPool poolParams tcpParams = Internal.TcpConnectionPool+    <$> Internal.createConnectionPool acquire release poolParams+  where+    acquire = Internal.acquireTcpClientConnection tcpParams+    release = Socket.sClose++-- | 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++#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 acquire release poolParams+  where+    acquire = (, ()) <$> getSocketUnix (getPath unixParams)+    release = Socket.sClose++-- | 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+#endif+    -- !WINDOWS++-- $tcpClientExample+--+-- Here is a simple example that demonstrates how TCP client can be created and+-- how connection pool behaves.+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- module Main (main)+--   where+--+-- import Control.Monad (void)+-- import Control.Concurrent (forkIO, threadDelay)+-- import System.Environment (getArgs)+--+-- import Control.Lens ((.~), (&))+-- import Data.ConnectionPool+--     ( 'createTcpClientPool'+--     , 'numberOfResourcesPerStripe'+--     , 'numberOfStripes'+--     , 'withTcpClientConnection'+--     )+-- import Data.Default.Class (Default(def))+-- import Data.Streaming.Network (appWrite, clientSettingsTCP)+--+--+-- main :: IO ()+-- main = do+--     [port, numStripes, numPerStripe] <- getArgs+--     pool <- 'createTcpClientPool'+--         (poolParams numStripes numPerStripe)+--         (clientSettingsTCP (read port) "127.0.0.1")+--     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"+--   where+--     poolParams m n =+--         def & 'numberOfStripes' .~ read m+--             & 'numberOfResourcesPerStripe' .~ read n+-- @+--+-- To test it we can use @socat@ or some @netcat@ like application. Our test+-- will require two terminals, in one we will execute @socat@ as a server+-- listenting on UNIX socket and in the other one we execute above example.+--+-- Simple TCP server listening on port @8001@ that prints what it receives to+-- stdout:+--+-- > $ socat TCP4-LISTEN:8001,bind=127.0.0.1,fork -+--+-- The @fork@ parameter in the above example is important, otherwise @socat@+-- would terminate when client closes its connection.+--+-- If we run above example as:+--+-- > $ runghc tcp-example.hs 8001 1 1+--+-- We can see that @socat@ received following text:+--+-- > 1: I'm alive!+-- > 2: I'm alive!+--+-- But if we increment number of stripes or number of connections (resources)+-- per stripe, then we will get:+--+-- > 2: I'm alive!+-- > 1: I'm alive!+--+-- The reason for this is that we use @threadDelay 100@ 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 example) will block. If we have more then one connection+-- available in our pool, 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 resources.++-- $unixClientExample+--+-- Here is a simple example that demonstrates how UNIX Sockets client can be+-- created and how connection pool behaves.+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- module Main (main)+--   where+--+-- import Control.Concurrent (forkIO, threadDelay)+-- import Control.Monad (void)+-- import System.Environment (getArgs)+--+-- import Control.Lens ((.~), (&))+-- import Data.ConnectionPool+--     ( 'createUnixClientPool'+--     , 'numberOfResourcesPerStripe'+--     , 'numberOfStripes'+--     , 'withUnixClientConnection'+--     )+-- import Data.Default.Class (Default(def))+-- import Data.Streaming.Network (appWrite, clientSettingsUnix)+--+--+-- main :: IO ()+-- main = do+--     [socket, numStripes, numPerStripe] <- getArgs+--     pool <- 'createUnixClientPool'+--         (poolParams numStripes numPerStripe)+--         (clientSettingsUnix socket)+--     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"+--   where+--     poolParams m n =+--         def & 'numberOfStripes' .~ read m+--             & 'numberOfResourcesPerStripe' .~ read n+-- @+--+-- Above example is very similar to our TCP Client Example and most notably the+-- implementation of two client threads is the same. Testing it is very similar+-- to testing TCP Client Example, but we would use different command for+-- @socat@ and for executing the example.+--+-- Simple UNIX socket server that prints what it receives to stdout:+--+-- > $ socat UNIX-LISTEN:test.sock,fork -+--+-- Parameter @fork@ has the same importance as when we used it in the command+-- for running TCP server.+--+-- We can execute UNIX Sockets Example using:+--+-- > $ runghc unix-sockets-example.hs test.sock 1 1+--+-- Result of the test will be the same in case of using one stripe and one+-- connection per stripe, and when we increase total number connections, to+-- what we had with the TCP Client Example.++-- $connectionPool+--+-- For each supported protocol we have a 'ConnectionPool' data family instance+-- that is tagged with supported protocol. Currently it can be either+-- 'TcpClient' or 'UnixClient'. This way we are able to use same core+-- implementation for both and only need to deviate from common code where+-- necessary.+--+-- Under the hood we use 'Network.Socket.Socket' to represent connections and+-- that limits possible implementations of 'ConnectionPool' instances to+-- protocols supported by <http://hackage.haskell.org/package/network network>+-- package.+--+-- Those interested in details should look in to+-- "Data.ConnectionPool.Internal.ConnectionPool" and+-- "Data.ConnectionPool.Internal.ConnectionPoolFamily" modules.++-- $constructingConnectionPool+--+-- For each protocol we provide separate function that creates 'ConnectionPool'+-- instance. For TCP clients it's 'createTcpClientPool' and for UNIX Socket+-- clients it's 'createUnixClientPool' (not available on Windows).+--+-- To simplify things we provide 'ResourcePoolParams' data type that is+-- accepted by concrete constructors of 'ConnectionPool' instances and it wraps+-- all common connection pool parameters.+--+-- In example, to specify connection pool with 2 stripes with 8 connections in+-- each stripe we can use:+--+-- @+-- def & numberOfStripes .~ 2+--     & numberOfResourcesPerStripe .~ 8+-- @+--+-- Functions @&@ and @.~@ are defined by+-- <http://hackage.haskell.org/package/lens lens> package, and 'def' is a+-- method of 'Default' type class defined in+-- <http://hackage.haskell.org/package/data-default-class data-default-class>+-- package.

@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module:       $HEADER$+-- Description:  ConnectionPool data type which is a specialized Pool wrapper.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+--+-- Maintainer:   peter.trsko@gmail.com+-- Stability:    unstable (internal module)+-- Portability:  non-portable (DeriveDataTypeable, FlexibleContexts,+--               NoImplicitPrelude)+--+-- 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.ConnectionPool 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.ConnectionPool+    ( ConnectionPool(ConnectionPool)+    , createConnectionPool+    , withConnection+    )+  where++import Control.Applicative ((<$>))+import Data.Function ((.))+import Data.Tuple (fst, uncurry)+import Data.Typeable (Typeable)+import System.IO (IO)++import Control.Monad.Trans.Control (MonadBaseControl)+import Network.Socket (Socket)++import Data.Pool (Pool)+import Data.Pool as Pool (createPool, withResource)++import Data.ConnectionPool.Internal.ResourcePoolParams (ResourcePoolParams)+import qualified Data.ConnectionPool.Internal.ResourcePoolParams+  as ResourcePoolParams (ResourcePoolParams(..))+++-- | Simple specialized wrapper for 'Pool'.+newtype ConnectionPool a = ConnectionPool (Pool (Socket, a))+  deriving (Typeable)++-- | Specialized wrapper for 'Pool.createPool', see its documentation for+-- details.+createConnectionPool+    :: IO (Socket, a)+    -- ^ Acquire a connection which is prepresented by a 'Socket'. There might+    -- be additional information associated with specific connection that we+    -- represent here as a sencond type 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 prepresented by a 'Socket'.+    -> ResourcePoolParams+    -- ^ Data type representing all 'Pool.createPool' parameters that describe+    -- internal 'Pool' parameters.+    -> IO (ConnectionPool a)+    -- ^ Created connection pool that is parametrised by additional connection+    -- details.+createConnectionPool acquire release params =+    ConnectionPool <$> Pool.createPool+        acquire+        (release . fst)+        (ResourcePoolParams._numberOfStripes params)+        (ResourcePoolParams._resourceIdleTimeout params)+        (ResourcePoolParams._numberOfResourcesPerStripe params)++-- | Specialized wrapper for 'Pool.withConnection'.+withConnection+    :: MonadBaseControl IO m+    => ConnectionPool a+    -> (Socket -> a -> m r)+    -> m r+withConnection (ConnectionPool pool) f =+    Pool.withResource pool (uncurry f)

@@ -0,0 +1,88 @@+{-# 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 Peter Trsko+-- License:      BSD3+--+-- Maintainer:   peter.trsko@gmail.com+-- Stability:    unstable (internal module)+-- Portability:  non-portable (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+-- <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 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)+++-- | 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 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 ())+#endif+    -- !WINDOWS

@@ -0,0 +1,101 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveDataTypeable #-}+-- |+-- Module:       $HEADER$+-- Description:  Resource pool construction parameters.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+--+-- Maintainer:   peter.trsko@gmail.com+-- Stability:    unstable (internal module)+-- Portability:  non-portable (NoImplicitPrelude, DeriveDataTypeable)+--+-- 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.ResourcePoolParams+-- >   as Internal+--+-- Surprisingly this module doesn't depend on+-- <http://hackage.haskell.org/package/resource-pool resource-pool>+-- package and it would be good if it stayed that way, but not at the cost of+-- cripling functionality.+--+-- Importantly this package should not depend on+-- <http://hackage.haskell.org/package/streaming-commons streaming-commons>+-- package or other modules of this package.+--+-- Please, bear above in mind when doing modifications.+module Data.ConnectionPool.Internal.ResourcePoolParams+    (+    -- * ResourcePoolParams+      ResourcePoolParams(..)++    -- ** Lenses+    , numberOfResourcesPerStripe+    , numberOfStripes+    , resourceIdleTimeout+    )+  where++import Data.Data (Data)+import Data.Functor (Functor)+import Data.Int (Int)+import Data.Typeable (Typeable)+import Text.Show (Show)++import Data.Time.Clock (NominalDiffTime)++import Data.Default.Class (Default(def))+import Data.Function.Between ((~@@^>))+++-- | Parameters of resource pool that describe things like its internal+-- structure. See 'Data.Pool.createPool' for details.+data ResourcePoolParams = ResourcePoolParams+    { _numberOfStripes :: !Int+    , _resourceIdleTimeout :: !NominalDiffTime+    , _numberOfResourcesPerStripe :: !Int+    }+  deriving (Data, Show, Typeable)++-- | @+-- numberOfStripes = 1+-- resourceIdleTimeout = 0.5+-- numberOfResourcesPerStripe = 1+-- @+instance Default ResourcePoolParams where+    def = ResourcePoolParams+        { _numberOfStripes = 1+        , _resourceIdleTimeout = 0.5+        , _numberOfResourcesPerStripe = 1+        }++-- | Lens for accessing stripe count. The number of distinct sub-pools to+-- maintain. The smallest acceptable value is 1 (default).+numberOfStripes+    :: Functor f+    => (Int -> f Int)+    -> ResourcePoolParams -> f ResourcePoolParams+numberOfStripes =+    _numberOfStripes ~@@^> \s b -> s {_numberOfStripes = b}++-- | Lens for accessing amount of time for which an unused resource is kept+-- open. The smallest acceptable value is 0.5 seconds (default).+resourceIdleTimeout+    :: Functor f+    => (NominalDiffTime -> f NominalDiffTime)+    -> ResourcePoolParams -> f ResourcePoolParams+resourceIdleTimeout = _resourceIdleTimeout ~@@^> \s b ->+    s {_resourceIdleTimeout = b}++-- | Lens for accessing maximum number of resources to keep open per stripe.+-- The smallest acceptable value is 1 (default).+numberOfResourcesPerStripe+    :: Functor f+    => (Int -> f Int)+    -> ResourcePoolParams -> f ResourcePoolParams+numberOfResourcesPerStripe = _numberOfResourcesPerStripe ~@@^> \s b ->+    s {_numberOfResourcesPerStripe = b}

@@ -0,0 +1,130 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module:       $HEADER$+-- Description:  Helper functions that aren't provided by streaming-commons.+-- Copyright:    (c) 2014 Peter Trsko+-- License:      BSD3+--+-- Maintainer:   peter.trsko@gmail.com+-- Stability:    unstable (internal module)+-- Portability:  non-portable (CPP, FlexibleContexts, NoImplicitPrelude)+--+-- Module defines helper functions that would be ideally provided by+-- <http://hackage.haskell.org/package/streaming-commons streaming-commons>+-- package and some wrappers with specialised type signatures.+--+-- 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.Streaming as Internal+--+-- 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 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.Streaming+    (+    -- * TCP+      acquireTcpClientConnection+    , runTcpApp+    , runTcpAppImpl++#ifndef WINDOWS+    -- Windows doesn't support UNIX Sockets.++    -- * Unix Socket+    , runUnixApp+    , runUnixAppImpl+#endif+    -- !WINDOWS+    )+  where++import Data.Maybe (Maybe)+import System.IO (IO)++import Control.Monad.Trans.Control (MonadBaseControl)+import Network.Socket (Socket, SockAddr)+import Network.Socket.ByteString (sendAll)++import Data.Streaming.Network (getSocketFamilyTCP, safeRecv)+import Data.Streaming.Network.Internal+    ( AppData(AppData)+    , AppDataUnix(AppDataUnix)+    , ClientSettings(ClientSettings)+    )+import qualified Data.Streaming.Network.Internal as AppData+    (AppData(appLocalAddr', appRead', appSockAddr', appWrite'))+import qualified Data.Streaming.Network.Internal as AppDataUnix+    (AppDataUnix(appReadUnix, appWriteUnix))++-- | Wrapper for 'runTcpAppImpl' with a type signature that is more natural+-- for implementing a TCP specific+-- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'.+runTcpApp+    :: MonadBaseControl IO m+    => Maybe SockAddr+    -> (AppData -> m r)+    -> Socket+    -> SockAddr+    -> m r+runTcpApp localAddr app sock addr = runTcpAppImpl localAddr sock addr app++-- | Simplified 'Data.Streaming.Network.runTCPClient' and+-- 'Data.Streaming.Network.runTCPServer' that provides only construction of+-- 'AppData' and passing it to a callback function.+runTcpAppImpl+    :: MonadBaseControl IO m+    => Maybe SockAddr+    -> Socket+    -> SockAddr+    -> (AppData -> m r)+    -> m r+runTcpAppImpl localAddr sock addr app = app AppData+    { AppData.appRead' = safeRecv sock 4096+    , AppData.appWrite' = sendAll sock+    , AppData.appSockAddr' = addr+    , AppData.appLocalAddr' = localAddr+    }++-- | Wrapper for 'getSocketFamilyTCP' that takes 'ClientSettings' instead of+-- individual parameters.+acquireTcpClientConnection :: ClientSettings -> IO (Socket, SockAddr)+acquireTcpClientConnection (ClientSettings port host addrFamily) =+    getSocketFamilyTCP host port addrFamily++#ifndef WINDOWS+-- Windows doesn't support UNIX Sockets.++-- | Wrapper for 'runUnixAppImpl' with a type signature that is more natural+-- for implementing a UNIX Socket specific+-- 'Data.ConnectionPool.Internal.ConnectionPool.withConnection'.+runUnixApp+    :: MonadBaseControl IO m+    => (AppDataUnix -> m r)+    -> Socket+    -> ()+    -> m r+runUnixApp app sock () = runUnixAppImpl sock app++-- | Simplified 'Data.Streaming.Network.runUnixClient' and+-- 'Data.Streaming.Network.runUnixServer' that provides only construction of+-- 'AppDataUnix' and passing it to a callback function.+runUnixAppImpl+    :: MonadBaseControl IO m+    => Socket+    -> (AppDataUnix -> m r)+    -> m r+runUnixAppImpl sock app = app AppDataUnix+    { AppDataUnix.appReadUnix = safeRecv sock 4096+    , AppDataUnix.appWriteUnix = sendAll sock+    }+#endif+    -- !WINDOWS