snaplet-sqlite-simple (empty) → 0.1.0
raw patch · 7 files changed
+698/−0 lines, 7 filesdep +MonadCatchIO-transformersdep +basedep +bytestringsetup-changed
Dependencies added: MonadCatchIO-transformers, base, bytestring, clientsession, configurator, direct-sqlite, mtl, resource-pool-catchio, snap, sqlite-simple, text, transformers, unordered-containers
Files
- LICENSE +56/−0
- Setup.hs +3/−0
- resources/auth/devel.cfg +21/−0
- resources/db/devel.cfg +13/−0
- snaplet-sqlite-simple.cabal +54/−0
- src/Snap/Snaplet/Auth/Backends/SqliteSimple.hs +338/−0
- src/Snap/Snaplet/SqliteSimple.hs +213/−0
+ LICENSE view
@@ -0,0 +1,56 @@+Copyright (c) 2012, Janne Hellsten+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.+++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,13 @@+db = "test.db"++# 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-sqlite-simple.cabal view
@@ -0,0 +1,54 @@+name: snaplet-sqlite-simple+version: 0.1.0+synopsis: sqlite-simple snaplet for the Snap Framework+description: This snaplet contains support for using the SQLite+ database with a Snap Framework application via the+ sqlite-simple package. It also includes an+ authentication backend.+license: BSD3+license-file: LICENSE+author: Janne Hellsten, Doug Beardsley+maintainer: Janne Hellsten <jjhellst@gmail.com>+build-type: Simple+cabal-version: >= 1.6+homepage: https://github.com/nurpax/snaplet-sqlite-simple+category: Web, Snap++extra-source-files: LICENSE++data-files:+ resources/db/devel.cfg+ resources/auth/devel.cfg++source-repository head+ type: git+ location: https://github.com/nurpax/snaplet-sqlite-simple.git++Library+ hs-source-dirs: src++ exposed-modules:+ Snap.Snaplet.SqliteSimple+ Snap.Snaplet.Auth.Backends.SqliteSimple++ other-modules:+ Paths_snaplet_sqlite_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,+ sqlite-simple >= 0.1 && < 1.0,+ direct-sqlite >= 2.0 && < 2.1,+ 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/SqliteSimple.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|++This module allows you to use the auth snaplet with your user database+stored in a SQLite database. When you run your application with this+snaplet, a config file will be copied into the the+@snaplets/sqlite-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, sqlite,+and auth snaplets as follows:++> data App = App+> { ... -- your own application state here+> , _sess :: Snaplet SessionManager+> , _db :: Snaplet Sqlite+> , _auth :: Snaplet (AuthManager App)+> }++Then in your initializer you'll have something like this:++> d <- nestSnaplet "db" db sqliteInit+> a <- nestSnaplet "auth" auth $ initSqliteAuth 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.SqliteSimple+ ( initSqliteAuth+ ) 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 Data.Maybe+import Data.Pool+import Database.SQLite3 (SQLData(..))+import qualified Database.SQLite.Simple as S+import qualified Database.SQLite.Simple.ToField as S+import Database.SQLite.Simple.FromField+import Database.SQLite.Simple.FromRow+import Database.SQLite.Simple.Types+import Snap+import Snap.Snaplet.Auth+import Snap.Snaplet.SqliteSimple+import Snap.Snaplet.Session+import Web.ClientSession+import Paths_snaplet_sqlite_simple+++data SqliteAuthManager = SqliteAuthManager+ { pamTable :: AuthTable+ , pamConnPool :: Pool S.Connection+ }+++------------------------------------------------------------------------------+-- | Initializer for the sqlite backend to the auth snaplet.+--+initSqliteAuth+ :: Lens b (Snaplet SessionManager) -- ^ Lens to the session snaplet+ -> Snaplet Sqlite -- ^ The sqlite snaplet+ -> SnapletInit b (AuthManager b)+initSqliteAuth sess db = makeSnaplet "sqlite-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 = SqliteAuthManager tableDesc $+ sqlitePool $ 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 = "An Sqlite backend for user authentication"+ datadir = Just $ liftM (++"/resources/auth") getDataDir+++------------------------------------------------------------------------------+-- | Create the user table if it doesn't exist.+createTableIfMissing :: SqliteAuthManager -> IO ()+createTableIfMissing SqliteAuthManager{..} = do+ withResource pamConnPool $ \conn -> do+ res <- S.query conn+ (Query "SELECT name FROM sqlite_master WHERE type='table' AND name=?")+ (Only (tblName pamTable))+ when (null (res :: [Only T.Text])) $+ S.execute_ conn (Query 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 = buildUid <$> fromField f++instance FromField Password where+ fromField f = Encrypted <$> fromField f++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 S.Connection -> Query -> q -> IO (Maybe a)+querySingle pool q ps = withResource pool $ \conn -> return . listToMaybe =<<+ S.query conn q ps++authExecute :: ToRow q+ => Pool S.Connection -> Query -> q -> IO ()+authExecute pool q ps = do+ withResource pool $ \conn -> S.execute conn q ps+ return ()++instance S.ToField Password where+ toField (ClearText bs) = S.toField bs+ toField (Encrypted bs) = S.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", "INTEGER 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 -> SQLData)]+colDef =+ [ (colId , S.toField . fmap unUid . userId)+ , (colLogin , S.toField . userLogin)+ , (colPassword , S.toField . userPassword)+ , (colActivatedAt , S.toField . userActivatedAt)+ , (colSuspendedAt , S.toField . userSuspendedAt)+ , (colRememberToken , S.toField . userRememberToken)+ , (colLoginCount , S.toField . userLoginCount)+ , (colFailedLoginCount, S.toField . userFailedLoginCount)+ , (colLockedOutUntil , S.toField . userLockedOutUntil)+ , (colCurrentLoginAt , S.toField . userCurrentLoginAt)+ , (colLastLoginAt , S.toField . userLastLoginAt)+ , (colCurrentLoginIp , S.toField . userCurrentLoginIp)+ , (colLastLoginIp , S.toField . userLastLoginIp)+ , (colCreatedAt , S.toField . userCreatedAt)+ , (colUpdatedAt , S.toField . userUpdatedAt)+ ]++saveQuery :: AuthTable -> AuthUser -> (Text, [SQLData])+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 ++ [S.toField $ unUid uid])+ cols = map (fst . ($at) . fst) $ tail colDef+ vals = map (const "?") cols+ params = map (($u) . snd) $ tail colDef+++------------------------------------------------------------------------------+-- |+instance IAuthBackend SqliteAuthManager where+ save SqliteAuthManager{..} u@AuthUser{..} = do+ let (qstr, params) = saveQuery pamTable u+ let q = Query qstr+ withResource pamConnPool $ \conn -> do+ S.execute conn q params+ let q2 = Query $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ res <- S.query conn q2 [userLogin]+ return $ fromMaybe u $ listToMaybe res++ lookupByUserId SqliteAuthManager{..} uid = do+ let q = Query $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colId pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [unUid uid]++ lookupByLogin SqliteAuthManager{..} login = do+ let q = Query $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [login]++ lookupByRememberToken SqliteAuthManager{..} token = do+ let q = Query $ T.concat+ [ "select * from "+ , tblName pamTable+ , " where "+ , fst (colRememberToken pamTable)+ , " = ?"+ ]+ querySingle pamConnPool q [token]++ destroy SqliteAuthManager{..} AuthUser{..} = do+ let q = Query $ T.concat+ [ "delete from "+ , tblName pamTable+ , " where "+ , fst (colLogin pamTable)+ , " = ?"+ ]+ authExecute pamConnPool q [userLogin]
+ src/Snap/Snaplet/SqliteSimple.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++{-|++This snaplet makes it simple to use a SQLite database from your Snap+application and is based on the sqlite-simple library+(<http://hackage.haskell.org/package/sqlite-simple>). 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 Sqlite+> }++Next, call the sqliteInit from your application's initializer.++> appInit = makeSnaplet ... $ do+> ...+> d <- nestSnaplet "db" db sqliteInit+> return $ App ... d++Now you can use any of the sqlite-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 HasSqlite instance for+your application.++> instance HasSqlite (Handler b App) where+> getSqliteState = 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 sqlite-simple snaplet,+a configuration file @devel.cfg@ is created in the+@snaplets/sqlite-simple@ directory underneath your project root. It+specifies how to connect to your Sqlite database. 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.Sqlite" module.++-}++module Snap.Snaplet.SqliteSimple (+ -- * The Snaplet+ Sqlite(..)+ , HasSqlite(..)+ , sqliteInit++ -- * Wrappers and re-exports+ , query+ , query_+ , execute+ , execute_++ -- Re-exported from sqlite-simple+ , S.Connection+ , S.Query+ , S.Only(..)+ , S.FormatError(..)+ , S.ResultError(..)+ , (S.:.)(..)+ , ToRow(..)+ , FromRow(..)++ , field++ ) where++import Prelude hiding (catch)++import Control.Monad.CatchIO hiding (Handler)+import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Writer+import qualified Data.Configurator as C+import Data.List+import Data.Maybe+import Data.Pool+import Database.SQLite.Simple.ToRow+import Database.SQLite.Simple.FromRow+import qualified Database.SQLite.Simple as S+import Snap+import Paths_snaplet_sqlite_simple++++------------------------------------------------------------------------------+-- | The state for the sqlite-simple snaplet. To use it in your app+-- include this in your application state and use 'sqliteInit' to initialize it.+data Sqlite = Sqlite+ { sqlitePool :: Pool S.Connection+ -- ^ Function for retrieving the connection pool+ }+++------------------------------------------------------------------------------+-- | Instantiate this typeclass on 'Handler b YourAppState' so this snaplet+-- can find the connection source. If you need to have multiple instances of+-- the sqlite snaplet in your application, then don't provide this instance+-- and leverage the default instance by using \"@with dbLens@\" in front of calls+-- to snaplet-sqlite-simple functions.+class (MonadCatchIO m) => HasSqlite m where+ getSqliteState :: m Sqlite+++------------------------------------------------------------------------------+-- | Default instance+instance HasSqlite (Handler b Sqlite) where+ getSqliteState = get+++------------------------------------------------------------------------------+-- | A convenience instance to make it easier to use this snaplet in the+-- Initializer monad like this:+--+-- > d <- nestSnaplet "db" db pgsInit+-- > count <- liftIO $ runReaderT (execute "INSERT ..." params) d+instance (MonadCatchIO m) => HasSqlite (ReaderT (Snaplet Sqlite) m) where+ getSqliteState = asks (getL snapletValue)+++------------------------------------------------------------------------------+-- | A convenience instance to make it easier to use functions written for+-- this snaplet in non-snaplet contexts.+instance (MonadCatchIO m) => HasSqlite (ReaderT Sqlite m) where+ getSqliteState = ask+++------------------------------------------------------------------------------+-- | Convenience function allowing easy collection of config file errors.+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+sqliteInit :: SnapletInit b Sqlite+sqliteInit = makeSnaplet "sqlite-simple" description datadir $ do+ config <- getSnapletUserConfig+ (mci,errs) <- runWriterT $ do+ db <- logErr "Must specify db filename" $ C.lookup config "db"+ return $ 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 (S.open ci) S.close stripes+ (realToFrac (idle :: Double)) resources+ return $ Sqlite pool+ where+ description = "Sqlite abstraction"+ datadir = Just $ liftM (++"/resources/db") getDataDir+++------------------------------------------------------------------------------+-- | Convenience function for executing a function that needs a database+-- connection.+withSqlite :: (HasSqlite m)+ => (S.Connection -> IO b) -> m b+withSqlite f = do+ s <- getSqliteState+ let pool = sqlitePool s+ liftIO $ withResource pool f+++------------------------------------------------------------------------------+-- | See 'P.query'+query :: (HasSqlite m, ToRow q, FromRow r)+ => S.Query -> q -> m [r]+query q params = withSqlite (\c -> S.query c q params)+++------------------------------------------------------------------------------+-- | See 'P.query_'+query_ :: (HasSqlite m, FromRow r) => S.Query -> m [r]+query_ q = withSqlite (\c -> S.query_ c q)+++------------------------------------------------------------------------------+-- |+execute :: (HasSqlite m, ToRow q, MonadCatchIO m)+ => S.Query -> q -> m ()+execute template qs = withSqlite (\c -> S.execute c template qs)+++------------------------------------------------------------------------------+-- |+execute_ :: (HasSqlite m, MonadCatchIO m)+ => S.Query -> m ()+execute_ template = withSqlite (\c -> S.execute_ c template)