diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Aleksey Uimanov + +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 Aleksey Uimanov 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,30 @@ +# What? + +Simple types and set of functions to quickly add configuration of +postgresql to your Yesod site or whatever. + +# How? + +Add separate file or section inside your existing config like that + +```yml +database: "dbname" +host: "127.0.0.1" # optional +port: "5432" # optional +user: "dbuser" +password: "pass" +poolsize: "10" # optional maximum connections in pool +pooltimeout: "60" # optional minimum connection lifetime +poolstripes: "1" # optional count of stripes in pool +``` + +and then in your program something like that + +```haskell +conf <- decodeFile "pgconfig.yml" + >>= maybe (fail "Could not parse pgconfig.yml") return +pool <- createPGPool conf +pingPGPool pool +``` + +So now you have a pool and can perform queries any way you like. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Main.hs b/examples/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Data.Yaml +import Database.PostgreSQL.Config + + +main :: IO () +main = do + conf <- decodeFile "pgconfig.yml" + >>= maybe (fail "Oups!") return + pool <- createPGPool conf + putStrLn "Pool created" + pingPGPool pool + putStrLn "Connection performed" diff --git a/examples/pgconfig.yml b/examples/pgconfig.yml new file mode 100644 --- /dev/null +++ b/examples/pgconfig.yml @@ -0,0 +1,8 @@ +database: "dbname" +host: "127.0.0.1" # optional +port: "5432" # optional +user: "dbuser" +password: "pass" +poolsize: "10" # optional maximum connections in pool +pooltimeout: "60" # optional minimum connection lifetime +poolstripes: "1" # optional count of stripes in pool diff --git a/postgresql-config.cabal b/postgresql-config.cabal new file mode 100644 --- /dev/null +++ b/postgresql-config.cabal @@ -0,0 +1,43 @@ +name: postgresql-config +version: 0.0.1 + +synopsis: Types for easy adding postgresql configuration to your program + +license: BSD3 +license-file: LICENSE +author: Aleksey Uimanov +maintainer: s9gf4ult@gmail.com + +category: Database +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: examples/Main.hs + , examples/pgconfig.yml + , README.md + +homepage: https://bitbucket.org/s9gf4ult/postgresql-config +source-repository head + type: git + location: git@bitbucket.org:s9gf4ult/postgresql-config.git + +library + hs-source-dirs: src + default-language: Haskell2010 + + default-extensions: RecordWildCards + , DeriveDataTypeable + , DeriveGeneric + , FlexibleContexts + , OverloadedStrings + + build-depends: base >=4.7 && <4.8 + , aeson + , bytestring + , monad-control + , mtl + , postgresql-simple + , resource-pool + , time + + exposed-modules: Database.PostgreSQL.Config diff --git a/src/Database/PostgreSQL/Config.hs b/src/Database/PostgreSQL/Config.hs new file mode 100644 --- /dev/null +++ b/src/Database/PostgreSQL/Config.hs @@ -0,0 +1,131 @@ +module Database.PostgreSQL.Config + ( -- * Types + PostgresConf(..) + , PGPool(..) + -- * Pool creation + , createPGPool + , pingPGPool + -- * Helpers for __postgresql-query__ + , withPGPool + , withPGPoolPrim + ) where + +import Prelude + +import Control.Monad.Reader +import Control.Monad.Trans.Control +import Data.Aeson +import Data.ByteString ( ByteString ) +import Data.Pool +import Data.Time +import Data.Typeable +import GHC.Generics + +import qualified Database.PostgreSQL.Simple as PG + +-- | Connection pool. Must be created from settings using +-- 'createPGPool' +newtype PGPool = + PGPool + { unPGPool :: (Pool PG.Connection) + } deriving ( Show, Typeable, Generic ) + +{- | Configuration parsed from json or yaml file, or obtained by any +other way. Example configuration yml is: + +@ +database: "dbname" +host: "127.0.0.1" \# optional +port: "5432" \# optional +user: "dbuser" +password: "pass" +poolsize: "10" \# optional maximum connections in pool +pooltimeout: "60" \# optional minimum connection lifetime +poolstripes: "1" \# optional count of stripes in pool +@ + +-} + +data PostgresConf = PostgresConf + { pgConnStr :: ByteString + -- ^ The connection string. + , pgPoolSize :: Int + -- ^ How many connections should be held on the connection pool. + , pgPoolTimeout :: NominalDiffTime + -- ^ Timeout to stay connection active + , pgPoolStripes :: Int + -- ^ Stripes in the pool + } deriving (Ord, Eq, Show) + +instance FromJSON PostgresConf where + parseJSON = withObject "PostgresConf" $ \o -> do + database <- o .: "database" + host <- o .:? "host" .!= "127.0.0.1" + port <- o .:? "port" .!= 5432 + user <- o .: "user" + password <- o .: "password" + pSize <- o .:? "poolsize" .!= 10 + pTimeout <- o .:? "pooltimeout" .!= 60 + pStripes <- o .:? "poolstripes" .!= 1 + let ci = PG.ConnectInfo + { PG.connectHost = host + , PG.connectPort = port + , PG.connectUser = user + , PG.connectPassword = password + , PG.connectDatabase = database + } + cstr = PG.postgreSQLConnectionString ci + return $ PostgresConf + { pgConnStr = cstr + , pgPoolSize = pSize + , pgPoolTimeout = fromInteger pTimeout + , pgPoolStripes = pStripes + } + +-- | Create pool from parsed configuration +createPGPool :: PostgresConf -> IO PGPool +createPGPool PostgresConf{..} = + fmap PGPool + $ createPool + (PG.connectPostgreSQL pgConnStr) + PG.close + pgPoolStripes + pgPoolTimeout + pgPoolSize + + +{- | Combinator for simple implementation of 'withPGConnection' method +from package __postgresql-query__. Typical usage is: + +@ +instance HasPostgres (HandlerT App IO) where + withPGConnection = withPGPool appPGPool +@ +-} +withPGPool :: (MonadReader site m, MonadBaseControl IO m) + => (site -> PGPool) + -> (PG.Connection -> m a) + -> m a +withPGPool extract action = do + (PGPool pool) <- asks extract + withResource pool action + +{- | Another combinator to implement 'withPGConnection' + +@ +instance HasPostgres (OurMonadT IO) where + withPGConnection = withPGPoolPrim $ getPGPool \<$\> getSomeThing +@ +-} +withPGPoolPrim :: (MonadBaseControl IO m) + => m PGPool + -> (PG.Connection -> m a) + -> m a +withPGPoolPrim pget action = do + (PGPool pool) <- pget + withResource pool action + +-- | Force to create at least one connection in pool. Usefull to check +-- connection settings at program start time +pingPGPool :: PGPool -> IO () +pingPGPool (PGPool pool) = withResource pool $ const (return ())