postgresql-simple 0.4.9.0 → 0.4.10.0
raw patch · 3 files changed
+98/−63 lines, 3 files
Files
- postgresql-simple.cabal +2/−2
- src/Database/PostgreSQL/Simple.hs +13/−60
- src/Database/PostgreSQL/Simple/Internal.hs +83/−1
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.4.9.0+Version: 0.4.10.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -82,7 +82,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.4.9.0+ tag: v0.4.10.0 test-suite test type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs view
@@ -66,9 +66,9 @@ -- ** Exceptions , SqlError(..) , PQ.ExecStatus(..)- , FormatError(fmtMessage, fmtQuery, fmtParams)- , QueryError(qeMessage, qeQuery)- , ResultError(errSQLType, errHaskellType, errMessage)+ , FormatError(..)+ , QueryError(..)+ , ResultError(..) -- * Connection management , Base.connectPostgreSQL , Base.close@@ -114,19 +114,18 @@ ( Builder, fromByteString, toByteString ) import Blaze.ByteString.Builder.Char8 (fromChar) import Blaze.Text ( integral )-import Control.Applicative ((<$>), pure)+import Control.Applicative ((<$>)) import Control.Exception as E import Control.Monad (foldM) import Data.ByteString (ByteString) import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (mconcat)-import Data.Typeable (Typeable) import Database.PostgreSQL.Simple.Compat ( (<>) ) import Database.PostgreSQL.Simple.FromField (ResultError(..)) import Database.PostgreSQL.Simple.FromRow (FromRow(..)) import Database.PostgreSQL.Simple.Ok-import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)+import Database.PostgreSQL.Simple.ToField (Action(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Database.PostgreSQL.Simple.Types ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )@@ -135,22 +134,10 @@ import Database.PostgreSQL.Simple.TypeInfo import qualified Database.PostgreSQL.LibPQ as PQ import qualified Data.ByteString.Char8 as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict --- | 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- -- | Format a query string. -- -- This function is exposed to help with debugging and logging. Do not@@ -286,40 +273,17 @@ skipSpace = B.dropWhile isSpace_ascii -escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)-escapeStringConn = escapeWrap PQ.escapeStringConn -escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)-escapeIdentifier = escapeWrap PQ.escapeIdentifier -escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)-escapeByteaConn = escapeWrap PQ.escapeByteaConn--escapeWrap :: (PQ.Connection -> ByteString -> IO (Maybe ByteString))- -> Connection- -> ByteString- -> IO (Either ByteString ByteString)-escapeWrap f conn s =- withConnection conn $ \c ->- f 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 err' msg = fmtError (utf8ToString msg) q xs- quote = either err' (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 (EscapeIdentifier s) = either err' fromByteString <$>- escapeIdentifier 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+buildQuery conn q template xs =+ zipParams (split template) <$> mapM (buildAction conn q xs) xs+ where split s =+ let (h,t) = B.break (=='?') s+ in fromByteString h+ : if B.null t+ then []+ else split (B.tail t) zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps zipParams [t] [] = t zipParams _ _ = fmtError (show (B.count '?' template) ++@@ -659,17 +623,6 @@ | B.length bs > 15 = B.take 10 bs `B.append` "[...]" | otherwise = bs -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 (EscapeByteA s) = s- twiddle (EscapeIdentifier s) = s- twiddle (Many ys) = B.concat (map twiddle ys) -- $use --
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -20,24 +20,31 @@ module Database.PostgreSQL.Simple.Internal where +import Blaze.ByteString.Builder+ ( Builder, fromByteString, toByteString ) import Control.Applicative import Control.Exception import Control.Concurrent.MVar import Control.Monad(MonadPlus(..)) 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.IORef import Data.Maybe(fromMaybe)+import Data.Monoid import Data.String+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import Data.Typeable import Data.Word import Database.PostgreSQL.LibPQ(Oid(..)) import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.LibPQ(ExecStatus(..)) import Database.PostgreSQL.Simple.Ok+import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes) import Database.PostgreSQL.Simple.Types (Query(..)) import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo) import Control.Monad.Trans.State.Strict@@ -92,6 +99,17 @@ instance Exception QueryError +-- | 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+ data ConnectInfo = ConnectInfo { connectHost :: String , connectPort :: Word16@@ -133,7 +151,7 @@ connect = connectPostgreSQL . postgreSQLConnectionString -- | Attempt to make a connection based on a libpq connection string.--- See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html>+-- See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING> -- for more information. Here is an example with some -- of the most commonly used parameters: --@@ -184,6 +202,16 @@ -- -- See <http://www.postgresql.org/docs/9.3/static/client-authentication.html> -- for more information regarding the authentication process.+--+-- SSL/TLS will typically "just work" if your postgresql server supports or+-- requires it. However, note that libpq is trivially vulnerable to a MITM+-- attack without setting additional SSL parameters in the connection string.+-- In particular, @sslmode@ needs to set be @require@, @verify-ca@, or+-- @verify-full@ to perform certificate validation. When @sslmode@ is+-- @require@, then you will also need to have a @sslrootcert@ file,+-- otherwise no validation of the server's identity will be performed.+-- Client authentication via certificates is also possible via the+-- @sslcert@ and @sslkey@ parameters. connectPostgreSQL :: ByteString -> IO Connection connectPostgreSQL connstr = do@@ -491,3 +519,57 @@ throwLibPQError conn default_desc = do msg <- maybe default_desc id <$> PQ.errorMessage conn throwIO $! libPQError msg+++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 (EscapeByteA s) = s+ twiddle (EscapeIdentifier s) = s+ twiddle (Many ys) = B.concat (map twiddle ys)++fmtErrorBs :: Query -> [Action] -> ByteString -> a+fmtErrorBs q xs msg = fmtError (T.unpack $ TE.decodeUtf8 msg) q xs++-- | Quote bytestring or throw 'FormatError'+quote :: Query -> [Action] -> Either ByteString ByteString -> Builder+quote q xs = either (fmtErrorBs q xs) (inQuotes . fromByteString)++buildAction :: Connection -- ^ Connection for string escaping+ -> Query -- ^ Query for message error+ -> [Action] -- ^ List of parameters for message error+ -> Action -- ^ Action to build+ -> IO Builder+buildAction _ _ _ (Plain b) = pure b+buildAction conn q xs (Escape s) = quote q xs <$> escapeStringConn conn s+buildAction conn q xs (EscapeByteA s) = quote q xs <$> escapeByteaConn conn s+buildAction conn q xs (EscapeIdentifier s) =+ either (fmtErrorBs q xs) fromByteString <$> escapeIdentifier conn s+buildAction conn q xs (Many ys) =+ mconcat <$> mapM (buildAction conn q xs) ys++checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)+checkError _ (Just x) = return $ Right x+checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c++escapeWrap :: (PQ.Connection -> ByteString -> IO (Maybe ByteString))+ -> Connection+ -> ByteString+ -> IO (Either ByteString ByteString)+escapeWrap f conn s =+ withConnection conn $ \c ->+ f c s >>= checkError c++escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)+escapeStringConn = escapeWrap PQ.escapeStringConn++escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)+escapeIdentifier = escapeWrap PQ.escapeIdentifier++escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)+escapeByteaConn = escapeWrap PQ.escapeByteaConn