diff --git a/Database/PostgreSQL/Base.hs b/Database/PostgreSQL/Base.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Base.hs @@ -0,0 +1,580 @@ +{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts, ViewPatterns, NamedFieldPuns, TupleSections #-} + +-- | A front-end implementation for the PostgreSQL database protocol +-- version 3.0 (implemented in PostgreSQL 7.4 and later). + +module Database.PostgreSQL.Base + (begin + ,rollback + ,commit + ,query + ,exec + ,escapeBS + ,connect + ,defaultConnectInfo + ,close + ,withDB + ,withTransaction + ,newPool + ,pconnect + ,withPoolConnection) + where + +import Database.PostgreSQL.Base.Types + +import Control.Concurrent +import Control.Monad +import Control.Monad.CatchIO (MonadCatchIO) +import qualified Control.Monad.CatchIO as E +import Control.Monad.Fix +import Control.Monad.State (MonadState,execStateT,modify) +import Control.Monad.Trans +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.UTF8 as L (toString,fromString) +import Data.ByteString.UTF8 (toString,fromString) +import Data.Int +import Data.List +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.Maybe +import Data.Monoid +import Network +import Prelude +import System.IO hiding (hPutStr) + +-------------------------------------------------------------------------------- +-- Exported values + +-- | Default information for setting up a connection. +-- +-- Defaults are as follows: +-- +-- * Server on @localhost@ +-- +-- * User @postgres@ +-- +-- * No password +-- +-- * Database @test@ +-- +-- * Character set @utf8@ +-- +-- Use as in the following example: +-- +-- > connect defaultConnectInfo { connectHost = "db.example.com" } +defaultConnectInfo :: ConnectInfo +defaultConnectInfo = ConnectInfo { + connectHost = "127.0.0.1" + , connectPort = 5432 + , connectUser = "postgres" + , connectPassword = "" + , connectDatabase = "" + } + +-- | Create a new connection pool. +newPool :: MonadIO m + => ConnectInfo -- ^ Connect info. + -> m Pool +newPool info = liftIO $ do + var <- newMVar $ PoolState { + poolConnections = [] + , poolConnectInfo = info + } + return $ Pool var + +-- | Connect using the connection pool. +pconnect :: MonadIO m => Pool -> m Connection +pconnect (Pool var) = liftIO $ do + modifyMVar var $ \state@PoolState{..} -> do + case poolConnections of + [] -> do conn <- connect poolConnectInfo + return (state,conn) + (conn:conns) -> return (state { poolConnections = conns },conn) + +-- | Restore a connection to the pool. +restore :: MonadIO m => Pool -> Connection -> m () +restore (Pool var) conn = liftIO $ do + handle <- readMVar $ connectionHandle conn + modifyMVar_ var $ \state -> do + case handle of + Nothing -> return state + Just h -> do + eof <- hIsOpen h + if eof + then return state { poolConnections = conn : poolConnections state } + else return state + +-- | Use the connection pool. +withPoolConnection + :: (MonadCatchIO m,MonadIO m) + => Pool -- ^ The connection pool. + -> (Connection -> m a) -- ^ Use the connection. + -> m () +withPoolConnection pool m = do + _ <- E.bracket (pconnect pool) (restore pool) m + return () + +-- | Connect with the given username to the given database. Will throw +-- an exception if it cannot connect. +connect :: MonadIO m => ConnectInfo -> m Connection -- ^ The datase connection. +connect connectInfo@ConnectInfo{..} = liftIO $ withSocketsDo $ do + var <- newEmptyMVar + h <- connectTo connectHost (PortNumber $ fromIntegral connectPort) + hSetBuffering h NoBuffering + putMVar var $ Just h + types <- newMVar IntMap.empty + let conn = Connection var types + authenticate conn connectInfo + return conn + +-- | Run a an action with a connection and close the connection +-- afterwards (protects against exceptions). +withDB :: (MonadCatchIO m,MonadIO m) => ConnectInfo -> (Connection -> m a) -> m a +withDB connectInfo m = E.bracket (liftIO $ connect connectInfo) (liftIO . close) m + +-- | With a transaction, do some action (protects against exceptions). +withTransaction :: (MonadCatchIO m,MonadIO m) => Connection -> m a -> m a +withTransaction conn act = do + begin conn + r <- act `E.onException` rollback conn + commit conn + return r + +-- | Rollback a transaction. +rollback :: (MonadCatchIO m,MonadIO m) => Connection -> m () +rollback conn = do + _ <- exec conn (fromString ("ABORT;" :: String)) + return () + +-- | Commit a transaction. +commit :: (MonadCatchIO m,MonadIO m) => Connection -> m () +commit conn = do + _ <- exec conn (fromString ("COMMIT;" :: String)) + return () + +-- | Begin a transaction. +begin :: (MonadCatchIO m,MonadIO m) => Connection -> m () +begin conn = do + _ <- exec conn (fromString ("BEGIN;" :: String)) + return () + +-- | Close a connection. Can safely be called any number of times. +close :: MonadIO m => Connection -- ^ The connection. + -> m () +close Connection{connectionHandle} = liftIO$ do + modifyMVar_ connectionHandle $ \h -> do + case h of + Just h -> hClose h + Nothing -> return () + return Nothing + +-- | Run a simple query on a connection. +query :: (MonadCatchIO m) + => Connection -- ^ The connection. + -> ByteString -- ^ The query. + -> m ([Field],[[Maybe ByteString]]) +query conn sql = do + result <- execQuery conn sql + case result of + (_,Just ok) -> return ok + _ -> return ([],[]) + +-- | Run a simple query on a connection. +execQuery :: (MonadCatchIO m) + => Connection -- ^ The connection. + -> ByteString -- ^ The query. + -> m (Integer,Maybe ([Field],[[Maybe ByteString]])) +execQuery conn sql = liftIO $ do + withConnection conn $ \h -> do + types <- readMVar $ connectionObjects conn + Result{..} <- sendQuery types h sql + case resultType of + ErrorResponse -> E.throw $ QueryError (fmap L.toString resultError) + EmptyQueryResponse -> E.throw QueryEmpty + _ -> + let tagCount = fromMaybe 0 resultTagRows + in case resultDesc of + Just fields -> return $ (tagCount,Just (fields,resultRows)) + Nothing -> return $ (tagCount,Nothing) + +-- | Exec a command. +exec :: (MonadCatchIO m) + => Connection + -> ByteString + -> m Integer +exec conn sql = do + result <- execQuery conn sql + case result of + (ok,_) -> return ok + +-- | PostgreSQL protocol version supported by this library. +protocolVersion :: Int32 +protocolVersion = 196608 + +-- | Escape a string for PostgreSQL. +escape :: String -> String +escape ('\\':cs) = '\\' : '\\' : escape cs +escape ('\'':cs) = '\'' : '\'' : escape cs +escape (c:cs) = c : escape cs +escape [] = [] + +-- | Escape a string for PostgreSQL. +escapeBS :: ByteString -> ByteString +escapeBS = fromString . escape . toString + +-------------------------------------------------------------------------------- +-- Authentication + +-- | Run the connectInfoentication procedure. +authenticate :: Connection -> ConnectInfo -> IO () +authenticate conn@Connection{..} connectInfo = do + withConnection conn $ \h -> do + sendStartUp h connectInfo + getConnectInfoResponse h connectInfo + objects <- objectIds h + modifyMVar_ connectionObjects (\_ -> return objects) + +-- | Send the start-up message. +sendStartUp :: Handle -> ConnectInfo -> IO () +sendStartUp h ConnectInfo{..} = do + sendBlock h Nothing $ do + int32 protocolVersion + string (fromString "user") ; string (fromString connectUser) + string (fromString "database") ; string (fromString connectDatabase) + zero + +-- | Wait for and process the connectInfoentication response from the server. +getConnectInfoResponse :: Handle -> ConnectInfo -> IO () +getConnectInfoResponse h conninfo = do + (typ,block) <- getMessage h + -- TODO: Handle connectInfo failure. Handle information messages that are + -- sent, maybe store in the connection value for later + -- inspection. + case typ of + AuthenticationOk + | param == 0 -> waitForReady h + | param == 3 -> sendPassClearText h conninfo +-- | param == 5 -> sendPassMd5 h conninfo salt + | otherwise -> E.throw $ UnsupportedAuthenticationMethod param (show block) + where param = decode block :: Int32 + _salt = flip runGet block $ do + _ <- getInt32 + getWord8 + + els -> E.throw $ AuthenticationFailed (show (els,block)) + +-- | Send the pass as clear text and wait for connect response. +sendPassClearText :: Handle -> ConnectInfo -> IO () +sendPassClearText h conninfo@ConnectInfo{..} = do + sendMessage h PasswordMessage $ + string (fromString connectPassword) + getConnectInfoResponse h conninfo + +-- -- | Send the pass as salted MD5 and wait for connect response. +-- sendPassMd5 :: Handle -> ConnectInfo -> Word8 -> IO () +-- sendPassMd5 h conninfo@ConnectInfo{..} salt = do +-- -- TODO: Need md5 library with salt support. +-- sendMessage h PasswordMessage $ +-- string (fromString connectPassword) +-- getConnectInfoResponse h conninfo + +-------------------------------------------------------------------------------- +-- Initialization + +objectIds :: Handle -> IO (IntMap Type) +objectIds h = do + Result{..} <- sendQuery IntMap.empty h q + case resultType of + ErrorResponse -> E.throw $ InitializationError "Couldn't get types." + _ -> return $ IntMap.fromList $ catMaybes $ flip map resultRows $ \row -> + case map toString $ catMaybes row of + [typeName,readMay -> Just objId] -> do + typ <- typeFromName typeName + return (fromIntegral objId,typ) + _ -> Nothing + + where q = fromString ("SELECT typname, oid FROM pg_type" :: String) + +-------------------------------------------------------------------------------- +-- Queries and commands + +-- | Send a simple query. +sendQuery :: IntMap Type -> Handle -> ByteString -> IO Result +sendQuery types h sql = do + sendMessage h Query $ string sql + listener $ \continue -> do + (typ,block) <- liftIO $ getMessage h + let setStatus = modify $ \r -> r { resultType = typ } + case typ of + ReadyForQuery -> + modify $ \r -> r { resultRows = reverse (resultRows r) } + + listenPassively -> do + case listenPassively of + EmptyQueryResponse -> setStatus + CommandComplete -> do setStatus + setCommandTag block + ErrorResponse -> do + modify $ \r -> r { resultError = Just block } + setStatus + RowDescription -> getRowDesc types block + DataRow -> getDataRow block + _ -> return () + + continue + + where emptyResponse = Result [] Nothing Nothing [] UnknownMessageType Nothing + listener m = execStateT (fix m) emptyResponse + +-- | CommandComplete returns a ‘tag’ which indicates how many rows were +-- affected, or returned, as a result of the command. +-- See http://developer.postgresql.org/pgdocs/postgres/protocol-message-formats.html +setCommandTag :: MonadState Result m => L.ByteString -> m () +setCommandTag block = do + modify $ \r -> r { resultTagRows = rows } + where rows = + case tag block of + ["INSERT",_oid,readMay -> Just rows] -> return rows + [cmd,readMay -> Just rows] | cmd `elem` cmds -> return rows + _ -> Nothing + tag = words . concat . map toString . L.toChunks . runGet getString + cmds = ["DELETE","UPDATE","SELECT","MOVE","FETCH"] + +-- | Update the row description of the result. +getRowDesc :: MonadState Result m => IntMap Type -> L.ByteString -> m () +getRowDesc types block = + modify $ \r -> r { + resultDesc = Just (parseFields types (runGet parseMsg block)) + } + where parseMsg = do + fieldCount :: Int16 <- getInt16 + forM [1..fieldCount] $ \_ -> do + name <- getString + objid <- getInt32 + colid <- getInt16 + dtype <- getInt32 + size <- getInt16 + modifier <- getInt32 + code <- getInt16 + return (name,objid,colid,dtype,size,modifier,code) + +-- | Parse a row description. +-- +-- Parts of the row description are: +-- +-- String: The field name. +-- +-- Int32: If the field can be identified as a column of a specific +-- table, the object ID of the table; otherwise zero. +-- +-- Int16: If the field can be identified as a column of a specific +-- table, the attribute number of the column; otherwise zero. +---- +-- Int32: The object ID of the field's data type. +---- +-- Int16: The data type size (see pg_type.typlen). Note that negative +-- values denote variable-width types. +---- +-- Int32: The type modifier (see pg_attribute.atttypmod). The meaning +-- of the modifier is type-specific. +-- +-- Int16: The format code being used for the field. Currently will be +-- zero (text) or one (binary). In a RowDescription returned from the +-- statement variant of Describe, the format code is not yet known and +-- will always be zero. +-- +parseFields :: IntMap Type + -> [(L.ByteString,Int32,Int16,Int32,Int16,Int32,Int16)] + -> [Field] +parseFields types = mapMaybe parse where + parse (_fieldName + ,_ -- parseObjId -> _objectId + ,_ -- parseAttrId -> _attrId + ,parseType types -> typ + ,_ -- parseSize -> _typeSize + ,_ -- parseModifier typ -> _typeModifier + ,parseFormatCode -> formatCode) + = Just $ Field { + fieldType = typ + , fieldFormatCode = formatCode + } + +-- These aren't used (yet). + +-- -- | Parse an object ID. 0 means no object. +-- parseObjId :: Int32 -> Maybe ObjectId +-- parseObjId 0 = Nothing +-- parseObjId n = Just (ObjectId n) + +-- -- | Parse an attribute ID. 0 means no object. +-- parseAttrId :: Int16 -> Maybe ObjectId +-- parseAttrId 0 = Nothing +-- parseAttrId n = Just (ObjectId $ fromIntegral n) + +-- | Parse a number into a type. +parseType :: IntMap Type -> Int32 -> Type +parseType types objId = + case IntMap.lookup (fromIntegral objId) types of + Just typ -> typ + _ -> error $ "parseType: Unknown type given by object-id: " ++ show objId + +typeFromName :: String -> Maybe Type +typeFromName = flip lookup fieldTypes + +fieldTypes :: [(String, Type)] +fieldTypes = + [("bool",Boolean) + ,("int2",Short) + ,("integer",Long) + ,("int",Long) + ,("int4",Long) + ,("int8",LongLong) + ,("timestamptz",TimestampWithZone) + ,("varchar",CharVarying) + ,("text",Text)] + +-- This isn't used yet. +-- | Parse a type's size. +-- parseSize :: Int16 -> Size +-- parseSize (-1) = Varying +-- parseSize n = Size n + +-- This isn't used yet. +-- -- | Parse a type-specific modifier. +-- parseModifier :: Type -> Int32 -> Maybe Modifier +-- parseModifier _typ _modifier = Nothing + +-- | Parse a format code (text or binary). +parseFormatCode :: Int16 -> FormatCode +parseFormatCode 1 = BinaryCode +parseFormatCode _ = TextCode + +-- | Add a data row to the response. +getDataRow :: MonadState Result m => L.ByteString -> m () +getDataRow block = + modify $ \r -> r { resultRows = runGet parseMsg block : resultRows r } + where parseMsg = do + values :: Int16 <- getInt16 + forM [1..values] $ \_ -> do + size <- getInt32 + if size == -1 + then return Nothing + else do v <- getByteString (fromIntegral size) + return (Just v) + +-- TODO: +-- getNotice :: MonadState Result m => L.ByteString -> m () +-- getNotice block = +-- return () +-- modify $ \r -> r { responseNotices = runGet parseMsg block : responseNotices r } +-- where parseMsg = return "" + +typeFromChar :: Char -> Maybe MessageType +typeFromChar c = lookup c types + +charFromType :: MessageType -> Maybe Char +charFromType typ = fmap fst $ find ((==typ).snd) types + +types :: [(Char, MessageType)] +types = [('C',CommandComplete) + ,('T',RowDescription) + ,('D',DataRow) + ,('I',EmptyQueryResponse) + ,('E',ErrorResponse) + ,('Z',ReadyForQuery) + ,('N',NoticeResponse) + ,('R',AuthenticationOk) + ,('Q',Query) + ,('p',PasswordMessage)] + +-- | Blocks until receives ReadyForQuery. +waitForReady :: Handle -> IO () +waitForReady h = loop where + loop = do + (typ,block) <- getMessage h + case typ of + ErrorResponse -> E.throw $ GeneralError $ show block + ReadyForQuery | decode block == 'I' -> return () + _ -> loop + +-------------------------------------------------------------------------------- +-- Connections + +-- | Atomically perform an action with the database handle, if there is one. +withConnection :: Connection -> (Handle -> IO a) -> IO a +withConnection Connection{..} m = do + withMVar connectionHandle $ \h -> do + case h of + Just h -> m h + -- TODO: Use extensible exceptions. + Nothing -> E.throw ConnectionLost + +-- | Send a block of bytes on a handle, prepending the message type +-- and complete length. +sendMessage :: Handle -> MessageType -> Put -> IO () +sendMessage h typ output = + case charFromType typ of + Just char -> sendBlock h (Just char) output + Nothing -> error $ "sendMessage: Bad message type " ++ show typ + +-- | Send a block of bytes on a handle, prepending the complete length. +sendBlock :: Handle -> Maybe Char -> Put -> IO () +sendBlock h typ output = do + L.hPutStr h bytes + where bytes = start `mappend` out + start = runPut $ do + maybe (return ()) (put . toByte) typ + int32 $ fromIntegral int32Size + + fromIntegral (L.length out) + out = runPut output + toByte c = fromIntegral (fromEnum c) :: Word8 + +-- | Get a message (block) from the stream. +getMessage :: Handle -> IO (MessageType,L.ByteString) +getMessage h = do + messageType <- L.hGet h 1 + blockLength <- L.hGet h int32Size + let typ = decode messageType + rest = fromIntegral (decode blockLength :: Int32) - int32Size + block <- L.hGet h rest + return (maybe UnknownMessageType id $ typeFromChar typ,block) + +-------------------------------------------------------------------------------- +-- Binary input/output + +-- | Put a Haskell string, encoding it to UTF-8, and null-terminating it. +string :: B.ByteString -> Put +string s = do putByteString s; zero + +-- | Put a Haskell 32-bit integer. +int32 :: Int32 -> Put +int32 = put + +-- | Put zero-byte terminator. +zero :: Put +zero = put (0 :: Word8) + +-- | To avoid magic numbers, size of a 32-bit integer in bytes. +int32Size :: Int +int32Size = 4 + +getInt16 :: Get Int16 +getInt16 = get + +getInt32 :: Get Int32 +getInt32 = get + +getString :: Get L.ByteString +getString = getLazyByteStringNul + +readMay :: Read a => String -> Maybe a +readMay x = case reads x of + [(v,"")] -> return v + _ -> Nothing diff --git a/Database/PostgreSQL/Base/Types.hs b/Database/PostgreSQL/Base/Types.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Base/Types.hs @@ -0,0 +1,135 @@ +{-# OPTIONS -Wall #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Database.PostgreSQL.Base.Types + (ConnectInfo(..) + ,Connection(..) + ,Field(..) + ,Result(..) + ,Type(..) + ,MessageType(..) + ,Size(..) + ,FormatCode(..) + ,Modifier(..) + ,ObjectId + ,Pool(..) + ,PoolState(..) + ,ConnectionError(..)) + where + +import Control.Concurrent.MVar (MVar) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.Int +import Data.Typeable +import Data.Word +import System.IO (Handle) +import Data.IntMap.Strict (IntMap) +import Control.Exception (Exception) + +data ConnectionError = + QueryError (Maybe String) -- ^ Query returned an error. + | QueryEmpty -- ^ The query was empty. + | AuthenticationFailed String -- ^ Connecting failed due to authentication problem. + | InitializationError String -- ^ Initialization (e.g. getting data types) failed. + | ConnectionLost -- ^ Connection was lost when using withConnection. + | UnsupportedAuthenticationMethod Int32 String -- ^ Unsupported method of authentication (e.g. md5). + | GeneralError String + deriving (Typeable,Show) + +instance Exception ConnectionError where + +-- | Connection configuration. +data ConnectInfo = ConnectInfo { + connectHost :: String + , connectPort :: Word16 + , connectUser :: String + , connectPassword :: String + , connectDatabase :: String + } deriving (Eq,Read,Show,Typeable) + +-- | A database connection. +data Connection = Connection { + connectionHandle :: MVar (Maybe Handle) + , connectionObjects :: MVar (IntMap Type) + } + +-- | Result of a database query. +data Result = + Result { + resultRows :: [[Maybe B.ByteString]] + ,resultDesc :: Maybe [Field] + ,resultError :: Maybe L.ByteString + ,resultNotices :: [String] + ,resultType :: MessageType + ,resultTagRows :: Maybe Integer + } deriving Show + +-- | An internal message type. +data MessageType = + CommandComplete + | RowDescription + | DataRow + | EmptyQueryResponse + | ErrorResponse + | ReadyForQuery + | NoticeResponse + | AuthenticationOk + | Query + | PasswordMessage + | UnknownMessageType + deriving (Show,Eq) + +-- | A field description. +data Field = Field { + fieldType :: Type + ,fieldFormatCode :: FormatCode + } deriving Show + +data Type = + Short -- ^ 2 bytes, small-range integer + | Long -- ^ 4 bytes, usual choice for integer + | LongLong -- ^ 8 bytes large-range integer + | Decimal -- ^ variable, user-specified precision, exact, no limit + | Numeric -- ^ variable, user-specified precision, exact, no limit + | Real -- ^ 4 bytes, variable-precision, inexact + | DoublePrecision -- ^ 8 bytes, variable-precision, inexact + + | CharVarying -- ^ character varying(n), varchar(n), variable-length + | Characters -- ^ character(n), char(n), fixed-length + | Text -- ^ text, variable unlimited length + -- + -- Lazy. Decoded from UTF-8 into Haskell native encoding. + + | Boolean -- ^ boolean, 1 byte, state of true or false + + | Timestamp -- ^ timestamp /without/ time zone + -- + -- More information about PostgreSQL’s dates here: + -- + | TimestampWithZone -- ^ timestamp /with/ time zone + | Date -- ^ date, 4 bytes julian day + | Time -- ^ 8 bytes, time of day (no date) + + deriving (Eq,Enum,Show) + +-- | A field size. +data Size = Varying | Size Int16 + deriving (Eq,Ord,Show) + +-- | A text format code. Will always be TextCode for DESCRIBE queries. +data FormatCode = TextCode | BinaryCode + deriving (Eq,Ord,Show) + +-- | A type-specific modifier. +data Modifier = Modifier + +-- | A PostgreSQL object ID. +type ObjectId = Int + +-- | A connection pool. +data PoolState = PoolState { + poolConnections :: [Connection] + , poolConnectInfo :: ConnectInfo + } + +newtype Pool = Pool { unPool :: MVar PoolState } diff --git a/Database/PostgreSQL/Simple.hs b/Database/PostgreSQL/Simple.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple.hs @@ -0,0 +1,530 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings, DisambiguateRecordFields #-} + +-- | +-- Module: Database.PostgreSQL.Simple +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- A mid-level client library for the MySQL database, aimed at ease of +-- use and high performance. + +module Database.PostgreSQL.Simple + ( + -- * Writing queries + -- $use + + -- ** The Query type + -- $querytype + + -- ** Parameter substitution + -- $subst + + -- *** Type inference + -- $inference + + -- ** Substituting a single parameter + -- $only_param + + -- ** Representing a list of values + -- $in + + -- ** Modifying multiple rows at once + -- $many + + -- * Extracting results + -- $result + + -- ** Handling null values + -- $null + + -- ** Type conversions + -- $types + + -- * Types + ConnectInfo(..) + , Connection + , Query + , In(..) + , Binary(..) + , Only(..) + , ProcessedQuery + , Pool + -- ** Exceptions + , FormatError(fmtMessage, fmtQuery, fmtParams) + , QueryError(qeMessage, qeQuery) + , ResultError(errSQLType, errHaskellType, errMessage) + -- * Connection management + , Base.connect + , Base.defaultConnectInfo + , Base.close + -- * Queries that return results + , query + , query_ + , processQuery + , queryProcessed + -- * Queries that stream results + -- , fold + -- , fold_ + -- , forEach + -- , forEach_ + -- * Statements that do not return results + , execute + , execute_ + , executeMany + -- * Transaction handling + , withTransaction + , Base.commit + , Base.rollback + -- * Helper functions + , formatMany + , formatQuery + , withPoolConnection + , newPool + ) where + +import Blaze.ByteString.Builder (Builder, fromByteString, toByteString) +import Blaze.ByteString.Builder.Char8 (fromChar) +import Control.Applicative ((<$>), pure) +import Control.Exception (Exception, throw) +import Control.Monad (forM) +import Data.ByteString (ByteString) +import Data.List (intersperse) +import Data.Monoid (mappend, mconcat) +import Data.Typeable (Typeable) +import Database.PostgreSQL.Base.Types (ConnectInfo(..),Connection(..),Pool) +import Database.PostgreSQL.Base (withPoolConnection, newPool) +import Database.PostgreSQL.Simple.Param (Action(..), inQuotes) +import Database.PostgreSQL.Simple.QueryParams (QueryParams(..)) +import Database.PostgreSQL.Simple.QueryResults (QueryResults(..)) +import Database.PostgreSQL.Simple.Result (ResultError(..)) +import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..)) +import Text.Regex.PCRE.Light (compile, caseless, match) +import qualified Data.ByteString.Char8 as B +import qualified Database.PostgreSQL.Base as Base +import Data.Monoid + +-- | Exception thrown if a 'Query' could not be formatted correctly. +-- This may occur if the number of \'@?@\' characters in the query +-- string does not match the number of parameters provided. +data FormatError = FormatError { + fmtMessage :: String + , fmtQuery :: Query + , fmtParams :: [ByteString] + } deriving (Eq, Show, Typeable) + +instance Exception FormatError + +-- | Exception thrown if 'query' is used to perform an @INSERT@-like +-- operation, or 'execute' is used to perform a @SELECT@-like operation. +data QueryError = QueryError { + qeMessage :: String + , qeQuery :: Query + } deriving (Eq, Show, Typeable) + +instance Exception QueryError + +-- | Format a query string. + +-- This function is exposed to help with debugging and logging. Do not +-- use it to prepare queries for execution. +-- +-- String parameters are escaped according to the character set in use +-- on the 'Connection'. +-- +-- Throws 'FormatError' if the query string could not be formatted +-- correctly. +formatQuery :: QueryParams q => Query -> q -> IO ByteString +formatQuery q@(Query template) qs + | null xs && '?' `B.notElem` template = return template + | otherwise = toByteString <$> buildQuery q template xs + where xs = renderParams qs + +-- | Format a query string with a variable number of rows. +-- +-- This function is exposed to help with debugging and logging. Do not +-- use it to prepare queries for execution. +-- +-- The query string must contain exactly one substitution group, +-- identified by the SQL keyword \"@VALUES@\" (case insensitive) +-- followed by an \"@(@\" character, a series of one or more \"@?@\" +-- characters separated by commas, and a \"@)@\" character. White +-- space in a substitution group is permitted. +-- +-- Throws 'FormatError' if the query string could not be formatted +-- correctly. +formatMany :: (QueryParams q) => Query -> [q] -> IO ByteString +formatMany q [] = fmtError "no rows supplied" q [] +formatMany q@(Query template) qs = do + case match re template [] of + Just [_,before,qbits,after] -> do + bs <- mapM (buildQuery q qbits . renderParams) qs + return . toByteString . mconcat $ fromByteString before : + intersperse (fromChar ',') bs ++ + [fromByteString after] + _ -> error "formatMany: The query did not match the documented format." + where + re = compile "^([^?]+\\bvalues\\s*)\ + \(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))\ + \([^?]*)$" + [caseless] + +buildQuery :: Query -> ByteString -> [Action] -> IO Builder +buildQuery q template xs = zipParams (split template) <$> mapM sub xs + where sub (Plain b) = pure b + sub (Escape s) = pure $ (inQuotes . fromByteString . Base.escapeBS) s + sub (Many ys) = mconcat <$> mapM sub ys + split s = fromByteString h : if B.null t then [] else split (B.tail t) + where (h,t) = B.break (=='?') s + zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps + zipParams [t] [] = t + zipParams _ _ = fmtError (show (B.count '?' template) ++ + " '?' characters, but " ++ + show (length xs) ++ " parameters") q xs + +-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not +-- expected to return results. +-- +-- Returns the number of rows affected. +-- +-- Throws 'FormatError' if the query could not be formatted correctly. +execute :: (QueryParams q) => Connection -> Query -> q -> IO Integer +execute conn template qs = do + Base.exec conn =<< formatQuery template qs + +-- | A version of 'execute' that does not perform query substitution. +execute_ :: Connection -> Query -> IO Integer +execute_ conn (Query stmt) = do + Base.exec conn stmt + +-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not +-- expected to return results. +-- +-- Returns the number of rows affected. +-- +-- Throws 'FormatError' if the query could not be formatted correctly. +executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Integer +executeMany _ _ [] = return 0 +executeMany conn q qs = do + Base.exec conn =<< formatMany q qs + +-- | Perform a @SELECT@ or other SQL query that is expected to return +-- results. All results are retrieved and converted before this +-- function returns. +-- +-- When processing large results, this function will consume a lot of +-- client-side memory. Consider using 'fold' instead. +-- +-- Exceptions that may be thrown: +-- +-- * 'FormatError': the query string could not be formatted correctly. +-- +-- * 'QueryError': the result contains no columns (i.e. you should be +-- using 'execute' instead of 'query'). +-- +-- * 'ResultError': result conversion failed. +query :: (QueryParams q, QueryResults r) + => Connection -> Query -> q -> IO [r] +query conn template qs = do + q <- formatQuery template qs + (fields,rows) <- Base.query conn q + forM rows $ \row -> let !c = convertResults fields row + in return c + +-- | A version of 'query' that does not perform query substitution. +query_ :: (QueryResults r) => Connection -> Query -> IO [r] +query_ conn (Query q) = do + (fields,rows) <- Base.query conn q + forM rows $ \row -> let !c = convertResults fields row + in return c + +-- | A processed, appendable. query +newtype ProcessedQuery r = ProcessedQuery ByteString + deriving (Monoid,Show) + +-- | Process a query for later use. +processQuery :: (QueryParams q,QueryResults r) => Query -> q -> IO (ProcessedQuery r) +processQuery template qs = fmap ProcessedQuery $ formatQuery template qs + +-- | A version of 'query' that does not perform query substitution. +queryProcessed :: (QueryResults r) => Connection -> ProcessedQuery r -> IO [r] +queryProcessed conn (ProcessedQuery q) = do + (fields,rows) <- Base.query conn q + forM rows $ \row -> let !c = convertResults fields row + in return c + +-- | Execute an action inside a SQL transaction. +-- +-- This function initiates a transaction with a \"@begin +-- transaction@\" statement, then executes the supplied action. If +-- the action succeeds, the transaction will be completed with +-- 'Base.commit' before this function returns. +-- +-- If the action throws /any/ kind of exception (not just a +-- MySQL-related exception), the transaction will be rolled back using +-- 'Base.rollback', then the exception will be rethrown. +withTransaction :: Connection -> IO a -> IO a +withTransaction = Base.withTransaction + +fmtError :: String -> Query -> [Action] -> a +fmtError msg q xs = throw FormatError { + fmtMessage = msg + , fmtQuery = q + , fmtParams = map twiddle xs + } + where twiddle (Plain b) = toByteString b + twiddle (Escape s) = s + twiddle (Many ys) = B.concat (map twiddle ys) + +-- $use +-- +-- SQL-based applications are somewhat notorious for their +-- susceptibility to attacks through the injection of maliciously +-- crafted data. The primary reason for widespread vulnerability to +-- SQL injections is that many applications are sloppy in handling +-- user data when constructing SQL queries. +-- +-- This library provides a 'Query' type and a parameter substitution +-- facility to address both ease of use and security. + +-- $querytype +-- +-- A 'Query' is a @newtype@-wrapped 'ByteString'. It intentionally +-- exposes a tiny API that is not compatible with the 'ByteString' +-- API; this makes it difficult to construct queries from fragments of +-- strings. The 'query' and 'execute' functions require queries to be +-- of type 'Query'. +-- +-- To most easily construct a query, enable GHC's @OverloadedStrings@ +-- language extension and write your query as a normal literal string. +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Database.MySQL.Simple +-- > +-- > hello = do +-- > conn <- connect defaultConnectInfo +-- > query conn "select 2 + 2" +-- +-- A 'Query' value does not represent the actual query that will be +-- executed, but is a template for constructing the final query. + +-- $subst +-- +-- Since applications need to be able to construct queries with +-- parameters that change, this library provides a query substitution +-- capability. +-- +-- The 'Query' template accepted by 'query' and 'execute' can contain +-- any number of \"@?@\" characters. Both 'query' and 'execute' +-- accept a third argument, typically a tuple. When constructing the +-- real query to execute, these functions replace the first \"@?@\" in +-- the template with the first element of the tuple, the second +-- \"@?@\" with the second element, and so on. If necessary, each +-- tuple element will be quoted and escaped prior to substitution; +-- this defeats the single most common injection vector for malicious +-- data. +-- +-- For example, given the following 'Query' template: +-- +-- > select * from user where first_name = ? and age > ? +-- +-- And a tuple of this form: +-- +-- > ("Boris" :: String, 37 :: Int) +-- +-- The query to be executed will look like this after substitution: +-- +-- > select * from user where first_name = 'Boris' and age > 37 +-- +-- If there is a mismatch between the number of \"@?@\" characters in +-- your template and the number of elements in your tuple, a +-- 'FormatError' will be thrown. +-- +-- Note that the substitution functions do not attempt to parse or +-- validate your query. It's up to you to write syntactically valid +-- SQL, and to ensure that each \"@?@\" in your query template is +-- matched with the right tuple element. + +-- $inference +-- +-- Automated type inference means that you will often be able to avoid +-- supplying explicit type signatures for the elements of a tuple. +-- However, sometimes the compiler will not be able to infer your +-- types. Consider a care where you write a numeric literal in a +-- parameter tuple: +-- +-- > query conn "select ? + ?" (40,2) +-- +-- The above query will be rejected by the compiler, because it does +-- not know the specific numeric types of the literals @40@ and @2@. +-- This is easily fixed: +-- +-- > query conn "select ? + ?" (40 :: Double, 2 :: Double) +-- +-- The same kind of problem can arise with string literals if you have +-- the @OverloadedStrings@ language extension enabled. Again, just +-- use an explicit type signature if this happens. + +-- $only_param +-- +-- Haskell lacks a single-element tuple type, so if you have just one +-- value you want substituted into a query, what should you do? +-- +-- The obvious approach would appear to be something like this: +-- +-- > instance (Param a) => QueryParam a where +-- > ... +-- +-- Unfortunately, this wreaks havoc with type inference, so we take a +-- different tack. To represent a single value @val@ as a parameter, write +-- a singleton list @[val]@, use 'Just' @val@, or use 'Only' @val@. +-- +-- Here's an example using a singleton list: +-- +-- > execute conn "insert into users (first_name) values (?)" +-- > ["Nuala"] + +-- $in +-- +-- Suppose you want to write a query using an @IN@ clause: +-- +-- > select * from users where first_name in ('Anna', 'Boris', 'Carla') +-- +-- In such cases, it's common for both the elements and length of the +-- list after the @IN@ keyword to vary from query to query. +-- +-- To address this case, use the 'In' type wrapper, and use a single +-- \"@?@\" character to represent the list. Omit the parentheses +-- around the list; these will be added for you. +-- +-- Here's an example: +-- +-- > query conn "select * from users where first_name in ?" $ +-- > In ["Anna", "Boris", "Carla"] +-- +-- If your 'In'-wrapped list is empty, the string @\"(null)\"@ will be +-- substituted instead, to ensure that your clause remains +-- syntactically valid. + +-- $many +-- +-- If you know that you have many rows of data to insert into a table, +-- it is much more efficient to perform all the insertions in a single +-- multi-row @INSERT@ statement than individually. +-- +-- The 'executeMany' function is intended specifically for helping +-- with multi-row @INSERT@ and @UPDATE@ statements. Its rules for +-- query substitution are different than those for 'execute'. +-- +-- What 'executeMany' searches for in your 'Query' template is a +-- single substring of the form: +-- +-- > values (?,?,?) +-- +-- The rules are as follows: +-- +-- * The keyword @VALUES@ is matched case insensitively. +-- +-- * There must be no other \"@?@\" characters anywhere in your +-- template. +-- +-- * There must one or more \"@?@\" in the parentheses. +-- +-- * Extra white space is fine. +-- +-- The last argument to 'executeMany' is a list of parameter +-- tuples. These will be substituted into the query where the @(?,?)@ +-- string appears, in a form suitable for use in a multi-row @INSERT@ +-- or @UPDATE@. +-- +-- Here is an example: +-- +-- > executeMany conn +-- > "insert into users (first_name,last_name) values (?,?)" +-- > [("Boris","Karloff"),("Ed","Wood")] +-- +-- The query that will be executed here will look like this +-- (reformatted for tidiness): +-- +-- > insert into users (first_name,last_name) values +-- > ('Boris','Karloff'),('Ed','Wood') + +-- $result +-- +-- The 'query' and 'query_' functions return a list of values in the +-- 'QueryResults' typeclass. This class performs automatic extraction +-- and type conversion of rows from a query result. +-- +-- Here is a simple example of how to extract results: +-- +-- > import qualified Data.Text as Text +-- > +-- > xs <- query_ conn "select name,age from users" +-- > forM_ xs $ \(name,age) -> +-- > putStrLn $ Text.unpack name ++ " is " ++ show (age :: Int) +-- +-- Notice two important details about this code: +-- +-- * The number of columns we ask for in the query template must +-- exactly match the number of elements we specify in a row of the +-- result tuple. If they do not match, a 'ResultError' exception +-- will be thrown. +-- +-- * Sometimes, the compiler needs our help in specifying types. It +-- can infer that @name@ must be a 'Text', due to our use of the +-- @unpack@ function. However, we have to tell it the type of @age@, +-- as it has no other information to determine the exact type. + +-- $null +-- +-- The type of a result tuple will look something like this: +-- +-- > (Text, Int, Int) +-- +-- Although SQL can accommodate @NULL@ as a value for any of these +-- types, Haskell cannot. If your result contains columns that may be +-- @NULL@, be sure that you use 'Maybe' in those positions of of your +-- tuple. +-- +-- > (Text, Maybe Int, Int) +-- +-- If 'query' encounters a @NULL@ in a row where the corresponding +-- Haskell type is not 'Maybe', it will throw a 'ResultError' +-- exception. + +-- $only_result +-- +-- To specify that a query returns a single-column result, use the +-- 'Only' type. +-- +-- > xs <- query_ conn "select id from users" +-- > forM_ xs $ \(Only dbid) -> {- ... -} + +-- $types +-- +-- Conversion of SQL values to Haskell values is somewhat +-- permissive. Here are the rules. +-- +-- * For numeric types, any Haskell type that can accurately represent +-- all values of the given MySQL type is considered \"compatible\". +-- For instance, you can always extract a MySQL @TINYINT@ column to +-- a Haskell 'Int'. The Haskell 'Float' type can accurately +-- represent MySQL integer types of size up to @INT24@, so it is +-- considered compatble with those types. +-- +-- * A numeric compatibility check is based only on the type of a +-- column, /not/ on its values. For instance, a MySQL @LONG_LONG@ +-- column will be considered incompatible with a Haskell 'Int8', +-- even if it contains the value @1@. +-- +-- * If a numeric incompatibility is found, 'query' will throw a +-- 'ResultError'. +-- +-- * The 'String' and 'Text' types are assumed to be encoded as +-- UTF-8. If you use some other encoding, decoding may fail or give +-- wrong results. In such cases, write a @newtype@ wrapper and a +-- custom 'Result' instance to handle your encoding. diff --git a/Database/PostgreSQL/Simple/Param.hs b/Database/PostgreSQL/Simple/Param.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple/Param.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, + OverloadedStrings #-} + +-- | +-- Module: Database.PostgreSQL.Simple.Param +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- The 'Param' typeclass, for rendering a parameter to a SQL query. + +module Database.PostgreSQL.Simple.Param + ( + Action(..) + , Param(..) + , inQuotes + ) where + +import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString, + toByteString) +import Blaze.ByteString.Builder.Char8 (fromChar) +import Blaze.Text (integral, double, float) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Base16.Lazy as L16 +import Data.Int (Int8, Int16, Int32, Int64) +import Data.List (intersperse) +import Data.Monoid (mappend) +import Data.Time.Calendar (Day, showGregorian) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (formatTime) +import Data.Time.LocalTime (TimeOfDay) +import Data.Typeable (Typeable) +import Data.Word (Word, Word8, Word16, Word32, Word64) +import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null) +import System.Locale (defaultTimeLocale) +import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 +import qualified Data.ByteString as SB +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as ST +import qualified Data.Text.Encoding as ST +import qualified Data.Text.Lazy as LT + +-- | How to render an element when substituting it into a query. +data Action = + Plain Builder + -- ^ Render without escaping or quoting. Use for non-text types + -- such as numbers, when you are /certain/ that they will not + -- introduce formatting vulnerabilities via use of characters such + -- as spaces or \"@'@\". + | Escape ByteString + -- ^ Escape and enclose in quotes before substituting. Use for all + -- text-like types, and anything else that may contain unsafe + -- characters when rendered. + | Many [Action] + -- ^ Concatenate a series of rendering actions. + deriving (Typeable) + +instance Show Action where + show (Plain b) = "Plain " ++ show (toByteString b) + show (Escape b) = "Escape " ++ show b + show (Many b) = "Many " ++ show b + +-- | A type that may be used as a single parameter to a SQL query. +class Param a where + render :: a -> Action + -- ^ Prepare a value for substitution into a query string. + +instance Param Action where + render a = a + {-# INLINE render #-} + +instance (Param a) => Param (Maybe a) where + render Nothing = renderNull + render (Just a) = render a + {-# INLINE render #-} + +instance (Param a) => Param (In [a]) where + render (In []) = Plain $ fromByteString "(null)" + render (In xs) = Many $ + Plain (fromChar '(') : + (intersperse (Plain (fromChar ',')) . map render $ xs) ++ + [Plain (fromChar ')')] + +instance Param (Binary SB.ByteString) where + render (Binary bs) = Plain $ fromByteString "x'" `mappend` + fromByteString (B16.encode bs) `mappend` + fromChar '\'' + +instance Param (Binary LB.ByteString) where + render (Binary bs) = Plain $ fromByteString "x'" `mappend` + fromLazyByteString (L16.encode bs) `mappend` + fromChar '\'' + +renderNull :: Action +renderNull = Plain (fromByteString "null") + +instance Param Null where + render _ = renderNull + {-# INLINE render #-} + +instance Param Bool where + render = Plain . integral . fromEnum + {-# INLINE render #-} + +instance Param Int8 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Int16 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Int32 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Int where + render = Plain . integral + {-# INLINE render #-} + +instance Param Int64 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Integer where + render = Plain . integral + {-# INLINE render #-} + +instance Param Word8 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Word16 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Word32 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Word where + render = Plain . integral + {-# INLINE render #-} + +instance Param Word64 where + render = Plain . integral + {-# INLINE render #-} + +instance Param Float where + render v | isNaN v || isInfinite v = renderNull + | otherwise = Plain (float v) + {-# INLINE render #-} + +instance Param Double where + render v | isNaN v || isInfinite v = renderNull + | otherwise = Plain (double v) + {-# INLINE render #-} + +instance Param SB.ByteString where + render = Escape + {-# INLINE render #-} + +instance Param LB.ByteString where + render = render . SB.concat . LB.toChunks + {-# INLINE render #-} + +instance Param ST.Text where + render = Escape . ST.encodeUtf8 + {-# INLINE render #-} + +instance Param [Char] where + render = Escape . toByteString . Utf8.fromString + {-# INLINE render #-} + +instance Param LT.Text where + render = render . LT.toStrict + {-# INLINE render #-} + +instance Param UTCTime where + render = Plain . Utf8.fromString . formatTime defaultTimeLocale "'%F %T'" + {-# INLINE render #-} + +instance Param Day where + render = Plain . inQuotes . Utf8.fromString . showGregorian + {-# INLINE render #-} + +instance Param TimeOfDay where + render = Plain . inQuotes . Utf8.fromString . show + {-# INLINE render #-} + +-- | Surround a string with single-quote characters: \"@'@\" +-- +-- This function /does not/ perform any other escaping. +inQuotes :: Builder -> Builder +inQuotes b = quote `mappend` b `mappend` quote + where quote = Utf8.fromChar '\'' diff --git a/Database/PostgreSQL/Simple/QueryParams.hs b/Database/PostgreSQL/Simple/QueryParams.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple/QueryParams.hs @@ -0,0 +1,84 @@ +-- | +-- Module: Database.PostgreSQL.Simple.QueryParams +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- The 'QueryParams' typeclass, for rendering a collection of +-- parameters to a SQL query. +-- +-- Predefined instances are provided for tuples containing up to ten +-- elements. + +module Database.PostgreSQL.Simple.QueryParams + ( + QueryParams(..) + ) where + +import Database.PostgreSQL.Simple.Param (Action(..), Param(..)) +import Database.PostgreSQL.Simple.Types (Only(..)) + +-- | A collection type that can be turned into a list of rendering +-- 'Action's. +-- +-- Instances should use the 'render' method of the 'Param' class +-- to perform conversion of each element of the collection. +class QueryParams a where + renderParams :: a -> [Action] + -- ^ Render a collection of values. + +instance QueryParams () where + renderParams _ = [] + +instance (Param a) => QueryParams (Only a) where + renderParams (Only v) = [render v] + +instance (Param a, Param b) => QueryParams (a,b) where + renderParams (a,b) = [render a, render b] + +instance (Param a, Param b, Param c) => QueryParams (a,b,c) where + renderParams (a,b,c) = [render a, render b, render c] + +instance (Param a, Param b, Param c, Param d) => QueryParams (a,b,c,d) where + renderParams (a,b,c,d) = [render a, render b, render c, render d] + +instance (Param a, Param b, Param c, Param d, Param e) + => QueryParams (a,b,c,d,e) where + renderParams (a,b,c,d,e) = + [render a, render b, render c, render d, render e] + +instance (Param a, Param b, Param c, Param d, Param e, Param f) + => QueryParams (a,b,c,d,e,f) where + renderParams (a,b,c,d,e,f) = + [render a, render b, render c, render d, render e, render f] + +instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g) + => QueryParams (a,b,c,d,e,f,g) where + renderParams (a,b,c,d,e,f,g) = + [render a, render b, render c, render d, render e, render f, render g] + +instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g, + Param h) + => QueryParams (a,b,c,d,e,f,g,h) where + renderParams (a,b,c,d,e,f,g,h) = + [render a, render b, render c, render d, render e, render f, render g, + render h] + +instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g, + Param h, Param i) + => QueryParams (a,b,c,d,e,f,g,h,i) where + renderParams (a,b,c,d,e,f,g,h,i) = + [render a, render b, render c, render d, render e, render f, render g, + render h, render i] + +instance (Param a, Param b, Param c, Param d, Param e, Param f, Param g, + Param h, Param i, Param j) + => QueryParams (a,b,c,d,e,f,g,h,i,j) where + renderParams (a,b,c,d,e,f,g,h,i,j) = + [render a, render b, render c, render d, render e, render f, render g, + render h, render i, render j] + +instance (Param a) => QueryParams [a] where + renderParams = map render diff --git a/Database/PostgreSQL/Simple/QueryResults.hs b/Database/PostgreSQL/Simple/QueryResults.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple/QueryResults.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE BangPatterns, OverloadedStrings #-} + +-- | +-- Module: Database.PostgreSQL.Simple.QueryResults +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- The 'QueryResults' typeclass, for converting a row of results +-- returned by a SQL query into a more useful Haskell representation. +-- +-- Predefined instances are provided for tuples containing up to ten +-- elements. + +module Database.PostgreSQL.Simple.QueryResults + ( QueryResults(..) + , convertError + ) where + +import Control.Exception (throw) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Database.PostgreSQL.Base.Types (Field(fieldType)) +import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..)) +import Database.PostgreSQL.Simple.Types (Only(..)) + +-- | A collection type that can be converted from a list of strings. +-- +-- Instances should use the 'convert' method of the 'Result' class +-- to perform conversion of each element of the collection. +-- +-- This example instance demonstrates how to convert a two-column row +-- into a Haskell pair. Each field in the metadata is paired up with +-- each value from the row, and the two are passed to 'convert'. +-- +-- @ +-- instance ('Result' a, 'Result' b) => 'QueryResults' (a,b) where +-- 'convertResults' [fa,fb] [va,vb] = (a,b) +-- where !a = 'convert' fa va +-- !b = 'convert' fb vb +-- 'convertResults' fs vs = 'convertError' fs vs +-- @ +-- +-- Notice that this instance evaluates each element to WHNF before +-- constructing the pair. By doing this, we guarantee two important +-- properties: +-- +-- * Keep resource usage under control by preventing the construction +-- of potentially long-lived thunks. +-- +-- * Ensure that any 'ResultError' that might arise is thrown +-- immediately, rather than some place later in application code +-- that cannot handle it. +-- +-- You can also declare Haskell types of your own to be instances of +-- 'QueryResults'. +-- +-- @ +-- data User { firstName :: String, lastName :: String } + +-- instance 'QueryResults' User where +-- 'convertResults' [fa,fb] [va,vb] = User a b +-- where !a = 'convert' fa va +-- !b = 'convert' fb vb +-- 'convertResults' fs vs = 'convertError' fs vs +-- @ + +class QueryResults a where + convertResults :: [Field] -> [Maybe ByteString] -> a + -- ^ Convert values from a row into a Haskell collection. + -- + -- This function will throw a 'ResultError' if conversion of the + -- collection fails. + +instance (Result a) => QueryResults (Only a) where + convertResults [fa] [va] = Only a + where !a = convert fa va + convertResults fs vs = convertError fs vs 1 + +instance (Result a, Result b) => QueryResults (a,b) where + convertResults [fa,fb] [va,vb] = (a,b) + where !a = convert fa va; !b = convert fb vb + convertResults fs vs = convertError fs vs 2 + +instance (Result a, Result b, Result c) => QueryResults (a,b,c) where + convertResults [fa,fb,fc] [va,vb,vc] = (a,b,c) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + convertResults fs vs = convertError fs vs 3 + +instance (Result a, Result b, Result c, Result d) => + QueryResults (a,b,c,d) where + convertResults [fa,fb,fc,fd] [va,vb,vc,vd] = (a,b,c,d) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd + convertResults fs vs = convertError fs vs 4 + +instance (Result a, Result b, Result c, Result d, Result e) => + QueryResults (a,b,c,d,e) where + convertResults [fa,fb,fc,fd,fe] [va,vb,vc,vd,ve] = (a,b,c,d,e) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve + convertResults fs vs = convertError fs vs 5 + +instance (Result a, Result b, Result c, Result d, Result e, Result f) => + QueryResults (a,b,c,d,e,f) where + convertResults [fa,fb,fc,fd,fe,ff] [va,vb,vc,vd,ve,vf] = (a,b,c,d,e,f) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve; !f = convert ff vf + convertResults fs vs = convertError fs vs 6 + +instance (Result a, Result b, Result c, Result d, Result e, Result f, + Result g) => + QueryResults (a,b,c,d,e,f,g) where + convertResults [fa,fb,fc,fd,fe,ff,fg] [va,vb,vc,vd,ve,vf,vg] = + (a,b,c,d,e,f,g) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve; !f = convert ff vf + !g = convert fg vg + convertResults fs vs = convertError fs vs 7 + +instance (Result a, Result b, Result c, Result d, Result e, Result f, + Result g, Result h) => + QueryResults (a,b,c,d,e,f,g,h) where + convertResults [fa,fb,fc,fd,fe,ff,fg,fh] [va,vb,vc,vd,ve,vf,vg,vh] = + (a,b,c,d,e,f,g,h) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve; !f = convert ff vf + !g = convert fg vg; !h = convert fh vh + convertResults fs vs = convertError fs vs 8 + +instance (Result a, Result b, Result c, Result d, Result e, Result f, + Result g, Result h, Result i) => + QueryResults (a,b,c,d,e,f,g,h,i) where + convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi] [va,vb,vc,vd,ve,vf,vg,vh,vi] = + (a,b,c,d,e,f,g,h,i) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve; !f = convert ff vf + !g = convert fg vg; !h = convert fh vh; !i = convert fi vi + convertResults fs vs = convertError fs vs 9 + +instance (Result a, Result b, Result c, Result d, Result e, Result f, + Result g, Result h, Result i, Result j) => + QueryResults (a,b,c,d,e,f,g,h,i,j) where + convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi,fj] + [va,vb,vc,vd,ve,vf,vg,vh,vi,vj] = + (a,b,c,d,e,f,g,h,i,j) + where !a = convert fa va; !b = convert fb vb; !c = convert fc vc + !d = convert fd vd; !e = convert fe ve; !f = convert ff vf + !g = convert fg vg; !h = convert fh vh; !i = convert fi vi + !j = convert fj vj + convertResults fs vs = convertError fs vs 10 + +-- | Throw a 'ConversionFailed' exception, indicating a mismatch +-- between the number of columns in the 'Field' and row, and the +-- number in the collection to be converted to. +convertError :: [Field] -> [Maybe ByteString] -> Int -> a +convertError fs vs n = throw $ ConversionFailed + (show (length fs) ++ " values: " ++ show (zip (map fieldType fs) + (map (fmap ellipsis) vs))) + (show n ++ " slots in target type") + "mismatch between number of columns to convert and number in target type" + +ellipsis :: ByteString -> ByteString +ellipsis bs + | B.length bs > 15 = B.take 10 bs `B.append` "[...]" + | otherwise = bs diff --git a/Database/PostgreSQL/Simple/Result.hs b/Database/PostgreSQL/Simple/Result.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple/Result.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances #-} + +-- | +-- Module: Database.PostgreSQL.Simpe.QueryResults +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- The 'Result' typeclass, for converting a single value in a row +-- returned by a SQL query into a more useful Haskell representation. +-- +-- A Haskell numeric type is considered to be compatible with all +-- MySQL numeric types that are less accurate than it. For instance, +-- the Haskell 'Double' type is compatible with the MySQL 'Long' type +-- because it can represent a 'Long' exactly. On the other hand, since +-- a 'Double' might lose precision if representing a 'LongLong', the +-- two are /not/ considered compatible. + +module Database.PostgreSQL.Simple.Result + ( Result(..) + , ResultError(..) + ) where + +#include "MachDeps.h" + +import Control.Applicative ((<$>), (<*>), (<*), (<|>)) +import Control.Exception (Exception, throw) +import Data.Attoparsec.Char8 hiding (Result) +import Data.Bits ((.&.), (.|.), shiftL) +import Data.ByteString (ByteString) +import Data.Int (Int16, Int32, Int64) +import Data.List (foldl') +import Data.Ratio (Ratio) +import Data.Time.Calendar (Day, fromGregorian) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (parseTime) +import Data.Time.LocalTime (TimeOfDay,LocalTime,ZonedTime,makeTimeOfDayValid) +import Data.Typeable (TypeRep, Typeable, typeOf) +import Data.Word (Word, Word16, Word32, Word64) +import Database.PostgreSQL.Base.Types (Field(..),Type(..),FormatCode(..)) +import System.Locale (defaultTimeLocale) +import qualified Data.ByteString as SB +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as ST +import qualified Data.Text.Encoding as ST +import qualified Data.Text.Lazy as LT + +-- | Exception thrown if conversion from a SQL value to a Haskell +-- value fails. +data ResultError = Incompatible { errSQLType :: String + , errHaskellType :: String + , errMessage :: String } + -- ^ The SQL and Haskell types are not compatible. + | UnexpectedNull { errSQLType :: String + , errHaskellType :: String + , errMessage :: String } + -- ^ A SQL @NULL@ was encountered when the Haskell + -- type did not permit it. + | ConversionFailed { errSQLType :: String + , errHaskellType :: String + , errMessage :: String } + -- ^ The SQL value could not be parsed, or could not + -- be represented as a valid Haskell value, or an + -- unexpected low-level error occurred (e.g. mismatch + -- between metadata and actual data in a row). + deriving (Eq, Show, Typeable) + +instance Exception ResultError + +-- | A type that may be converted from a SQL type. +class Result a where + convert :: Field -> Maybe ByteString -> a + -- ^ Convert a SQL value to a Haskell value. + -- + -- Throws a 'ResultError' if conversion fails. + +instance (Result a) => Result (Maybe a) where + convert _ Nothing = Nothing + convert f bs = Just (convert f bs) + +instance Result Bool where + convert _ (Just t) + | str == "t" = True + | str == "f" = False + where str = B8.unpack t + convert f _ = conversionFailed f "Bool" "could not parse" + +instance Result Int16 where + convert = atto ok16 $ signed decimal + +instance Result Int32 where + convert = atto ok32 $ signed decimal + +instance Result Int where + convert = atto okWord $ signed decimal + +instance Result Int64 where + convert = atto ok64 $ signed decimal + +instance Result Integer where + convert = atto ok64 $ signed decimal + +instance Result Word16 where + convert = atto ok16 decimal + +instance Result Word32 where + convert = atto ok32 decimal + +instance Result Word where + convert = atto okWord decimal + +instance Result Word64 where + convert = atto ok64 decimal + +instance Result Float where + convert = atto ok ((fromRational . toRational) <$> double) + where ok = mkCompats [Real,Short,Long] + +instance Result Double where + convert = atto ok double + where ok = mkCompats [Real,DoublePrecision,Short,Long] + +instance Result (Ratio Integer) where + convert = atto ok rational + where ok = mkCompats [Decimal,Numeric,Real,DoublePrecision] + +instance Result SB.ByteString where + convert f = doConvert f okText $ id + +instance Result LB.ByteString where + convert f = LB.fromChunks . (:[]) . convert f + +instance Result ST.Text where + convert f | isText f = doConvert f okText $ ST.decodeUtf8 + | otherwise = incompatible f (typeOf ST.empty) + "attempt to mix binary and text" + +instance Result LT.Text where + convert f = LT.fromStrict . convert f + +instance Result [Char] where + convert f = ST.unpack . convert f + +instance Result LocalTime where + convert f = doConvert f ok $ \bs -> + case parseLocalTime (B8.unpack bs) of + Just t -> t + Nothing -> conversionFailed f "UTCTime" "could not parse" + where ok = mkCompats [TimestampWithZone] + +parseLocalTime :: String -> Maybe LocalTime +parseLocalTime s = + parseTime defaultTimeLocale "%F %T%Q" s <|> + parseTime defaultTimeLocale "%F %T%Q%z" (s ++ "00") + +instance Result ZonedTime where + convert f = doConvert f ok $ \bs -> + case parseZonedTime (B8.unpack bs) of + Just t -> t + Nothing -> conversionFailed f "UTCTime" "could not parse" + where ok = mkCompats [TimestampWithZone] + +parseZonedTime :: String -> Maybe ZonedTime +parseZonedTime s = + parseTime defaultTimeLocale "%F %T%Q%z" (s ++ "00") + +instance Result UTCTime where + convert f = doConvert f ok $ \bs -> + case parseTime defaultTimeLocale "%F %T%Q" (B8.unpack bs) of + Just t -> t + Nothing -> conversionFailed f "UTCTime" "could not parse" + where ok = mkCompats [Timestamp] + +instance Result Day where + convert f = flip (atto ok) f $ date + where ok = mkCompats [Date] + date = fromGregorian <$> (decimal <* char '-') + <*> (decimal <* char '-') + <*> decimal + +instance Result TimeOfDay where + convert f = flip (atto ok) f $ do + hours <- decimal <* char ':' + mins <- decimal <* char ':' + secs <- decimal :: Parser Int + case makeTimeOfDayValid hours mins (fromIntegral secs) of + Just t -> return t + _ -> conversionFailed f "TimeOfDay" "could not parse" + where ok = mkCompats [Time] + +isText :: Field -> Bool +isText f = fieldFormatCode f == TextCode + +newtype Compat = Compat Word32 + +mkCompats :: [Type] -> Compat +mkCompats = foldl' f (Compat 0) . map mkCompat + where f (Compat a) (Compat b) = Compat (a .|. b) + +mkCompat :: Type -> Compat +mkCompat = Compat . shiftL 1 . fromEnum + +compat :: Compat -> Compat -> Bool +compat (Compat a) (Compat b) = a .&. b /= 0 + +okText, ok16, ok32, ok64, okWord :: Compat +okText = mkCompats [CharVarying,Characters,Text] +ok16 = mkCompats [Short] +ok32 = mkCompats [Short,Long] +ok64 = mkCompats [Short,Long,LongLong] +#if WORD_SIZE_IN_BITS < 64 +okWord = ok32 +#else +okWord = ok64 +#endif + +doConvert :: (Typeable a) => + Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a +doConvert f types cvt (Just bs) + | mkCompat (fieldType f) `compat` types = cvt bs + | otherwise = incompatible f (typeOf (cvt undefined)) "types incompatible" +doConvert f _ cvt _ = throw $ UnexpectedNull (show (fieldType f)) + (show (typeOf (cvt undefined))) "" + +incompatible :: Field -> TypeRep -> String -> a +incompatible f r = throw . Incompatible (show (fieldType f)) (show r) + +conversionFailed :: Field -> String -> String -> a +conversionFailed f s = throw . ConversionFailed (show (fieldType f)) s + +atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> a +atto types p0 f = doConvert f types $ go (error "atto") p0 + where + go :: (Typeable a) => a -> Parser a -> ByteString -> a + go dummy p s = + case parseOnly p s of + Left err -> conversionFailed f (show (typeOf dummy)) err + Right v -> v diff --git a/Database/PostgreSQL/Simple/Types.hs b/Database/PostgreSQL/Simple/Types.hs new file mode 100644 --- /dev/null +++ b/Database/PostgreSQL/Simple/Types.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-} + +-- | +-- Module: Database.PostgreSQL.Simple.Types +-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc. +-- License: BSD3 +-- Maintainer: Chris Done +-- Stability: experimental +-- Portability: portable +-- +-- Basic types. + +module Database.PostgreSQL.Simple.Types + ( + Null(..) + , Only(..) + , In(..) + , Binary(..) + , Query(..) + ) where + +import Blaze.ByteString.Builder (toByteString) +import Control.Arrow (first) +import Data.ByteString (ByteString) +import Data.Monoid (Monoid(..)) +import Data.String (IsString(..)) +import Data.Typeable (Typeable) +import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 +import qualified Data.ByteString as B + +-- | A placeholder for the SQL @NULL@ value. +data Null = Null + deriving (Read, Show, Typeable) + +instance Eq Null where + _ == _ = False + _ /= _ = False + +-- | A query string. This type is intended to make it difficult to +-- construct a SQL query by concatenating string fragments, as that is +-- an extremely common way to accidentally introduce SQL injection +-- vulnerabilities into an application. +-- +-- This type is an instance of 'IsString', so the easiest way to +-- construct a query is to enable the @OverloadedStrings@ language +-- extension and then simply write the query in double quotes. +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Database.MySQL.Simple +-- > +-- > q :: Query +-- > q = "select ?" +-- +-- The underlying type is a 'ByteString', and literal Haskell strings +-- that contain Unicode characters will be correctly transformed to +-- UTF-8. +newtype Query = Query { + fromQuery :: ByteString + } deriving (Eq, Ord, Typeable) + +instance Show Query where + show = show . fromQuery + +instance Read Query where + readsPrec i = fmap (first Query) . readsPrec i + +instance IsString Query where + fromString = Query . toByteString . Utf8.fromString + +instance Monoid Query where + mempty = Query B.empty + mappend (Query a) (Query b) = Query (B.append a b) + {-# INLINE mappend #-} + +-- | A single-value \"collection\". +-- +-- This is useful if you need to supply a single parameter to a SQL +-- query, or extract a single column from a SQL result. +-- +-- Parameter example: +-- +-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@ +-- +-- Result example: +-- +-- @xs <- query_ c \"select id from users\" +--forM_ xs $ \\('Only' id) -> {- ... -}@ +newtype Only a = Only { + fromOnly :: a + } deriving (Eq, Ord, Read, Show, Typeable, Functor) + +-- | Wrap a list of values for use in an @IN@ clause. Replaces a +-- single \"@?@\" character with a parenthesized list of rendered +-- values. +-- +-- Example: +-- +-- > query c "select * from whatever where id in ?" (In [3,4,5]) +newtype In a = In a + deriving (Eq, Ord, Read, Show, Typeable, Functor) + +-- | Wrap a mostly-binary string to be escaped in hexadecimal. +newtype Binary a = Binary a + deriving (Eq, Ord, Read, Show, Typeable, Functor) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2011, MailRank, Inc. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,22 @@ +# Work in progress + +I am currently porting the MySQL parts to PostgreSQL, hoping to +maintain the rest of the API verbatim. + +# pgsql-simple: mid-level bindings to PostgreSQL servers + +This library is a mid-level Haskell binding to PostgreSQL servers. It +is aimed at speed and ease of use. + +# Licensing + +This library is BSD-licensed. + +# Authors + +This library is written and maintained by Chris Done, +. + +This library is also directly forked from mysql-simple, written and +maintained by Bryan O'Sullivan, , with the MySQL +parts changed to PostgreSQL, in order to have a consistent API. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/pgsql-simple.cabal b/pgsql-simple.cabal new file mode 100644 --- /dev/null +++ b/pgsql-simple.cabal @@ -0,0 +1,55 @@ +name: pgsql-simple +version: 0.1.1 +homepage: https://github.com/chrisdone/pgsql-simple +bug-reports: https://github.com/chrisdone/pgsql-simple/issues +synopsis: A mid-level PostgreSQL client library. +description: + A mid-level client library for the PostgreSQL database, intended to be + fast and easy to use. +license: BSD3 +license-file: LICENSE +author: Chris Done , Bryan O'Sullivan +maintainer: Chris Done +copyright: 2011 Chris Done, 2011 MailRank, Inc. +category: Database +build-type: Simple +cabal-version: >= 1.6 +extra-source-files: + README.markdown + +library + exposed-modules: + Database.PostgreSQL.Simple + Database.PostgreSQL.Simple.Param + Database.PostgreSQL.Simple.QueryParams + Database.PostgreSQL.Simple.QueryResults + Database.PostgreSQL.Simple.Result + Database.PostgreSQL.Simple.Types + Database.PostgreSQL.Base + Database.PostgreSQL.Base.Types + + build-depends: + attoparsec >= 0.8.5.3, + base < 5, + base16-bytestring, + blaze-builder, + blaze-textual, + bytestring >= 0.9, + pcre-light, + old-locale, + text >= 0.11.0.2, + time, + network >= 2.2, + binary >= 0.5, + mtl >= 2.0, + MonadCatchIO-transformers, + utf8-string, + containers >= 0.5 + + ghc-options: -Wall -O2 + if impl(ghc >= 6.8) + ghc-options: -fwarn-tabs + +source-repository head + type: git + location: http://github.com/chrisdone/pgsql-simple