1{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings, DoAndIfThenElse, RecordWildCards, NamedFieldPuns #-}
4-- Module: Database.PostgreSQL.Simple
5-- Copyright: (c) 2011 MailRank, Inc.
6-- (c) 2011 Leon P Smith
8-- Maintainer: Leon P Smith <leon@melding-monads.com>
9-- Stability: experimental
10-- Portability: portable
12-- A mid-level client library for the MySQL database, aimed at ease of
13-- use and high performance.
15module Database.PostgreSQL.Simple
23 -- ** Parameter substitution
29 -- ** Substituting a single parameter
32 -- ** Representing a list of values
35 -- ** Modifying multiple rows at once
38 -- * Extracting results
41 -- ** Handling null values
44 -- ** Type conversions
55 , FormatError(fmtMessage, fmtQuery, fmtParams)
56 , QueryError(qeMessage, qeQuery)
57 , ResultError(errSQLType, errHaskellType, errMessage)
58 -- * Connection management
60 , Base.connectPostgreSQL
61 , Base.postgreSQLConnectionString
62 , Base.defaultConnectInfo
64 -- * Queries that return results
68 -- * Queries that stream results
74 -- * Statements that do not return results
79 -- * Transaction handling
90import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
91import Blaze.ByteString.Builder.Char8 (fromChar)
92import Control.Applicative ((<$>), pure)
93import Control.Concurrent.MVar
94import Control.Exception (Exception, bracket, onException, throw, throwIO)
95import Control.Monad (forM)
96import Control.Monad.Fix (fix)
97import Data.ByteString (ByteString)
98-- import qualified Data.ByteString as B (unpack)
100import Data.Int (Int64)
101import qualified Data.IntMap as IntMap
102import Data.List (intersperse)
103import Data.Monoid (mappend, mconcat)
104import Data.Typeable (Typeable)
105--import Database.MySQL.Base (Connection, Result)
106--import Database.MySQL.Base.Types (Field)
107import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)
108import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)
109import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))
110import Database.PostgreSQL.Simple.Result (ResultError(..))
111import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
112-- import Database.PostgreSQL.Simple.Result (ResultError(..))
113import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))
114import Database.PostgreSQL.Simple.Internal as Base
115import qualified Database.PostgreSQL.LibPQ as PQ
116import Text.Regex.PCRE.Light (compile, caseless, match)
117import qualified Data.ByteString.Char8 as B
118--import qualified Database.MySQL.Base as Base
120-- | Exception thrown if a 'Query' could not be formatted correctly.
121-- This may occur if the number of \'@?@\' characters in the query
122-- string does not match the number of parameters provided.
123data FormatError = FormatError {
126 , fmtParams :: [ByteString]
127 } deriving (Eq, Show, Typeable)
129instance Exception FormatError
131-- | Exception thrown if 'query' is used to perform an @INSERT@-like
132-- operation, or 'execute' is used to perform a @SELECT@-like operation.
133data QueryError = QueryError {
136 } deriving (Eq, Show, Typeable)
138instance Exception QueryError
140-- | Format a query string.
142-- This function is exposed to help with debugging and logging. Do not
143-- use it to prepare queries for execution.
145-- String parameters are escaped according to the character set in use
146-- on the 'Connection'.
148-- Throws 'FormatError' if the query string could not be formatted
150formatQuery :: QueryParams q => Connection -> Query -> q -> IO ByteString
151formatQuery conn q@(Query template) qs
152 | null xs && '?' `B.notElem` template = return template
153 | otherwise = toByteString <$> buildQuery conn q template xs
154 where xs = renderParams qs
156-- | Format a query string with a variable number of rows.
158-- This function is exposed to help with debugging and logging. Do not
159-- use it to prepare queries for execution.
161-- The query string must contain exactly one substitution group,
162-- identified by the SQL keyword \"@VALUES@\" (case insensitive)
163-- followed by an \"@(@\" character, a series of one or more \"@?@\"
164-- characters separated by commas, and a \"@)@\" character. White
165-- space in a substitution group is permitted.
167-- Throws 'FormatError' if the query string could not be formatted
169formatMany :: (QueryParams q) => Connection -> Query -> [q] -> IO ByteString
170formatMany _ q [] = fmtError "no rows supplied" q []
171formatMany conn q@(Query template) qs = do
172 case match re template [] of
173 Just [_,before,qbits,after] -> do
174 bs <- mapM (buildQuery conn q qbits . renderParams) qs
175 return . toByteString . mconcat $ fromByteString before :
176 intersperse (fromChar ',') bs ++
177 [fromByteString after]
180 re = compile "^([^?]+\\bvalues\\s*)\
181 \(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))\
185escapeStringConn conn s = withConnection conn $ \c -> do
186 PQ.escapeStringConn c s
188buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
189buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs
190 where quote = inQuotes . fromByteString . maybe undefined id
191 sub (Plain b) = pure b
192 sub (Escape s) = quote <$> escapeStringConn conn s
193 sub (Many ys) = mconcat <$> mapM sub ys
194 split s = fromByteString h : if B.null t then [] else split (B.tail t)
195 where (h,t) = B.break (=='?') s
196 zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps
198 zipParams _ _ = fmtError (show (B.count '?' template) ++
199 " '?' characters, but " ++
200 show (length xs) ++ " parameters") q xs
202-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
203-- expected to return results.
205-- Returns the number of rows affected.
207-- Throws 'FormatError' if the query could not be formatted correctly.
208execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64
209execute conn template qs = do
210 result <- exec conn =<< formatQuery conn template qs
211 finishExecute conn template result
213-- | A version of 'execute' that does not perform query substitution.
214execute_ :: Connection -> Query -> IO Int64
215execute_ conn q@(Query stmt) = do
216 result <- exec conn stmt
217 finishExecute conn q result
219-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not
220-- expected to return results.
222-- Returns the number of rows affected.
224-- Throws 'FormatError' if the query could not be formatted correctly.
225executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Int64
226executeMany _ _ [] = return 0
227executeMany conn q qs = do
228 result <- exec conn =<< formatMany conn q qs
229 finishExecute conn q result
231finishExecute :: Connection -> Query -> PQ.Result -> IO Int64
232finishExecute conn q result = do
233 status <- PQ.resultStatus result
235 PQ.EmptyQuery -> fail "empty query" -- FIXME: error message
237 ncols <- PQ.nfields result
239 then throwIO $ QueryError ("execute resulted in " ++ show ncols ++
242 nstr <- PQ.cmdTuples result
243 return $ case nstr of
244 Nothing -> 0 -- is this appropriate?
245 Just str -> toInteger str
247 ncols <- PQ.nfields result
248 throwIO $ QueryError ("execute resulted in " ++ show ncols ++
250 PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"
251 PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"
253 errormsg <- maybe "" id <$> PQ.resultErrorMessage result
254 statusmsg <- PQ.resStatus status
255 state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
256 throw $ SqlError { sqlState = state
257 , sqlNativeError = 0 -- FIXME
258 , sqlErrorMsg = B.concat [ "execute: ", statusmsg
261 toInteger str = B.foldl' delta 0 str
264 if '0' <= c && c <= '9'
265 then 10 * acc + fromIntegral (ord c - ord '0')
266 else error ("finishExecute: not an int: " ++ B.unpack str)
270-- | Perform a @SELECT@ or other SQL query that is expected to return
271-- results. All results are retrieved and converted before this
274-- When processing large results, this function will consume a lot of
275-- client-side memory. Consider using 'fold' instead.
277-- Exceptions that may be thrown:
279-- * 'FormatError': the query string could not be formatted correctly.
281-- * 'QueryError': the result contains no columns (i.e. you should be
282-- using 'execute' instead of 'query').
284-- * 'ResultError': result conversion failed.
285query :: (QueryParams q, QueryResults r)
286 => Connection -> Query -> q -> IO [r]
287query conn template qs = do
288 result <- exec conn =<< formatQuery conn template qs
289 finishQuery conn template result
291-- | A version of 'query' that does not perform query substitution.
292query_ :: (QueryResults r) => Connection -> Query -> IO [r]
293query_ conn q@(Query que) = do
294 result <- exec conn que
295 finishQuery conn q result
297-- | Perform a @SELECT@ or other SQL query that is expected to return
298-- results. Results are streamed incrementally from the server, and
299-- consumed via a left fold.
301-- The result consumer must be carefully written to execute
302-- quickly. If the consumer is slow, server resources will be tied up,
303-- and other clients may not be able to update the tables from which
304-- the results are being streamed.
306-- When dealing with small results, it may be simpler (and perhaps
307-- faster) to use 'query' instead.
309-- This fold is /not/ strict. The stream consumer is responsible for
310-- forcing the evaluation of its result to avoid space leaks.
312-- Exceptions that may be thrown:
314-- * 'FormatError': the query string could not be formatted correctly.
316-- * 'QueryError': the result contains no columns (i.e. you should be
317-- using 'execute' instead of 'query').
319-- * 'ResultError': result conversion failed.
320fold :: (QueryParams q, QueryResults r) =>
322 -> Query -- ^ Query template.
323 -> q -- ^ Query parameters.
324 -> a -- ^ Initial state for result consumer.
325 -> (a -> r -> IO a) -- ^ Result consumer.
327fold conn template qs z f = do
328 Base.query conn =<< formatQuery conn template qs
329 finishFold conn template z f
332-- | A version of 'fold' that does not perform query substitution.
333fold_ :: (QueryResults r) =>
336 -> a -- ^ Initial state for result consumer.
337 -> (a -> r -> IO a) -- ^ Result consumer.
339fold_ conn q@(Query que) z f = do
341 finishFold conn q z f
344-- | A version of 'fold' that does not transform a state value.
345forEach :: (QueryParams q, QueryResults r) =>
347 -> Query -- ^ Query template.
348 -> q -- ^ Query parameters.
349 -> (r -> IO ()) -- ^ Result consumer.
351forEach conn template qs = fold conn template qs () . const
352{-# INLINE forEach #-}
354-- | A version of 'forEach' that does not perform query substitution.
355forEach_ :: (QueryResults r) =>
357 -> Query -- ^ Query template.
358 -> (r -> IO ()) -- ^ Result consumer.
360forEach_ conn template = fold_ conn template () . const
361{-# INLINE forEach_ #-}
364forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]
365forM' lo hi m = loop hi []
373finishQuery :: (QueryResults r) => Connection -> Query -> PQ.Result -> IO [r]
374finishQuery conn q result = do
375 status <- PQ.resultStatus result
377 PQ.EmptyQuery -> fail "empty query" -- FIXME: error message
379 throwIO $ QueryError "query resulted in a command response" q
381 ncols <- PQ.nfields result
382 fields <- forM' 0 (ncols-1) $ \column -> do
383 type_oid <- PQ.ftype result column
384 typename <- getTypename conn type_oid
386 nrows <- PQ.ntuples result
387 forM' 0 (nrows-1) $ \row -> do
388 values <- forM' 0 (ncols-1) (\col -> PQ.getvalue' result row col)
389 case convertResults fields values of
390 Left err -> throwIO err
392 PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"
393 PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"
395 errormsg <- maybe "" id <$> PQ.resultErrorMessage result
396 statusmsg <- PQ.resStatus status
397 state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
398 throw $ SqlError { sqlState = state
399 , sqlNativeError = 0 -- FIXME
400 , sqlErrorMsg = B.concat [ "execute: ", statusmsg
404withResult (Base.storeResult conn) q $ \r fs -> do
406/ flip fix [] $ \loop acc -> do
407 row <- Base.fetchRow r
409 [] -> return (reverse acc)
410 _ -> let !c = convertResults fs row
414finishFold :: (QueryResults r) =>
415 Connection -> Query -> a -> (a -> r -> IO a) -> IO a
416finishFold conn q z0 f = withResult (Base.useResult conn) q $ \r fs ->
417 flip fix z0 $ \loop z -> do
418 row <- Base.fetchRow r
421 _ -> (f z $! convertResults fs row) >>= loop
424withResult :: (IO Result) -> Query -> (Result -> [Field] -> IO a) -> IO a
425withResult fetchResult q act = bracket fetchResult Base.freeResult $ \r -> do
426 ncols <- Base.fieldCount (Right r)
428 then throwIO $ QueryError "query resulted in zero-column result" q
429 else act r =<< Base.fetchFields r
431-- | Execute an action inside a SQL transaction.
433-- This function initiates a transaction with a \"@begin
434-- transaction@\" statement, then executes the supplied action. If
435-- the action succeeds, the transaction will be completed with
436-- 'Base.commit' before this function returns.
438-- If the action throws /any/ kind of exception (not just a
439-- MySQL-related exception), the transaction will be rolled back using
440-- 'Base.rollback', then the exception will be rethrown.
441withTransaction :: Connection -> IO a -> IO a
442withTransaction conn act = do
444 r <- act `onException` rollback conn
448-- | Rollback a transaction.
449-- rollback :: (MonadCatchIO m,MonadIO m) => Connection -> m ()
450rollback :: Connection -> IO ()
452 _ <- execute_ conn "ABORT;"
455-- | Commit a transaction.
456-- commit :: (MonadCatchIO m,MonadIO m) => Connection -> m ()
457commit :: Connection -> IO ()
459 _ <- execute_ conn "COMMIT;"
462-- | Begin a transaction.
463-- begin :: (MonadCatchIO m,MonadIO m) => Connection -> m ()
464begin :: Connection -> IO ()
466 _ <- execute_ conn "BEGIN;"
469fmtError :: String -> Query -> [Action] -> a
470fmtError msg q xs = throw FormatError {
473 , fmtParams = map twiddle xs
475 where twiddle (Plain b) = toByteString b
476 twiddle (Escape s) = s
477 twiddle (Many ys) = B.concat (map twiddle ys)
481-- SQL-based applications are somewhat notorious for their
482-- susceptibility to attacks through the injection of maliciously
483-- crafted data. The primary reason for widespread vulnerability to
484-- SQL injections is that many applications are sloppy in handling
485-- user data when constructing SQL queries.
487-- This library provides a 'Query' type and a parameter substitution
488-- facility to address both ease of use and security.
492-- A 'Query' is a @newtype@-wrapped 'ByteString'. It intentionally
493-- exposes a tiny API that is not compatible with the 'ByteString'
494-- API; this makes it difficult to construct queries from fragments of
495-- strings. The 'query' and 'execute' functions require queries to be
498-- To most easily construct a query, enable GHC's @OverloadedStrings@
499-- language extension and write your query as a normal literal string.
501-- > {-# LANGUAGE OverloadedStrings #-}
503-- > import Database.MySQL.Simple
506-- > conn <- connect defaultConnectInfo
507-- > query conn "select 2 + 2"
509-- A 'Query' value does not represent the actual query that will be
510-- executed, but is a template for constructing the final query.
514-- Since applications need to be able to construct queries with
515-- parameters that change, this library provides a query substitution
518-- The 'Query' template accepted by 'query' and 'execute' can contain
519-- any number of \"@?@\" characters. Both 'query' and 'execute'
520-- accept a third argument, typically a tuple. When constructing the
521-- real query to execute, these functions replace the first \"@?@\" in
522-- the template with the first element of the tuple, the second
523-- \"@?@\" with the second element, and so on. If necessary, each
524-- tuple element will be quoted and escaped prior to substitution;
525-- this defeats the single most common injection vector for malicious
528-- For example, given the following 'Query' template:
530-- > select * from user where first_name = ? and age > ?
532-- And a tuple of this form:
534-- > ("Boris" :: String, 37 :: Int)
536-- The query to be executed will look like this after substitution:
538-- > select * from user where first_name = 'Boris' and age > 37
540-- If there is a mismatch between the number of \"@?@\" characters in
541-- your template and the number of elements in your tuple, a
542-- 'FormatError' will be thrown.
544-- Note that the substitution functions do not attempt to parse or
545-- validate your query. It's up to you to write syntactically valid
546-- SQL, and to ensure that each \"@?@\" in your query template is
547-- matched with the right tuple element.
551-- Automated type inference means that you will often be able to avoid
552-- supplying explicit type signatures for the elements of a tuple.
553-- However, sometimes the compiler will not be able to infer your
554-- types. Consider a care where you write a numeric literal in a
557-- > query conn "select ? + ?" (40,2)
559-- The above query will be rejected by the compiler, because it does
560-- not know the specific numeric types of the literals @40@ and @2@.
561-- This is easily fixed:
563-- > query conn "select ? + ?" (40 :: Double, 2 :: Double)
565-- The same kind of problem can arise with string literals if you have
566-- the @OverloadedStrings@ language extension enabled. Again, just
567-- use an explicit type signature if this happens.
571-- Haskell lacks a single-element tuple type, so if you have just one
572-- value you want substituted into a query, what should you do?
574-- The obvious approach would appear to be something like this:
576-- > instance (Param a) => QueryParam a where
579-- Unfortunately, this wreaks havoc with type inference, so we take a
580-- different tack. To represent a single value @val@ as a parameter, write
581-- a singleton list @[val]@, use 'Just' @val@, or use 'Only' @val@.
583-- Here's an example using a singleton list:
585-- > execute conn "insert into users (first_name) values (?)"
590-- Suppose you want to write a query using an @IN@ clause:
592-- > select * from users where first_name in ('Anna', 'Boris', 'Carla')
594-- In such cases, it's common for both the elements and length of the
595-- list after the @IN@ keyword to vary from query to query.
597-- To address this case, use the 'In' type wrapper, and use a single
598-- \"@?@\" character to represent the list. Omit the parentheses
599-- around the list; these will be added for you.
603-- > query conn "select * from users where first_name in ?" $
604-- > In ["Anna", "Boris", "Carla"]
606-- If your 'In'-wrapped list is empty, the string @\"(null)\"@ will be
607-- substituted instead, to ensure that your clause remains
608-- syntactically valid.
612-- If you know that you have many rows of data to insert into a table,
613-- it is much more efficient to perform all the insertions in a single
614-- multi-row @INSERT@ statement than individually.
616-- The 'executeMany' function is intended specifically for helping
617-- with multi-row @INSERT@ and @UPDATE@ statements. Its rules for
618-- query substitution are different than those for 'execute'.
620-- What 'executeMany' searches for in your 'Query' template is a
621-- single substring of the form:
625-- The rules are as follows:
627-- * The keyword @VALUES@ is matched case insensitively.
629-- * There must be no other \"@?@\" characters anywhere in your
632-- * There must one or more \"@?@\" in the parentheses.
634-- * Extra white space is fine.
636-- The last argument to 'executeMany' is a list of parameter
637-- tuples. These will be substituted into the query where the @(?,?)@
638-- string appears, in a form suitable for use in a multi-row @INSERT@
641-- Here is an example:
644-- > "insert into users (first_name,last_name) values (?,?)"
645-- > [("Boris","Karloff"),("Ed","Wood")]
647-- The query that will be executed here will look like this
648-- (reformatted for tidiness):
650-- > insert into users (first_name,last_name) values
651-- > ('Boris','Karloff'),('Ed','Wood')
655-- The 'query' and 'query_' functions return a list of values in the
656-- 'QueryResults' typeclass. This class performs automatic extraction
657-- and type conversion of rows from a query result.
659-- Here is a simple example of how to extract results:
661-- > import qualified Data.Text as Text
663-- > xs <- query_ conn "select name,age from users"
664-- > forM_ xs $ \(name,age) ->
665-- > putStrLn $ Text.unpack name ++ " is " ++ show (age :: Int)
667-- Notice two important details about this code:
669-- * The number of columns we ask for in the query template must
670-- exactly match the number of elements we specify in a row of the
671-- result tuple. If they do not match, a 'ResultError' exception
674-- * Sometimes, the compiler needs our help in specifying types. It
675-- can infer that @name@ must be a 'Text', due to our use of the
676-- @unpack@ function. However, we have to tell it the type of @age@,
677-- as it has no other information to determine the exact type.
681-- The type of a result tuple will look something like this:
685-- Although SQL can accommodate @NULL@ as a value for any of these
686-- types, Haskell cannot. If your result contains columns that may be
687-- @NULL@, be sure that you use 'Maybe' in those positions of of your
690-- > (Text, Maybe Int, Int)
692-- If 'query' encounters a @NULL@ in a row where the corresponding
693-- Haskell type is not 'Maybe', it will throw a 'ResultError'
698-- To specify that a query returns a single-column result, use the
701-- > xs <- query_ conn "select id from users"
702-- > forM_ xs $ \(Only dbid) -> {- ... -}
706-- Conversion of SQL values to Haskell values is somewhat
707-- permissive. Here are the rules.
709-- * For numeric types, any Haskell type that can accurately represent
710-- all values of the given MySQL type is considered \"compatible\".
711-- For instance, you can always extract a MySQL @TINYINT@ column to
712-- a Haskell 'Int'. The Haskell 'Float' type can accurately
713-- represent MySQL integer types of size up to @INT24@, so it is
714-- considered compatble with those types.
716-- * A numeric compatibility check is based only on the type of a
717-- column, /not/ on its values. For instance, a MySQL @LONG_LONG@
718-- column will be considered incompatible with a Haskell 'Int8',
719-- even if it contains the value @1@.
721-- * If a numeric incompatibility is found, 'query' will throw a
724-- * The 'String' and 'Text' types are assumed to be encoded as
725-- UTF-8. If you use some other encoding, decoding may fail or give
726-- wrong results. In such cases, write a @newtype@ wrapper and a
727-- custom 'Result' instance to handle your encoding.
729getTypename :: Connection -> PQ.Oid -> IO ByteString
730getTypename conn@Connection{..} oid =
731 case oid2builtin oid of
732 Just builtin -> return $! builtin2typname builtin
734 oidmap <- takeMVar connectionObjects
735 case IntMap.lookup (oid2int oid) oidmap of
736 Just name -> putMVar connectionObjects oidmap >> return name
738 names <- query conn "SELECT typname FROM pg_type WHERE oid=?"
740 name <- case names of
741 [] -> return $ throw SqlError {
743 sqlErrorMsg = "invalid type oid",
747 _ -> fail "typename query returned more than one result"
748 -- oid is a primary key, so the query should
749 -- never return more than one result
750 putMVar connectionObjects (IntMap.insert (oid2int oid) name oidmap)
753 putMVar connectionObjects oidmap
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list