diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -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 diff --git a/src/Database/PostgreSQL/Simple.hs b/src/Database/PostgreSQL/Simple.hs --- a/src/Database/PostgreSQL/Simple.hs +++ b/src/Database/PostgreSQL/Simple.hs @@ -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 -- diff --git a/src/Database/PostgreSQL/Simple/Internal.hs b/src/Database/PostgreSQL/Simple/Internal.hs --- a/src/Database/PostgreSQL/Simple/Internal.hs +++ b/src/Database/PostgreSQL/Simple/Internal.hs @@ -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 +-- See -- for more information. Here is an example with some -- of the most commonly used parameters: -- @@ -184,6 +202,16 @@ -- -- See -- 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