diff --git a/example/Site.hs b/example/Site.hs new file mode 100644 --- /dev/null +++ b/example/Site.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Main where + +------------------------------------------------------------------------------ +import Control.Applicative +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State +import Data.ByteString (ByteString) +import Control.Lens +import Data.Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Time.Clock +import qualified Database.PostgreSQL.Simple as P +import Snap +import Snap.Snaplet.Auth +import Snap.Snaplet.Auth.Backends.PostgresqlSimple +import Snap.Snaplet.Heist +import Snap.Snaplet.PostgresqlSimple +import Snap.Snaplet.Session +import Snap.Snaplet.Session.Backends.CookieSession +import Snap.Util.FileServe +import Heist +import Text.XmlHtml hiding (render) + + +------------------------------------------------------------------------------ +data App = App + { _sess :: Snaplet SessionManager + , _db :: Snaplet Postgres + , _auth :: Snaplet (AuthManager App) + } + +makeLenses ''App + +instance HasPostgres (Handler b App) where + getPostgresState = with db get + setLocalPostgresState s = local (set (db . snapletValue) s) + +------------------------------------------------------------------------------ +-- | The application's routes. +routes :: [(ByteString, Handler App App ())] +routes = [ ("/", writeText "hello") + , ("foo", fooHandler) + , ("add/:uname", addHandler) + , ("find/:email", findHandler) + ] + +fooHandler = do + results <- query_ "select * from snap_auth_user" + liftIO $ print (results :: [AuthUser]) + +addHandler = do + mname <- getParam "uname" + email <- getParam "email" + let name = maybe "guest" T.decodeUtf8 mname + u <- with auth $ do + createUser name "" >>= \u -> case u of + Left _ -> return u + Right u' -> saveUser (u' {userEmail = T.decodeUtf8 <$> email}) + liftIO $ print u + +findHandler = do + email <- getParam "email" + env <- with auth get + liftIO $ lookupByEmail env (maybe "" T.decodeUtf8 email) >>= print + +------------------------------------------------------------------------------ +-- | The application initializer. +app :: SnapletInit App App +app = makeSnaplet "app" "An snaplet example application." Nothing $ do + s <- nestSnaplet "" sess $ + initCookieSessionManager "site_key.txt" "_cookie" Nothing Nothing + d <- nestSnaplet "db" db pgsInit + a <- nestSnaplet "auth" auth $ initPostgresAuth sess d + addRoutes routes + return $ App s d a + + +main :: IO () +main = serveSnaplet defaultConfig app + diff --git a/resources/db/devel.cfg b/resources/db/devel.cfg --- a/resources/db/devel.cfg +++ b/resources/db/devel.cfg @@ -4,7 +4,7 @@ pass = "" db = "testdb" -# Nmuber of distinct connection pools to maintain. The smallest acceptable +# Number of distinct connection pools to maintain. The smallest acceptable # value is 1. numStripes = 1 diff --git a/snaplet-postgresql-simple.cabal b/snaplet-postgresql-simple.cabal --- a/snaplet-postgresql-simple.cabal +++ b/snaplet-postgresql-simple.cabal @@ -1,5 +1,5 @@ name: snaplet-postgresql-simple -version: 1.0.2.0 +version: 1.1.0.0 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 @@ -10,11 +10,17 @@ author: Doug Beardsley maintainer: mightybyte@gmail.com build-type: Simple -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2 -cabal-version: >= 1.6 +cabal-version: >= 1.10 homepage: https://github.com/mightybyte/snaplet-postgresql-simple category: Web, Snap +tested-with: + GHC == 7.8.4, + GHC == 7.10.3, + GHC == 8.0.1, + GHC == 8.2.1, + GHC == 8.4.1 + extra-source-files: LICENSE README.md @@ -27,6 +33,11 @@ type: git location: https://github.com/mightybyte/snaplet-postgresql-simple.git + +flag Example + description: Enable example + default: False + Library hs-source-dirs: src @@ -39,17 +50,17 @@ Paths_snaplet_postgresql_simple build-depends: - base >= 4 && < 4.10, + base >= 4 && < 4.12, bytestring >= 0.9.1 && < 0.11, clientsession >= 0.7.2 && < 0.10, configurator >= 0.2 && < 0.4, - lens >= 3.7.6 && < 4.16, + lens >= 3.7.6 && < 4.17, lifted-base >= 0.2 && < 0.3, monad-control >= 1.0 && < 1.1, mtl >= 2 && < 2.3, postgresql-simple >= 0.3 && < 0.6, resource-pool >= 0.2 && < 0.3, - snap >= 1.0 && < 1.1, + snap >= 1.0 && < 1.2, text >= 0.11 && < 1.3, transformers >= 0.2 && < 0.6, transformers-base >= 0.4 && < 0.5, @@ -58,3 +69,27 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans -fno-warn-unused-do-bind + + default-language: Haskell2010 + +executable Example + if flag(Example) + buildable: True + else + buildable: False + build-depends: base, + aeson, + bytestring, + heist, + lens, + postgresql-simple, + mtl, + snap, + snap-core, + snaplet-postgresql-simple, + text, + time, + xmlhtml + default-language: Haskell2010 + hs-source-dirs: example + main-is: Site.hs diff --git a/src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs b/src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs --- a/src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs +++ b/src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -17,7 +18,7 @@ > { ... -- your own application state here > , _sess :: Snaplet SessionManager > , _db :: Snaplet Postgres -> , _auth :: Snaplet (AuthManager App) +> , _auth :: Snaplet (A.AuthManager App) > } Then in your initializer you'll have something like this: @@ -35,36 +36,41 @@ ) where ------------------------------------------------------------------------------ -import Prelude import Control.Applicative -import qualified Control.Exception as E -import Control.Lens -import Control.Monad -import Control.Monad.Trans -import qualified Data.Configurator as C -import qualified Data.HashMap.Lazy as HM -import Data.Maybe -import qualified Data.Text as T -import Data.Text (Text) -import qualified Data.Text.Encoding as T -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.PostgresqlSimple.Internal -import Snap.Snaplet.Session -import Web.ClientSession +import qualified Control.Exception as E +import Control.Lens ((^#)) +import Control.Monad (liftM, void, when) +import Control.Monad.Trans (liftIO) +import qualified Data.Configurator as C +import qualified Data.HashMap.Lazy as HM +import Data.Maybe (fromMaybe, listToMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Database.PostgreSQL.Simple as P +import Database.PostgreSQL.Simple.FromField (FromField, fromField) +import qualified Database.PostgreSQL.Simple.ToField as P +import Database.PostgreSQL.Simple.Types (Query (Query)) import Paths_snaplet_postgresql_simple +import Prelude +import Snap (Snaplet, SnapletInit, + SnapletLens, + getSnapletUserConfig, + makeSnaplet, + snapletValue) +import qualified Snap.Snaplet.Auth as A +import Snap.Snaplet.PostgresqlSimple (FromRow, Only, ToRow, + field, fromRow) +import Snap.Snaplet.PostgresqlSimple.Internal (Postgres, + withConnection) +import Snap.Snaplet.Session (SessionManager, mkRNG) +import Web.ClientSession (getKey) ------------------------------------------------------------------------------ data PostgresAuthManager = PostgresAuthManager - { pamTable :: AuthTable - , pamConn :: Postgres + { pamTable :: AuthTable + , pamConn :: Postgres } @@ -74,26 +80,26 @@ initPostgresAuth :: SnapletLens b SessionManager -- ^ Lens to the session snaplet -> Snaplet Postgres -- ^ The postgres snaplet - -> SnapletInit b (AuthManager b) + -> SnapletInit b (A.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) + authSettings <- A.authSettingsFromConfig + key <- liftIO $ getKey (A.asSiteKey authSettings) let tableDesc = defAuthTable { tblName = authTable } let manager = PostgresAuthManager tableDesc $ db ^# snapletValue liftIO $ createTableIfMissing manager rng <- liftIO mkRNG - return AuthManager + return A.AuthManager { backend = manager , session = sess , activeUser = Nothing - , minPasswdLen = asMinPasswdLen authSettings - , rememberCookieName = asRememberCookieName authSettings + , minPasswdLen = A.asMinPasswdLen authSettings + , rememberCookieName = A.asRememberCookieName authSettings , rememberCookieDomain = Nothing - , rememberPeriod = asRememberPeriod authSettings + , rememberPeriod = A.asRememberPeriod authSettings , siteKey = key - , lockout = asLockout authSettings + , lockout = A.asLockout authSettings , randomNumberGenerator = rng } where @@ -119,22 +125,25 @@ , tblName pamTable , "\" (" , T.intercalate "," (map (fDesc . ($pamTable) . fst) colDef) - , ")" + , "); " + , "CREATE INDEX email_idx ON \"" + , tblName pamTable + , "\" (email);" ] -buildUid :: Int -> UserId -buildUid = UserId . T.pack . show +buildUid :: Int -> A.UserId +buildUid = A.UserId . T.pack . show -instance FromField UserId where +instance FromField A.UserId where fromField f v = buildUid <$> fromField f v -instance FromField Password where - fromField f v = Encrypted <$> fromField f v +instance FromField A.Password where + fromField f v = A.Encrypted <$> fromField f v -instance FromRow AuthUser where +instance FromRow A.AuthUser where fromRow = - AuthUser + A.AuthUser <$> _userId <*> _userLogin <*> _userEmail @@ -189,9 +198,9 @@ withConnection pc $ \conn -> P.execute conn q ps return () -instance P.ToField Password where - toField (ClearText bs) = P.toField bs - toField (Encrypted bs) = P.toField bs +instance P.ToField A.Password where + toField (A.ClearText bs) = P.toField bs + toField (A.Encrypted bs) = P.toField bs -- | Datatype containing the names of the columns for the authentication table. @@ -250,30 +259,30 @@ -- | List of deconstructors so it's easier to extract column names from an -- 'AuthTable'. -colDef :: [(AuthTable -> (Text, Text), AuthUser -> P.Action)] +colDef :: [(AuthTable -> (Text, Text), A.AuthUser -> P.Action)] colDef = - [ (colId , P.toField . fmap unUid . userId) - , (colLogin , P.toField . userLogin) - , (colEmail , P.toField . userEmail) - , (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) - , (colResetToken , P.toField . userResetToken) - , (colResetRequestedAt, P.toField . userResetRequestedAt) + [ (colId , P.toField . fmap A.unUid . A.userId) + , (colLogin , P.toField . A.userLogin) + , (colEmail , P.toField . A.userEmail) + , (colPassword , P.toField . A.userPassword) + , (colActivatedAt , P.toField . A.userActivatedAt) + , (colSuspendedAt , P.toField . A.userSuspendedAt) + , (colRememberToken , P.toField . A.userRememberToken) + , (colLoginCount , P.toField . A.userLoginCount) + , (colFailedLoginCount, P.toField . A.userFailedLoginCount) + , (colLockedOutUntil , P.toField . A.userLockedOutUntil) + , (colCurrentLoginAt , P.toField . A.userCurrentLoginAt) + , (colLastLoginAt , P.toField . A.userLastLoginAt) + , (colCurrentLoginIp , P.toField . A.userCurrentLoginIp) + , (colLastLoginIp , P.toField . A.userLastLoginIp) + , (colCreatedAt , P.toField . A.userCreatedAt) + , (colUpdatedAt , P.toField . A.userUpdatedAt) + , (colResetToken , P.toField . A.userResetToken) + , (colResetRequestedAt, P.toField . A.userResetRequestedAt) ] -saveQuery :: AuthTable -> AuthUser -> (Text, [P.Action]) -saveQuery atable u@AuthUser{..} = maybe insertQuery updateQuery userId +saveQuery :: AuthTable -> A.AuthUser -> (Text, [P.Action]) +saveQuery atable u@A.AuthUser{..} = maybe insertQuery updateQuery userId where insertQuery = (T.concat [ "INSERT INTO " , tblName atable @@ -296,19 +305,19 @@ , " = ? RETURNING " , T.intercalate "," (map (fst . ($atable) . fst) colDef) ] - , params ++ [P.toField $ unUid uid]) + , params ++ [P.toField $ A.unUid uid]) cols = map (fst . ($atable) . fst) $ tail colDef vals = map (const "?") cols params = map (($u) . snd) $ tail colDef -onFailure :: Monad m => E.SomeException -> m (Either AuthFailure a) -onFailure e = return $ Left $ AuthError $ show e +onFailure :: Monad m => E.SomeException -> m (Either A.AuthFailure a) +onFailure e = return $ Left $ A.AuthError $ show e ------------------------------------------------------------------------------ -- | -instance IAuthBackend PostgresAuthManager where - save PostgresAuthManager{..} u@AuthUser{..} = do +instance A.IAuthBackend PostgresAuthManager where + save PostgresAuthManager{..} u@A.AuthUser{..} = do let (qstr, params) = saveQuery pamTable u let q = Query $ T.encodeUtf8 qstr let action = withConnection pamConn $ \conn -> do @@ -325,7 +334,7 @@ , fst (colId pamTable) , " = ?" ] - querySingle pamConn q [unUid uid] + querySingle pamConn q [A.unUid uid] where cols = map (fst . ($pamTable) . fst) colDef lookupByLogin PostgresAuthManager{..} login = do @@ -339,6 +348,19 @@ querySingle pamConn q [login] where cols = map (fst . ($pamTable) . fst) colDef +#if MIN_VERSION_snap(1,1,0) + lookupByEmail PostgresAuthManager{..} email = do + let q = Query $ T.encodeUtf8 $ T.concat + [ "select ", T.intercalate "," cols, " from " + , tblName pamTable + , " where " + , fst (colEmail pamTable) + , " = ?" + ] + querySingle pamConn q [email] + where cols = map (fst . ($pamTable) . fst) colDef +#endif + lookupByRememberToken PostgresAuthManager{..} token = do let q = Query $ T.encodeUtf8 $ T.concat [ "select ", T.intercalate "," cols, " from " @@ -350,7 +372,7 @@ querySingle pamConn q [token] where cols = map (fst . ($pamTable) . fst) colDef - destroy PostgresAuthManager{..} AuthUser{..} = do + destroy PostgresAuthManager{..} A.AuthUser{..} = do let q = Query $ T.encodeUtf8 $ T.concat [ "delete from " , tblName pamTable diff --git a/src/Snap/Snaplet/PostgresqlSimple.hs b/src/Snap/Snaplet/PostgresqlSimple.hs --- a/src/Snap/Snaplet/PostgresqlSimple.hs +++ b/src/Snap/Snaplet/PostgresqlSimple.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -130,38 +130,41 @@ ) where -import Prelude hiding ((++)) import Control.Applicative -import qualified Control.Exception as E -import Control.Lens -import Control.Monad.IO.Class -import Control.Monad.State -import Control.Monad.Reader -import Control.Monad.Trans.Control (MonadBaseControl(..)) -import Data.ByteString (ByteString) -import Data.Monoid(Monoid(..), (<>)) -import qualified Data.Configurator as C -import qualified Data.Configurator.Types as C -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Builder as TB -import qualified Data.Text.Lazy.Builder.Int as TB -import qualified Data.Text.Lazy.Builder.RealFloat as TB -import Data.Int -import Data.Ratio -import Data.Pool -import Database.PostgreSQL.Simple.ToRow +import qualified Control.Exception as E +import Control.Lens (set, (^#)) +import Control.Monad (liftM) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Reader (ReaderT, ask, asks, + local) +import Control.Monad.State (get) +import Control.Monad.Trans.Control (MonadBaseControl, + liftBaseWith, restoreM) +import Data.ByteString (ByteString) +import qualified Data.Configurator as C +import qualified Data.Configurator.Types as C +import Data.Int (Int64) +import Data.Monoid (Monoid (..), (<>)) +import Data.Pool (createPool) +import Data.Ratio (denominator, numerator) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Text.Lazy.Builder.Int as TB +import qualified Data.Text.Lazy.Builder.RealFloat as TB +import qualified Database.PostgreSQL.Simple as P import Database.PostgreSQL.Simple.FromRow -import qualified Database.PostgreSQL.Simple as P +import Database.PostgreSQL.Simple.ToRow import qualified Database.PostgreSQL.Simple.Transaction as P -import Snap -import Snap.Snaplet.PostgresqlSimple.Internal import Paths_snaplet_postgresql_simple +import Prelude hiding ((++)) +import qualified Snap as Snap +import Snap.Snaplet.PostgresqlSimple.Internal ------------------------------------------------------------------------------ -- | Default instance -instance HasPostgres (Handler b Postgres) where +instance HasPostgres (Snap.Handler b Postgres) where getPostgresState = get setLocalPostgresState s = local (const s) @@ -173,9 +176,9 @@ -- > d <- nestSnaplet "db" db pgsInit -- > count <- liftIO $ runReaderT (execute "INSERT ..." params) d instance {-# OVERLAPPING #-} (MonadIO m, MonadBaseControl IO m) - => HasPostgres (ReaderT (Snaplet Postgres) m) where - getPostgresState = asks (^# snapletValue) - setLocalPostgresState s = local (set snapletValue s) + => HasPostgres (ReaderT (Snap.Snaplet Postgres) m) where + getPostgresState = asks (^# Snap.snapletValue) + setLocalPostgresState s = local (set Snap.snapletValue s) ------------------------------------------------------------------------------ -- | A convenience instance to make it easier to use functions written for @@ -258,8 +261,8 @@ loop (T.break escapeNeeded -> (a,b)) = TB.fromText a <> case T.uncons b of - Nothing -> qt - Just (c,b') -> escapeChar c <> loop b' + Nothing -> qt + Just (c,b') -> escapeChar c <> loop b' escapeNeeded c = c == '\'' || c == '\\' @@ -279,16 +282,16 @@ ------------------------------------------------------------------------------ -- | Initialize the snaplet -pgsInit :: SnapletInit b Postgres -pgsInit = makeSnaplet "postgresql-simple" description datadir $ do - config <- mkPGSConfig =<< getSnapletUserConfig +pgsInit :: Snap.SnapletInit b Postgres +pgsInit = Snap.makeSnaplet "postgresql-simple" description datadir $ do + config <- mkPGSConfig =<< Snap.getSnapletUserConfig initHelper config ------------------------------------------------------------------------------ -- | Initialize the snaplet using a specific configuration. -pgsInit' :: PGSConfig -> SnapletInit b Postgres -pgsInit' config = makeSnaplet "postgresql-simple" description Nothing $ +pgsInit' :: PGSConfig -> Snap.SnapletInit b Postgres +pgsInit' config = Snap.makeSnaplet "postgresql-simple" description Nothing $ initHelper config diff --git a/src/Snap/Snaplet/PostgresqlSimple/Internal.hs b/src/Snap/Snaplet/PostgresqlSimple/Internal.hs --- a/src/Snap/Snaplet/PostgresqlSimple/Internal.hs +++ b/src/Snap/Snaplet/PostgresqlSimple/Internal.hs @@ -1,27 +1,28 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Snap.Snaplet.PostgresqlSimple.Internal where -import Control.Monad.IO.Class -import Control.Monad.Trans -import Control.Monad.Trans.Control (MonadBaseControl(..), control) -import Control.Monad.Trans.Identity -import Control.Monad.Trans.List -import Control.Monad.Trans.Maybe -import Control.Monad.Trans.Reader -import qualified Control.Monad.Trans.RWS.Lazy as LRWS -import qualified Control.Monad.Trans.RWS.Strict as SRWS -import qualified Control.Monad.Trans.State.Lazy as LS -import qualified Control.Monad.Trans.State.Strict as SS -import qualified Control.Monad.Trans.Writer.Lazy as LW +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Control (MonadBaseControl (..), + control) +import Control.Monad.Trans.Identity (IdentityT (IdentityT)) +import Control.Monad.Trans.List (ListT (ListT)) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) +import Control.Monad.Trans.Reader (ReaderT (ReaderT)) +import qualified Control.Monad.Trans.RWS.Lazy as LRWS +import qualified Control.Monad.Trans.RWS.Strict as SRWS +import qualified Control.Monad.Trans.State.Lazy as LS +import qualified Control.Monad.Trans.State.Strict as SS +import qualified Control.Monad.Trans.Writer.Lazy as LW import qualified Control.Monad.Trans.Writer.Strict as SW -import Data.ByteString (ByteString) -import Data.Monoid -import Data.Pool -import qualified Database.PostgreSQL.Simple as P +import Data.ByteString (ByteString) +import Data.Monoid (Monoid) +import Data.Pool (Pool, withResource) +import qualified Database.PostgreSQL.Simple as P ------------------------------------------------------------------------------ -- | The state for the postgresql-simple snaplet. To use it in your app @@ -134,7 +135,7 @@ -- action. Nested calls to withPG will only reserve one connection. For example, -- the following code calls withPG twice in a nested way yet only results in a single -- connection being reserved: --- +-- -- > myHandler = withPG $ do -- > queryTheDatabase -- > commonDatabaseMethod @@ -144,7 +145,7 @@ -- > evenMoreDatabaseActions -- -- This is useful in a practical setting because you may often find yourself in a situation --- where you have common code (that requires a database connection) that you wish to call from +-- where you have common code (that requires a database connection) that you wish to call from -- other blocks of code that may require a database connection and you still want to make sure -- that you are only using one connection through all of your nested methods. withPG :: (HasPostgres m)