postgresql-simple 0.1.1 → 0.1.2
raw patch · 6 files changed
+140/−88 lines, 6 filesdep +HUnitdep +cryptohashdep +postgresql-simpledep ~attoparsecdep ~basedep ~bytestring
Dependencies added: HUnit, cryptohash, postgresql-simple
Dependency ranges changed: attoparsec, base, bytestring, text
Files
- postgresql-simple.cabal +19/−4
- src/Database/PostgreSQL/Simple.hs +37/−65
- src/Database/PostgreSQL/Simple/FromRow.hs +1/−1
- src/Database/PostgreSQL/Simple/Internal.hs +66/−0
- src/Database/PostgreSQL/Simple/ToField.hs +16/−17
- src/Database/PostgreSQL/Simple/Types.hs +1/−1
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.1.1+Version: 0.1.2 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -12,7 +12,7 @@ Category: Database Build-type: Simple -Cabal-version: >=1.6+Cabal-version: >= 1.9.2 Library hs-source-dirs: src@@ -37,7 +37,6 @@ Build-depends: attoparsec >= 0.8.5.3, base < 5,- base16-bytestring, blaze-builder, blaze-textual, bytestring >= 0.9,@@ -63,4 +62,20 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.1.1+ tag: v0.1.2++test-suite test+ type: exitcode-stdio-1.0++ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Bytea++ build-depends: base+ , base16-bytestring+ , bytestring+ , cryptohash+ , HUnit+ , postgresql-simple+ , text
src/Database/PostgreSQL/Simple.hs view
@@ -54,6 +54,7 @@ , In(..) , Binary(..) , Only(..)+ , (:.)(..) -- ** Exceptions , SqlError(..) , FormatError(fmtMessage, fmtQuery, fmtParams)@@ -113,7 +114,6 @@ ( Exception, onException, throw, throwIO, finally ) import Control.Monad (foldM) import Data.ByteString (ByteString)-import Data.Char(ord) import Data.Int (Int64) import qualified Data.IntMap as IntMap import Data.List (intersperse)@@ -128,11 +128,13 @@ import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Database.PostgreSQL.Simple.Types- ( Binary(..), In(..), Only(..), Query(..) )+ ( Binary(..), In(..), Only(..), Query(..), (:.)(..) ) import Database.PostgreSQL.Simple.Internal as Base import qualified Database.PostgreSQL.LibPQ as PQ import Text.Regex.PCRE.Light (compile, caseless, match) import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict@@ -148,15 +150,6 @@ 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@@ -202,16 +195,29 @@ \([^?]*)$" [caseless] -escapeStringConn :: Connection -> ByteString -> IO (Maybe ByteString)-escapeStringConn conn s = withConnection conn $ \c -> do- PQ.escapeStringConn c s+escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)+escapeStringConn conn s =+ withConnection conn $ \c ->+ PQ.escapeStringConn c s >>= checkError c +escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)+escapeByteaConn conn s =+ withConnection conn $ \c ->+ PQ.escapeByteaConn c s >>= checkError c++checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)+checkError _ (Just x) = return $ Right x+checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c+ buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs- where quote = inQuotes . fromByteString . maybe undefined id- sub (Plain b) = pure b- sub (Escape s) = quote <$> escapeStringConn conn s- sub (Many ys) = mconcat <$> mapM sub ys+ where quote = either (\msg -> fmtError (utf8ToString msg) q xs)+ (inQuotes . fromByteString)+ utf8ToString = T.unpack . TE.decodeUtf8+ sub (Plain b) = pure b+ sub (Escape s) = quote <$> escapeStringConn conn s+ sub (EscapeBytea s) = quote <$> escapeByteaConn conn 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@@ -231,12 +237,6 @@ result <- exec conn =<< formatQuery conn template qs finishExecute conn template result --- | A version of 'execute' that does not perform query substitution.-execute_ :: Connection -> Query -> IO Int64-execute_ conn q@(Query stmt) = do- result <- exec conn stmt- finishExecute conn q result- -- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not -- expected to return results. --@@ -249,44 +249,6 @@ result <- exec conn =<< formatMany conn q qs finishExecute conn q result -finishExecute :: Connection -> Query -> PQ.Result -> IO Int64-finishExecute _conn q result = do- status <- PQ.resultStatus result- case status of- PQ.CommandOk -> do- ncols <- PQ.nfields result- if ncols /= 0- then throwIO $ QueryError ("execute resulted in " ++ show ncols ++- "-column result") q- else do- nstr <- PQ.cmdTuples result- return $ case nstr of- Nothing -> 0 -- is this appropriate?- Just str -> toInteger str- PQ.TuplesOk -> do- ncols <- PQ.nfields result- throwIO $ QueryError ("execute resulted in " ++ show ncols ++- "-column result") q- PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"- PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"- _ -> do- errormsg <- maybe "" id <$> PQ.resultErrorMessage result- statusmsg <- PQ.resStatus status- state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate- throwIO $ SqlError { sqlState = state- , sqlNativeError = fromEnum status- , sqlErrorMsg = B.concat [ "execute: ", statusmsg- , ": ", errormsg ]}- where- toInteger str = B.foldl' delta 0 str- where- delta acc c =- if '0' <= c && c <= '9'- then 10 * acc + fromIntegral (ord c - ord '0')- else error ("finishExecute: not an int: " ++ B.unpack str)--- -- | Perform a @SELECT@ or other SQL query that is expected to return -- results. All results are retrieved and converted before this -- function returns.@@ -467,6 +429,8 @@ finishQuery conn q result = do status <- PQ.resultStatus result case status of+ PQ.EmptyQuery ->+ throwIO $ QueryError "query: Empty query" q PQ.CommandOk -> do throwIO $ QueryError "query resulted in a command response" q PQ.TuplesOk -> do@@ -494,6 +458,13 @@ Errors [] -> throwIO $ ConversionFailed "" "" "unknown error" Errors [x] -> throwIO x Errors xs -> throwIO $ ManyErrors xs+ PQ.CopyOut ->+ throwIO $ QueryError "query: COPY TO is not supported" q+ PQ.CopyIn ->+ throwIO $ QueryError "query: COPY FROM is not supported" q+ PQ.BadResponse -> throwResultError "query" result status+ PQ.NonfatalError -> throwResultError "query" result status+ PQ.FatalError -> throwResultError "query" result status ellipsis :: ByteString -> ByteString ellipsis bs@@ -611,9 +582,10 @@ , fmtQuery = q , fmtParams = map twiddle xs }- where twiddle (Plain b) = toByteString b- twiddle (Escape s) = s- twiddle (Many ys) = B.concat (map twiddle ys)+ where twiddle (Plain b) = toByteString b+ twiddle (Escape s) = s+ twiddle (EscapeBytea s) = s+ twiddle (Many ys) = B.concat (map twiddle ys) -- $use --
src/Database/PostgreSQL/Simple/FromRow.hs view
@@ -33,7 +33,7 @@ import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.Simple.Internal import Database.PostgreSQL.Simple.FromField-import Database.PostgreSQL.Simple.Types+import Database.PostgreSQL.Simple.Types ((:.)(..)) import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -25,6 +25,10 @@ import Control.Exception import Control.Concurrent.MVar import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.Char (ord)+import Data.Int (Int64) import qualified Data.IntMap as IntMap import Data.String import Data.Typeable@@ -33,6 +37,7 @@ import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType) import Database.PostgreSQL.Simple.Ok+import Database.PostgreSQL.Simple.Types (Query(..)) import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import qualified Data.Vector as V@@ -86,6 +91,15 @@ instance Exception SqlError +-- | 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+ data ConnectInfo = ConnectInfo { connectHost :: String , connectPort :: Word16@@ -138,6 +152,8 @@ PQ.ConnectionOk -> do connectionHandle <- newMVar conn connectionObjects <- newMVar (IntMap.empty)+ let wconn = Connection{..}+ _ <- execute_ wconn "SET standard_conforming_strings TO on" return Connection{..} _ -> do msg <- maybe "connectPostgreSQL error" id <$> PQ.errorMessage conn@@ -197,6 +213,56 @@ , sqlState = "" } Just res -> do return res++-- | A version of 'execute' that does not perform query substitution.+execute_ :: Connection -> Query -> IO Int64+execute_ conn q@(Query stmt) = do+ result <- exec conn stmt+ finishExecute conn q result++finishExecute :: Connection -> Query -> PQ.Result -> IO Int64+finishExecute _conn q result = do+ status <- PQ.resultStatus result+ case status of+ PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q+ PQ.CommandOk -> do+ ncols <- PQ.nfields result+ if ncols /= 0+ then throwIO $ QueryError ("execute resulted in " ++ show ncols +++ "-column result") q+ else do+ nstr <- PQ.cmdTuples result+ return $ case nstr of+ Nothing -> 0 -- is this appropriate?+ Just str -> toInteger str+ PQ.TuplesOk -> do+ ncols <- PQ.nfields result+ throwIO $ QueryError ("execute resulted in " ++ show ncols +++ "-column result") q+ PQ.CopyOut ->+ throwIO $ QueryError "execute: COPY TO is not supported" q+ PQ.CopyIn ->+ throwIO $ QueryError "execute: COPY FROM is not supported" q+ PQ.BadResponse -> throwResultError "execute" result status+ PQ.NonfatalError -> throwResultError "execute" result status+ PQ.FatalError -> throwResultError "execute" result status+ where+ toInteger str = B8.foldl' delta 0 str+ where+ delta acc c =+ if '0' <= c && c <= '9'+ then 10 * acc + fromIntegral (ord c - ord '0')+ else error ("finishExecute: not an int: " ++ B8.unpack str)++throwResultError :: ByteString -> PQ.Result -> PQ.ExecStatus -> IO a+throwResultError context result status = do+ errormsg <- maybe "" id <$> PQ.resultErrorMessage result+ statusmsg <- PQ.resStatus status+ state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate+ throwIO $ SqlError { sqlState = state+ , sqlNativeError = fromEnum status+ , sqlErrorMsg = B.concat [ context, ": ", statusmsg+ , ": ", errormsg ]} disconnectedError :: SqlError disconnectedError = SqlError {
src/Database/PostgreSQL/Simple/ToField.hs view
@@ -21,13 +21,10 @@ , inQuotes ) where -import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString,- toByteString)+import Blaze.ByteString.Builder (Builder, fromByteString, 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)@@ -58,14 +55,18 @@ -- ^ Escape and enclose in quotes before substituting. Use for all -- text-like types, and anything else that may contain unsafe -- characters when rendered.+ | EscapeBytea ByteString+ -- ^ Escape binary data for use as a @bytea@ literal. Include surrounding+ -- quotes. This is used by the 'Binary' newtype wrapper. | 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+ show (Plain b) = "Plain " ++ show (toByteString b)+ show (Escape b) = "Escape " ++ show b+ show (EscapeBytea b) = "EscapeBytea " ++ show b+ show (Many b) = "Many " ++ show b -- | A type that may be used as a single parameter to a SQL query. class ToField a where@@ -88,16 +89,6 @@ (intersperse (Plain (fromChar ',')) . map toField $ xs) ++ [Plain (fromChar ')')] -instance ToField (Binary SB.ByteString) where- toField (Binary bs) = Plain $ fromByteString "'\\x" `mappend`- fromByteString (B16.encode bs) `mappend`- fromChar '\''--instance ToField (Binary LB.ByteString) where- toField (Binary bs) = Plain $ fromByteString "'\\x" `mappend`- fromLazyByteString (L16.encode bs) `mappend`- fromChar '\''- renderNull :: Action renderNull = Plain (fromByteString "null") @@ -166,6 +157,14 @@ instance ToField Double where toField v | isNaN v || isInfinite v = Plain (inQuotes (double v)) | otherwise = Plain (double v)+ {-# INLINE toField #-}++instance ToField (Binary SB.ByteString) where+ toField (Binary bs) = EscapeBytea bs+ {-# INLINE toField #-}++instance ToField (Binary LB.ByteString) where+ toField (Binary bs) = (EscapeBytea . SB.concat . LB.toChunks) bs {-# INLINE toField #-} instance ToField SB.ByteString where
src/Database/PostgreSQL/Simple/Types.hs view
@@ -107,7 +107,7 @@ newtype In a = In a deriving (Eq, Ord, Read, Show, Typeable, Functor) --- | Wrap a mostly-binary string to be escaped in hexadecimal.+-- | Wrap binary data for use as a @bytea@ value. newtype Binary a = Binary a deriving (Eq, Ord, Read, Show, Typeable, Functor)