git.iko.soy/typeable/postgresql-simple
on master help sign in
Use PQescapeByteaConn instead of hex for compatibility with Postgres < 9.0
33432ceJoey Adams
postgresql-simple.cabal−1
compare with master
unifiedsplit
@@ -37,7 +37,6 @@ Library
37 Build-depends:
37 Build-depends:
38 attoparsec >= 0.8.5.3,
38 attoparsec >= 0.8.5.3,
39 base < 5,
39 base < 5,
40− base16-bytestring,
41 blaze-builder,
40 blaze-builder,
42 blaze-textual,
41 blaze-textual,
43 bytestring >= 0.9,
42 bytestring >= 0.9,
src/Database/PostgreSQL/Simple.hs+26−10
@@ -133,6 +133,8 @@ import Database.PostgreSQL.Simple.Internal as Base
133import qualified Database.PostgreSQL.LibPQ as PQ
133import qualified Database.PostgreSQL.LibPQ as PQ
134import Text.Regex.PCRE.Light (compile, caseless, match)
134import Text.Regex.PCRE.Light (compile, caseless, match)
135import qualified Data.ByteString.Char8 as B
135import qualified Data.ByteString.Char8 as B
136+import qualified Data.Text as T
137+import qualified Data.Text.Encoding as TE
136import qualified Data.Vector as V
138import qualified Data.Vector as V
137import Control.Monad.Trans.Reader
139import Control.Monad.Trans.Reader
138import Control.Monad.Trans.State.Strict
140import Control.Monad.Trans.State.Strict
@@ -202,16 +204,29 @@ formatMany conn q@(Query template) qs = do
202 \([^?]*)$"
204 \([^?]*)$"
203 [caseless]
205 [caseless]
204
206
205−escapeStringConn :: Connection -> ByteString -> IO (Maybe ByteString)
207+escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
206−escapeStringConn conn s = withConnection conn $ \c -> do
208+escapeStringConn conn s =
207− PQ.escapeStringConn c 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
208
220
209buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
221buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
210buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs
222buildQuery conn q template xs = zipParams (split template) <$> mapM sub xs
223+ where quote = either (\msg -> fmtError (utf8ToString msg) q xs)
211− where quote = inQuotes . fromByteString . maybe undefined id
224+ (inQuotes . fromByteString)
225+ utf8ToString = T.unpack . TE.decodeUtf8
212− sub (Plain b) = pure b
226+ sub (Plain b) = pure b
213− sub (Escape s) = quote <$> escapeStringConn conn s
227+ sub (Escape s) = quote <$> escapeStringConn conn s
228+ sub (EscapeBytea s) = quote <$> escapeByteaConn conn s
214− sub (Many ys) = mconcat <$> mapM sub ys
229+ sub (Many ys) = mconcat <$> mapM sub ys
215 split s = fromByteString h : if B.null t then [] else split (B.tail t)
230 split s = fromByteString h : if B.null t then [] else split (B.tail t)
216 where (h,t) = B.break (=='?') s
231 where (h,t) = B.break (=='?') s
217 zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps
232 zipParams (t:ts) (p:ps) = t `mappend` p `mappend` zipParams ts ps
@@ -611,9 +626,10 @@ fmtError msg q xs = throw FormatError {
611 , fmtQuery = q
626 , fmtQuery = q
612 , fmtParams = map twiddle xs
627 , fmtParams = map twiddle xs
613 }
628 }
614− where twiddle (Plain b) = toByteString b
629+ where twiddle (Plain b) = toByteString b
615− twiddle (Escape s) = s
630+ twiddle (Escape s) = s
631+ twiddle (EscapeBytea s) = s
616− twiddle (Many ys) = B.concat (map twiddle ys)
632+ twiddle (Many ys) = B.concat (map twiddle ys)
617
633
618-- $use
634-- $use
619--
635--
src/Database/PostgreSQL/Simple/ToField.hs+16−17
@@ -21,13 +21,10 @@ module Database.PostgreSQL.Simple.ToField
21 , inQuotes
21 , inQuotes
22 ) where
22 ) where
23
23
24−import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString,
24+import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
25− toByteString)
26import Blaze.ByteString.Builder.Char8 (fromChar)
25import Blaze.ByteString.Builder.Char8 (fromChar)
27import Blaze.Text (integral, double, float)
26import Blaze.Text (integral, double, float)
28import Data.ByteString (ByteString)
27import Data.ByteString (ByteString)
29−import qualified Data.ByteString.Base16 as B16
30−import qualified Data.ByteString.Base16.Lazy as L16
31import Data.Int (Int8, Int16, Int32, Int64)
28import Data.Int (Int8, Int16, Int32, Int64)
32import Data.List (intersperse)
29import Data.List (intersperse)
33import Data.Monoid (mappend)
30import Data.Monoid (mappend)
@@ -58,14 +55,18 @@ data Action =
58 -- ^ Escape and enclose in quotes before substituting. Use for all
55 -- ^ Escape and enclose in quotes before substituting. Use for all
59 -- text-like types, and anything else that may contain unsafe
56 -- text-like types, and anything else that may contain unsafe
60 -- characters when rendered.
57 -- 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.
61 | Many [Action]
61 | Many [Action]
62 -- ^ Concatenate a series of rendering actions.
62 -- ^ Concatenate a series of rendering actions.
63 deriving (Typeable)
63 deriving (Typeable)
64
64
65instance Show Action where
65instance Show Action where
66− show (Plain b) = "Plain " ++ show (toByteString b)
66+ show (Plain b) = "Plain " ++ show (toByteString b)
67− show (Escape b) = "Escape " ++ show b
67+ show (Escape b) = "Escape " ++ show b
68+ show (EscapeBytea b) = "EscapeBytea " ++ show b
68− show (Many b) = "Many " ++ show b
69+ show (Many b) = "Many " ++ show b
69
70
70-- | A type that may be used as a single parameter to a SQL query.
71-- | A type that may be used as a single parameter to a SQL query.
71class ToField a where
72class ToField a where
@@ -88,16 +89,6 @@ instance (ToField a) => ToField (In [a]) where
88 (intersperse (Plain (fromChar ',')) . map toField $ xs) ++
89 (intersperse (Plain (fromChar ',')) . map toField $ xs) ++
89 [Plain (fromChar ')')]
90 [Plain (fromChar ')')]
90
91
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−
101renderNull :: Action
92renderNull :: Action
102renderNull = Plain (fromByteString "null")
93renderNull = Plain (fromByteString "null")
103
94
@@ -168,6 +159,14 @@ instance ToField Double where
168 | otherwise = Plain (double v)
159 | otherwise = Plain (double v)
169 {-# INLINE toField #-}
160 {-# INLINE toField #-}
170
161
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+
171instance ToField SB.ByteString where
170instance ToField SB.ByteString where
172 toField = Escape
171 toField = Escape
173 {-# INLINE toField #-}
172 {-# INLINE toField #-}
src/Database/PostgreSQL/Simple/Types.hs+1−1
@@ -107,7 +107,7 @@ newtype Only a = Only {
107newtype In a = In a
107newtype In a = In a
108 deriving (Eq, Ord, Read, Show, Typeable, Functor)
108 deriving (Eq, Ord, Read, Show, Typeable, Functor)
109
109
110−-- | Wrap a mostly-binary string to be escaped in hexadecimal.
110+-- | Wrap binary data for use as a @bytea@ value.
111newtype Binary a = Binary a
111newtype Binary a = Binary a
112 deriving (Eq, Ord, Read, Show, Typeable, Functor)
112 deriving (Eq, Ord, Read, Show, Typeable, Functor)
113
113