33432ce · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Use PQescapeByteaConn instead of hex for compatibility with Postgres < 9.0

commit33432cedbde4e36a691d11e9b09220a74edd23b9 authorJoey Adams <joeyadams3.14159@gmail.com> dateTue 8 May 2012, 04:30 (14 years ago) parenta7bee4b

4 files changed+43−29

compare with master

unifiedsplit

postgresql-simple.cabal−1 src/Database/PostgreSQL/Simple.hs+26−10 src/Database/PostgreSQL/Simple/ToField.hs+16−17 src/Database/PostgreSQL/Simple/Types.hs+1−1

postgresql-simple.cabal−1

@@ -37,7 +37,6 @@ Library

3737 Build-depends:

3838 attoparsec >= 0.8.5.3,

3939 base < 5,

40− base16-bytestring,

4140 blaze-builder,

4241 blaze-textual,

4342 bytestring >= 0.9,

src/Database/PostgreSQL/Simple.hs+26−10

@@ -133,6 +133,8 @@ import Database.PostgreSQL.Simple.Internal as Base

133133import qualified Database.PostgreSQL.LibPQ as PQ

134134import Text.Regex.PCRE.Light (compile, caseless, match)

135135import qualified Data.ByteString.Char8 as B

136+import qualified Data.Text as T

137+import qualified Data.Text.Encoding as TE

136138import qualified Data.Vector as V

137139import Control.Monad.Trans.Reader

138140import Control.Monad.Trans.State.Strict

@@ -202,16 +204,29 @@ formatMany conn q@(Query template) qs = do

202204 \([^?]*)$"

203205 [caseless]

204206

205−escapeStringConn :: Connection -> ByteString -> IO (Maybe ByteString)

206−escapeStringConn conn s = withConnection conn $ \c -> do

207− PQ.escapeStringConn c s

207+escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

208+escapeStringConn conn s =

209+ withConnection conn $ \c ->

210+ PQ.escapeStringConn c s >>= checkError c

211+

212+escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

213+escapeByteaConn conn s =

214+ withConnection conn $ \c ->

215+ PQ.escapeByteaConn c s >>= checkError c

216+

217+checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)

218+checkError c (Just x) = return $ Right x

219+checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c

208220

209221buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder

210222buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs

211− where quote = inQuotes . fromByteString . maybe undefined id

212− sub (Plain b) = pure b

213− sub (Escape s) = quote <$> escapeStringConn conn s

214− sub (Many ys) = mconcat <$> mapM sub ys

223+ where quote = either (\msg -> fmtError (utf8ToString msg) q xs)

224+ (inQuotes . fromByteString)

225+ utf8ToString = T.unpack . TE.decodeUtf8

226+ sub (Plain b) = pure b

227+ sub (Escape s) = quote <$> escapeStringConn conn s

228+ sub (EscapeBytea s) = quote <$> escapeByteaConn conn s

229+ sub (Many ys) = mconcat <$> mapM sub ys

215230 split s = fromByteString h : if B.null t then [] else split (B.tail t)

216231 where (h,t) = B.break (=='?') s

217232 zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps

@@ -611,9 +626,10 @@ fmtError msg q xs = throw FormatError {

611626 , fmtQuery = q

612627 , fmtParams = map twiddle xs

613628 }

614− where twiddle (Plain b) = toByteString b

615− twiddle (Escape s) = s

616− twiddle (Many ys) = B.concat (map twiddle ys)

629+ where twiddle (Plain b) = toByteString b

630+ twiddle (Escape s) = s

631+ twiddle (EscapeBytea s) = s

632+ twiddle (Many ys) = B.concat (map twiddle ys)

617633

618634-- $use

619635--

src/Database/PostgreSQL/Simple/ToField.hs+16−17

@@ -21,13 +21,10 @@ module Database.PostgreSQL.Simple.ToField

2121 , inQuotes

2222 ) where

2323

24−import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString,

25− toByteString)

24+import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)

2625import Blaze.ByteString.Builder.Char8 (fromChar)

2726import Blaze.Text (integral, double, float)

2827import Data.ByteString (ByteString)

29−import qualified Data.ByteString.Base16 as B16

30−import qualified Data.ByteString.Base16.Lazy as L16

3128import Data.Int (Int8, Int16, Int32, Int64)

3229import Data.List (intersperse)

3330import Data.Monoid (mappend)

@@ -58,14 +55,18 @@ data Action =

5855 -- ^ Escape and enclose in quotes before substituting. Use for all

5956 -- text-like types, and anything else that may contain unsafe

6057 -- characters when rendered.

58+ | EscapeBytea ByteString

59+ -- ^ Escape binary data for use as a @bytea@ literal. Include surrounding

60+ -- quotes. This is used by the 'Binary' newtype wrapper.

6161 | Many [Action]

6262 -- ^ Concatenate a series of rendering actions.

6363 deriving (Typeable)

6464

6565instance Show Action where

66− show (Plain b) = "Plain " ++ show (toByteString b)

67− show (Escape b) = "Escape " ++ show b

68− show (Many b) = "Many " ++ show b

66+ show (Plain b) = "Plain " ++ show (toByteString b)

67+ show (Escape b) = "Escape " ++ show b

68+ show (EscapeBytea b) = "EscapeBytea " ++ show b

69+ show (Many b) = "Many " ++ show b

6970

7071-- | A type that may be used as a single parameter to a SQL query.

7172class ToField a where

@@ -88,16 +89,6 @@ instance (ToField a) => ToField (In [a]) where

8889 (intersperse (Plain (fromChar ',')) . map toField $ xs) ++

8990 [Plain (fromChar ')')]

9091

91−instance ToField (Binary SB.ByteString) where

92− toField (Binary bs) = Plain $ fromByteString "'\\x" `mappend`

93− fromByteString (B16.encode bs) `mappend`

94− fromChar '\''

95−

96−instance ToField (Binary LB.ByteString) where

97− toField (Binary bs) = Plain $ fromByteString "'\\x" `mappend`

98− fromLazyByteString (L16.encode bs) `mappend`

99− fromChar '\''

100−

10192renderNull :: Action

10293renderNull = Plain (fromByteString "null")

10394

@@ -168,6 +159,14 @@ instance ToField Double where

168159 | otherwise = Plain (double v)

169160 {-# INLINE toField #-}

170161

162+instance ToField (Binary SB.ByteString) where

163+ toField (Binary bs) = EscapeBytea bs

164+ {-# INLINE toField #-}

165+

166+instance ToField (Binary LB.ByteString) where

167+ toField (Binary bs) = (EscapeBytea . SB.concat . LB.toChunks) bs

168+ {-# INLINE toField #-}

169+

171170instance ToField SB.ByteString where

172171 toField = Escape

173172 {-# INLINE toField #-}

src/Database/PostgreSQL/Simple/Types.hs+1−1

@@ -107,7 +107,7 @@ newtype Only a = Only {

107107newtype In a = In a

108108 deriving (Eq, Ord, Read, Show, Typeable, Functor)

109109

110−-- | Wrap a mostly-binary string to be escaped in hexadecimal.

110+-- | Wrap binary data for use as a @bytea@ value.

111111newtype Binary a = Binary a

112112 deriving (Eq, Ord, Read, Show, Typeable, Functor)

113113