snaplet-postgresql-simple (empty) → 0.1
raw patch · 7 files changed
+808/−0 lines, 7 filesdep +MonadCatchIO-transformersdep +basedep +bytestringsetup-changed
Dependencies added: MonadCatchIO-transformers, base, bytestring, clientsession, configurator, mtl, postgresql-simple, resource-pool-catchio, snap, text, transformers, unordered-containers
Files
- LICENSE +27/−0
- Setup.hs +3/−0
- resources/auth/devel.cfg +21/−0
- resources/db/devel.cfg +17/−0
- snaplet-postgresql-simple.cabal +53/−0
- src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs +339/−0
- src/Snap/Snaplet/PostgresqlSimple.hs +348/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2012, Doug Beardsley+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 the authors nor the names of its 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 HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ resources/auth/devel.cfg view
@@ -0,0 +1,21 @@+# Currently this option is not enforced. See current auth documentation for+# more information.+minPasswordLen = 8++# Name of the cookie to use for remembering the logged in user.+rememberCookie = "_remember"++# Number of seconds of inactivity before the user is logged out. If ommitted,+# the user will remain logged in until the end of the session.+rememberPeriod = 1209600 # 2 weeks++# Lockout strategy. The first value is the max number of invalid login+# attempts before lockout. The second value is how long the locked lasts. If+# ommitted, then incorrect passwords will never result in lockout.+# lockout = [5, 86400]++# File where the auth encryption key is stored.+siteKey = "site_key.txt"++# Name of the table where the user data is stored.+authTable = "snap_auth_user"
+ resources/db/devel.cfg view
@@ -0,0 +1,17 @@+host = "localhost"+port = 5432+user = "postgres"+pass = ""+db = "testdb"++# Nmuber of distinct connection pools to maintain. The smallest acceptable+# value is 1.+numStripes = 1++# Number of seconds an unused resource is kept open. The smallest acceptable+# value is 0.5 seconds.+idleTime = 5++# Maximum number of resources to keep open per stripe. The smallest+# acceptable value is 1.+maxResourcesPerStripe = 20
+ snaplet-postgresql-simple.cabal view
@@ -0,0 +1,53 @@+name: snaplet-postgresql-simple+version: 0.1+synopsis: postgresql-simple snaplet for the Snap Framework+description: This snaplet contains support for using the Postgresql+ database with a Snap Framework application via the+ postgresql-simple package. It also includes an+ authentication backend.+license: BSD3+license-file: LICENSE+author: Doug Beardsley+maintainer: mightybyte@gmail.com+build-type: Simple+cabal-version: >= 1.6+homepage: https://github.com/mightybyte/snaplet-postgresql-simple+category: Web++extra-source-files: LICENSE++data-files:+ resources/db/devel.cfg+ resources/auth/devel.cfg++source-repository head+ type: git+ location: https://github.com/mightybyte/snaplet-postgresql-simple.git++Library+ hs-source-dirs: src++ exposed-modules:+ Snap.Snaplet.PostgresqlSimple+ Snap.Snaplet.Auth.Backends.PostgresqlSimple++ other-modules:+ Paths_snaplet_postgresql_simple++ build-depends:+ base >= 4 && < 5,+ bytestring >= 0.9.1 && < 0.10,+ clientsession >= 0.7.2 && < 0.8,+ configurator >= 0.2 && < 0.3,+ MonadCatchIO-transformers >= 0.3 && < 0.4,+ mtl >= 2 && < 3,+ postgresql-simple >= 0.1 && < 0.2,+ resource-pool-catchio >= 0.2 && < 0.3,+ snap >= 0.9 && < 0.10,+ text >= 0.11 && < 0.12,+ transformers >= 0.2 && < 0.4,+ unordered-containers >= 0.2 && < 0.3+++ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+ -fno-warn-orphans -fno-warn-unused-do-bind
+ src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs view
@@ -0,0 +1,339 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|++This module allows you to use the auth snaplet with your user database stored+in a PostgreSQL database. When you run your application with this snaplet, a+config file will be copied into the the @snaplets/postgresql-auth@ directory.+This file contains all of the configurable options for the snaplet and allows+you to change them without recompiling your application. ++To use this snaplet in your application enable the session, postgres, and auth+snaplets as follows:++> data App = App+> { ... -- your own application state here+> , _sess :: Snaplet SessionManager+> , _db :: Snaplet Postgres+> , _auth :: Snaplet (AuthManager App)+> }++Then in your initializer you'll have something like this:++> d <- nestSnaplet "db" db pgsInit+> a <- nestSnaplet "auth" auth $ initPostgresAuth sess d++If you have not already created the database table for users, it will+automatically be created for you the first time you run your application.++-}++module Snap.Snaplet.Auth.Backends.PostgresqlSimple+ ( initPostgresAuth+ ) where++------------------------------------------------------------------------------+import qualified Data.Configurator as C+import qualified Data.HashMap.Lazy as HM+import qualified Data.Text as T+import Data.Text (Text)+import qualified Data.Text.Encoding as T+import Data.Maybe+import Data.Pool+import qualified Database.PostgreSQL.Simple as P+import qualified Database.PostgreSQL.Simple.ToField as P+import Database.PostgreSQL.Simple.FromField+import Database.PostgreSQL.Simple.FromRow+import Database.PostgreSQL.Simple.Types+import Snap+import Snap.Snaplet.Auth+import Snap.Snaplet.PostgresqlSimple+import Snap.Snaplet.Session+import Web.ClientSession+import Paths_snaplet_postgresql_simple+++data PostgresAuthManager = PostgresAuthManager+ { pamTable :: AuthTable+ , pamConnPool :: Pool P.Connection+ }+++------------------------------------------------------------------------------+-- | Initializer for the postgres backend to the auth snaplet.+--+initPostgresAuth+ :: Lens b (Snaplet SessionManager) -- ^ Lens to the session snaplet+ -> Snaplet Postgres -- ^ The postgres snaplet+ -> SnapletInit b (AuthManager b)+initPostgresAuth sess db = makeSnaplet "postgresql-auth" desc datadir $ do+ config <- getSnapletUserConfig+ authTable <- liftIO $ C.lookupDefault "snap_auth_user" config "authTable"+ authSettings <- authSettingsFromConfig+ key <- liftIO $ getKey (asSiteKey authSettings)+ let tableDesc = defAuthTable { tblName = authTable }+ let manager = PostgresAuthManager tableDesc $+ pgPool $ getL snapletValue db+ liftIO $ createTableIfMissing manager+ rng <- liftIO mkRNG+ return $ AuthManager+ { backend = manager+ , session = sess+ , activeUser = Nothing+ , minPasswdLen = asMinPasswdLen authSettings+ , rememberCookieName = asRememberCookieName authSettings+ , rememberPeriod = asRememberPeriod authSettings+ , siteKey = key+ , lockout = asLockout authSettings+ , randomNumberGenerator = rng+ }+ where+ desc = "A PostgreSQL backend for user authentication"+ datadir = Just $ liftM (++"/resources/auth") getDataDir+++------------------------------------------------------------------------------+-- | Create the user table if it doesn't exist.+createTableIfMissing :: PostgresAuthManager -> IO ()+createTableIfMissing PostgresAuthManager{..} = do+ withResource pamConnPool $ \conn -> do+ res <- P.query_ conn $ Query $ T.encodeUtf8 $+ "select relname from pg_class where relname='"+ `T.append` tblName pamTable `T.append` "'"+ when (null (res :: [Only T.Text])) $+ P.execute_ conn (Query $ T.encodeUtf8 q) >> return ()+ return ()+ where+ q = T.concat+ [ "CREATE TABLE "+ , tblName pamTable+ , " ("+ , T.intercalate "," (map (fDesc . ($pamTable) . (fst)) colDef)+ , ")"+ ]++buildUid :: Int -> UserId+buildUid = UserId . T.pack . show+++instance FromField UserId where+ fromField f v = buildUid <$> fromField f v++instance FromField Password where+ fromField f v = Encrypted <$> fromField f v++instance FromRow AuthUser where+ fromRow =+ AuthUser+ <$> _userId+ <*> _userLogin+ <*> _userPassword+ <*> _userActivatedAt+ <*> _userSuspendedAt+ <*> _userRememberToken+ <*> _userLoginCount+ <*> _userFailedLoginCount+ <*> _userLockedOutUntil+ <*> _userCurrentLoginAt+ <*> _userLastLoginAt+ <*> _userCurrentLoginIp+ <*> _userLastLoginIp+ <*> _userCreatedAt+ <*> _userUpdatedAt+ <*> _userRoles+ <*> _userMeta+ where+ !_userId = field+ !_userLogin = field+ !_userPassword = field+ !_userActivatedAt = field+ !_userSuspendedAt = field+ !_userRememberToken = field+ !_userLoginCount = field+ !_userFailedLoginCount = field+ !_userLockedOutUntil = field+ !_userCurrentLoginAt = field+ !_userLastLoginAt = field+ !_userCurrentLoginIp = field+ !_userLastLoginIp = field+ !_userCreatedAt = field+ !_userUpdatedAt = field+ !_userRoles = pure []+ !_userMeta = pure HM.empty+++querySingle :: (ToRow q, FromRow a)+ => Pool P.Connection -> Query -> q -> IO (Maybe a)+querySingle pool q ps = withResource pool $ \conn -> return . listToMaybe =<<+ P.query conn q ps++authExecute :: ToRow q+ => Pool P.Connection -> Query -> q -> IO ()+authExecute pool q ps = do+ withResource pool $ \conn -> P.execute conn q ps+ return ()++instance P.ToField Password where+ toField (ClearText bs) = P.toField bs+ toField (Encrypted bs) = P.toField bs+++-- | Datatype containing the names of the columns for the authentication table.+data AuthTable+ = AuthTable+ { tblName :: Text+ , colId :: (Text, Text)+ , colLogin :: (Text, Text)+ , colPassword :: (Text, Text)+ , colActivatedAt :: (Text, Text)+ , colSuspendedAt :: (Text, Text)+ , colRememberToken :: (Text, Text)+ , colLoginCount :: (Text, Text)+ , colFailedLoginCount :: (Text, Text)+ , colLockedOutUntil :: (Text, Text)+ , colCurrentLoginAt :: (Text, Text)+ , colLastLoginAt :: (Text, Text)+ , colCurrentLoginIp :: (Text, Text)+ , colLastLoginIp :: (Text, Text)+ , colCreatedAt :: (Text, Text)+ , colUpdatedAt :: (Text, Text)+ , rolesTable :: Text+ }++-- | Default authentication table layout+defAuthTable :: AuthTable+defAuthTable+ = AuthTable+ { tblName = "snap_auth_user"+ , colId = ("uid", "SERIAL PRIMARY KEY")+ , colLogin = ("login", "text UNIQUE NOT NULL")+ , colPassword = ("password", "text")+ , colActivatedAt = ("activated_at", "timestamp")+ , colSuspendedAt = ("suspended_at", "timestamp")+ , colRememberToken = ("remember_token", "text")+ , colLoginCount = ("login_count", "integer NOT NULL")+ , colFailedLoginCount = ("failed_login_count", "integer NOT NULL")+ , colLockedOutUntil = ("locked_out_until", "timestamp")+ , colCurrentLoginAt = ("current_login_at", "timestamp")+ , colLastLoginAt = ("last_login_at", "timestamp")+ , colCurrentLoginIp = ("current_login_ip", "text")+ , colLastLoginIp = ("last_login_ip", "text")+ , colCreatedAt = ("created_at", "timestamp")+ , colUpdatedAt = ("updated_at", "timestamp")+ , rolesTable = "user_roles"+ }++fDesc :: (Text, Text) -> Text+fDesc f = fst f `T.append` " " `T.append` snd f++-- | List of deconstructors so it's easier to extract column names from an+-- 'AuthTable'.+colDef :: [(AuthTable -> (Text, Text), AuthUser -> P.Action)]+colDef =+ [ (colId , P.toField . fmap unUid . userId)+ , (colLogin , P.toField . userLogin)+ , (colPassword , P.toField . userPassword)+ , (colActivatedAt , P.toField . userActivatedAt)+ , (colSuspendedAt , P.toField . userSuspendedAt)+ , (colRememberToken , P.toField . userRememberToken)+ , (colLoginCount , P.toField . userLoginCount)+ , (colFailedLoginCount, P.toField . userFailedLoginCount)+ , (colLockedOutUntil , P.toField . userLockedOutUntil)+ , (colCurrentLoginAt , P.toField . userCurrentLoginAt)+ , (colLastLoginAt , P.toField . userLastLoginAt)+ , (colCurrentLoginIp , P.toField . userCurrentLoginIp)+ , (colLastLoginIp , P.toField . userLastLoginIp)+ , (colCreatedAt , P.toField . userCreatedAt)+ , (colUpdatedAt , P.toField . userUpdatedAt)+ ]++saveQuery :: AuthTable -> AuthUser -> (Text, [P.Action])+saveQuery at u@AuthUser{..} = maybe insertQuery updateQuery userId+ where+ insertQuery = (T.concat [ "INSERT INTO "+ , tblName at+ , " ("+ , T.intercalate "," cols+ , ") VALUES ("+ , T.intercalate "," vals+ , ")"+ ]+ , params)+ qval f = fst (f at) `T.append` " = ?"+ updateQuery uid =+ (T.concat [ "UPDATE "+ , tblName at+ , " SET "+ , T.intercalate "," (map (qval . fst) $ tail colDef)+ , " WHERE "+ , fst (colId at)+ , " = ?"+ ]+ , params ++ [P.toField $ unUid uid])+ cols = map (fst . ($at) . fst) $ tail colDef+ vals = map (const "?") cols+ params = map (($u) . snd) $ tail colDef+ ++------------------------------------------------------------------------------+-- | +instance IAuthBackend PostgresAuthManager where+ save PostgresAuthManager{..} u@AuthUser{..} = do+ let (qstr, params) = saveQuery pamTable u+ let q = Query $ T.encodeUtf8 qstr+ withResource pamConnPool $ \conn -> do+ P.begin conn+ P.execute conn q params+ let q2 = Query $ T.encodeUtf8 $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ res <- P.query conn q2 [userLogin]+ P.commit conn+ return $ fromMaybe u $ listToMaybe res++ lookupByUserId PostgresAuthManager{..} uid = do+ let q = Query $ T.encodeUtf8 $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colId pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [unUid uid]++ lookupByLogin PostgresAuthManager{..} login = do+ let q = Query $ T.encodeUtf8 $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [login]++ lookupByRememberToken PostgresAuthManager{..} token = do+ let q = Query $ T.encodeUtf8 $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colRememberToken pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [token]++ destroy PostgresAuthManager{..} AuthUser{..} = do+ let q = Query $ T.encodeUtf8 $ T.concat+ [ "delete from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ authExecute pamConnPool q [userLogin]+
+ src/Snap/Snaplet/PostgresqlSimple.hs view
@@ -0,0 +1,348 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++{-|++This snaplet makes it simple to use a PostgreSQL database from your Snap+application and is based on the excellent postgresql-simple library+(<http://hackage.haskell.org/package/postgresql-simple>) by Bryan O'Sullivan.+Now, adding a database to your web app takes just two simple steps.++First, include this snaplet in your application's state.++> data App = App+> { ... -- Other state needed in your app+> , _db :: Snaplet Postgres+> }++Next, call the pgsInit from your application's initializer.++> appInit = makeSnaplet ... $ do+> ...+> d <- nestSnaplet "db" db pgsInit+> return $ App ... d++Now you can use any of the postgresql-simple wrapper functions defined in this+module anywhere in your application handlers. For instance:++> postHandler :: Handler App App ()+> postHandler = do+> posts <- with db $ query_ "select * from blog_post"+> ...++Optionally, if you find yourself doing many database queries, you can eliminate some of the boilerplate by defining a HasPostgres instance for your application.++> instance HasPostgres (Handler b App) where+> getPostgresState = with db get++With this code, our postHandler example no longer requires the 'with' function:++> postHandler :: Handler App App ()+> postHandler = do+> posts <- query_ "select * from blog_post"+> ...++The first time you run an application with the postgresql-simple snaplet, a+configuration file @snaplet.cfg@ in the @snaplets/postgresql-simple@ directory+underneath your project root. It specifies how to connect to your PostgreSQL+server and what user, password, and database to use. Edit this file and modify+the values appropriately and you'll be off and running.++If you want to have out-of-the-box authentication, look at the documentation+for the "Snap.Snaplet.Auth.Backends.PostgresqlSimple" module.++-}++module Snap.Snaplet.PostgresqlSimple (+ -- * The Snaplet+ Postgres(..)+ , HasPostgres(..)+ , pgsInit++ -- * Wrappers and re-exports+ , query+ , query_+ , fold+ , foldWithOptions+ , fold_+ , foldWithOptions_+ , forEach+ , forEach_+ , execute+ , execute_+ , executeMany+ , begin+ , beginLevel+ , beginMode+ , rollback+ , commit+ , withTransaction+ , withTransactionLevel+ , withTransactionMode+ , formatMany+ , formatQuery++ -- Re-exported from postgresql-simple+ , P.ConnectInfo(..)+ , P.Query+ , P.In(..)+ , P.Binary(..)+ , P.Only(..)+ , P.SqlError(..)+ , P.FormatError(..)+ , P.QueryError(..)+ , P.ResultError(..)+ , P.TransactionMode(..)+ , P.IsolationLevel(..)+ , P.ReadWriteMode(..)+ , ToRow(..)+ , FromRow(..)++ , P.defaultConnectInfo+ , P.defaultTransactionMode+ , P.defaultIsolationLevel+ , P.defaultReadWriteMode++ ) where++import Prelude hiding (catch)++import Control.Applicative+import Control.Monad.CatchIO hiding (Handler)+import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad.Trans.Writer+import Data.ByteString (ByteString)+import qualified Data.Configurator as C+import Data.Int+import Data.List+import Data.Maybe+import Data.Pool+import Database.PostgreSQL.Simple.ToRow+import Database.PostgreSQL.Simple.FromRow+import qualified Database.PostgreSQL.Simple as P+import Snap.Snaplet+import Paths_snaplet_postgresql_simple++++------------------------------------------------------------------------------+-- | The state for the postgresql-simple snaplet. To use it in your app+-- include this in your application state and use pgsInit to initialize it.+data Postgres = Postgres+ { pgPool :: Pool P.Connection+ -- ^ Function for retrieving the connection pool+ }+++------------------------------------------------------------------------------+-- | Instantiate this typeclass on 'Handler b YourAppState' so this snaplet+-- can find the connection source.+class (MonadCatchIO m) => HasPostgres m where+ getPostgresState :: m Postgres+++------------------------------------------------------------------------------+-- | Default instance+instance HasPostgres (Handler b Postgres) where+ getPostgresState = get+++logErr :: MonadIO m+ => t -> IO (Maybe a) -> WriterT [t] m (Maybe a)+logErr err m = do+ res <- liftIO m+ when (isNothing res) (tell [err])+ return res++------------------------------------------------------------------------------+-- | Initialize the snaplet+pgsInit :: SnapletInit b Postgres+pgsInit = makeSnaplet "postgresql-simple" description datadir $ do+ config <- getSnapletUserConfig+ (mci,errs) <- runWriterT $ do+ host <- logErr "Must specify postgres host" $ C.lookup config "host"+ port <- logErr "Must specify postgres port" $ C.lookup config "port"+ user <- logErr "Must specify postgres user" $ C.lookup config "user"+ pwd <- logErr "Must specify postgres pass" $ C.lookup config "pass"+ db <- logErr "Must specify postgres db" $ C.lookup config "db"+ return $ P.ConnectInfo <$> host <*> port <*> user <*> pwd <*> db+ let ci = fromMaybe (error $ intercalate "\n" errs) mci++ stripes <- liftIO $ C.lookupDefault 1 config "numStripes"+ idle <- liftIO $ C.lookupDefault 5 config "idleTime"+ resources <- liftIO $ C.lookupDefault 20 config "maxResourcesPerStripe"+ pool <- liftIO $ createPool (P.connect ci) P.close stripes+ (realToFrac (idle :: Double)) resources+ return $ Postgres pool+ where+ description = "PostgreSQL abstraction"+ datadir = Just $ liftM (++"/resources/db") getDataDir+++------------------------------------------------------------------------------+-- | Convenience function for executing a function that needs a database+-- connection.+withPG :: (HasPostgres m)+ => (P.Connection -> IO b) -> m b+withPG f = do+ s <- getPostgresState+ let pool = pgPool s+ liftIO $ withResource pool f+++------------------------------------------------------------------------------+-- | See 'P.query'+query :: (HasPostgres m, ToRow q, FromRow r)+ => P.Query -> q -> m [r]+query q params = withPG (\c -> P.query c q params)+++------------------------------------------------------------------------------+-- | See 'P.query_'+query_ :: (HasPostgres m, FromRow r) => P.Query -> m [r]+query_ q = withPG (\c -> P.query_ c q)+++------------------------------------------------------------------------------+-- | +fold :: (HasPostgres m,+ FromRow row,+ ToRow params,+ MonadCatchIO m)+ => P.Query -> params -> b -> (b -> row -> IO b) -> m b+fold template qs a f = withPG (\c -> P.fold c template qs a f)+++------------------------------------------------------------------------------+-- | +foldWithOptions :: (HasPostgres m,+ FromRow row,+ ToRow params,+ MonadCatchIO m)+ => P.FoldOptions+ -> P.Query+ -> params+ -> b+ -> (b -> row -> IO b)+ -> m b+foldWithOptions opts template qs a f =+ withPG (\c -> P.foldWithOptions opts c template qs a f)+++------------------------------------------------------------------------------+-- | +fold_ :: (HasPostgres m,+ FromRow row,+ MonadCatchIO m)+ => P.Query -> b -> (b -> row -> IO b) -> m b+fold_ template a f = withPG (\c -> P.fold_ c template a f)+++------------------------------------------------------------------------------+-- | +foldWithOptions_ :: (HasPostgres m,+ FromRow row,+ MonadCatchIO m)+ => P.FoldOptions+ -> P.Query+ -> b+ -> (b -> row -> IO b)+ -> m b+foldWithOptions_ opts template a f =+ withPG (\c -> P.foldWithOptions_ opts c template a f)+++------------------------------------------------------------------------------+-- | +forEach :: (HasPostgres m,+ FromRow r,+ ToRow q,+ MonadCatchIO m)+ => P.Query -> q -> (r -> IO ()) -> m ()+forEach template qs f = withPG (\c -> P.forEach c template qs f)+++------------------------------------------------------------------------------+-- | +forEach_ :: (HasPostgres m,+ FromRow r,+ MonadCatchIO m)+ => P.Query -> (r -> IO ()) -> m ()+forEach_ template f = withPG (\c -> P.forEach_ c template f)+++------------------------------------------------------------------------------+-- | +execute :: (HasPostgres m, ToRow q, MonadCatchIO m)+ => P.Query -> q -> m Int64+execute template qs = withPG (\c -> P.execute c template qs)+++------------------------------------------------------------------------------+-- | +execute_ :: (HasPostgres m, MonadCatchIO m)+ => P.Query -> m Int64+execute_ template = withPG (\c -> P.execute_ c template)+++------------------------------------------------------------------------------+-- | +executeMany :: (HasPostgres m, ToRow q, MonadCatchIO m)+ => P.Query -> [q] -> m Int64+executeMany template qs = withPG (\c -> P.executeMany c template qs)+++begin :: (HasPostgres m, MonadCatchIO m) => m ()+begin = withPG P.begin+++beginLevel :: (HasPostgres m, MonadCatchIO m)+ => P.IsolationLevel -> m ()+beginLevel lvl = withPG (P.beginLevel lvl)+++beginMode :: (HasPostgres m, MonadCatchIO m)+ => P.TransactionMode -> m ()+beginMode mode = withPG (P.beginMode mode)+++rollback :: (HasPostgres m, MonadCatchIO m) => m ()+rollback = withPG P.rollback+++commit :: (HasPostgres m, MonadCatchIO m) => m ()+commit = withPG P.commit+++withTransaction :: (HasPostgres m, MonadCatchIO m)+ => m a -> m a+withTransaction = withTransactionMode P.defaultTransactionMode+++withTransactionLevel :: (HasPostgres m, MonadCatchIO m)+ => P.IsolationLevel -> m a -> m a+withTransactionLevel lvl+ = withTransactionMode P.defaultTransactionMode { P.isolationLevel = lvl }+++withTransactionMode :: (HasPostgres m, MonadCatchIO m)+ => P.TransactionMode -> m a -> m a+withTransactionMode mode act = do+ beginMode mode+ r <- act `onException` rollback+ commit+ return r+++formatMany :: (ToRow q, HasPostgres m, MonadCatchIO m)+ => P.Query -> [q] -> m ByteString+formatMany q qs = withPG (\c -> P.formatMany c q qs)+++formatQuery :: (ToRow q, HasPostgres m, MonadCatchIO m)+ => P.Query -> q -> m ByteString+formatQuery q qs = withPG (\c -> P.formatQuery c q qs)++