5cc3d00 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

add sql identifier newtype using PQ.escapeIdentifier

5cc3d00Tobias Florek13 years ago

postgresql-simple.cabal+2−2

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1Name: postgresql-simple

2−Version: 0.4.0.2

2+Version: 0.4.0.3

3Synopsis: Mid-Level PostgreSQL client library

4Description:

5 Mid-Level PostgreSQL client library, forked from mysql-simple.

@@ -59,7 +59,7 @@ Library

59 blaze-textual,

60 bytestring >= 0.9,

61 containers,

62− postgresql-libpq >= 0.8,

62+ postgresql-libpq >= 0.9,

63 template-haskell,

64 text >= 0.11.1,

65 time,

src/Database/PostgreSQL/Simple.hs+25−15

@@ -287,14 +287,21 @@ parseTemplate template =

287 skipSpace = B.dropWhile isSpace_ascii

288

289escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

290−escapeStringConn conn s =

290+escapeStringConn = escapeWrap PQ.escapeStringConn

291− withConnection conn $ \c ->

291+

292− PQ.escapeStringConn c s >>= checkError c

292+escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)

293+escapeIdentifier = escapeWrap PQ.escapeIdentifier

293

294

294escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

295escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

295−escapeByteaConn conn s =

296+escapeByteaConn = escapeWrap PQ.escapeByteaConn

297+

298+escapeWrap :: (PQ.Connection -> ByteString -> IO (Maybe ByteString))

299+ -> Connection

300+ -> ByteString

301+ -> IO (Either ByteString ByteString)

302+escapeWrap f conn s =

296 withConnection conn $ \c ->

303 withConnection conn $ \c ->

297− PQ.escapeByteaConn c s >>= checkError c

304+ f c s >>= checkError c

298

305

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

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

300checkError _ (Just x) = return $ Right x

307checkError _ (Just x) = return $ Right x

@@ -302,13 +309,15 @@ checkError c Nothing = Left . maybe "" id <$> PQ.errorMessage c

302

309

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

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

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

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

305− where quote = either (\msg -> fmtError (utf8ToString msg) q xs)

312+ where err' msg = fmtError (utf8ToString msg) q xs

306− (inQuotes . fromByteString)

313+ quote = either err' (inQuotes . fromByteString)

307 utf8ToString = T.unpack . TE.decodeUtf8

314 utf8ToString = T.unpack . TE.decodeUtf8

308− sub (Plain b) = pure b

315+ sub (Plain b) = pure b

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

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

310− sub (EscapeByteA s) = quote <$> escapeByteaConn conn s

317+ sub (EscapeByteA s) = quote <$> escapeByteaConn conn s

318+ sub (EscapeIdentifier s) = either err' fromByteString <$>

319+ escapeIdentifier conn s

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

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

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

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

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

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

314 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

323 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

@@ -606,10 +615,11 @@ fmtError msg q xs = throw FormatError {

606 , fmtQuery = q

615 , fmtQuery = q

607 , fmtParams = map twiddle xs

616 , fmtParams = map twiddle xs

608 }

617 }

609− where twiddle (Plain b) = toByteString b

618+ where twiddle (Plain b) = toByteString b

610− twiddle (Escape s) = s

619+ twiddle (Escape s) = s

620+ twiddle (EscapeByteA s) = s

611− twiddle (EscapeByteA s) = s

621+ twiddle (EscapeIdentifier s) = s

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

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

613

623

614-- $use

624-- $use

615--

625--

src/Database/PostgreSQL/Simple/ToField.hs+21−4

@@ -61,15 +61,20 @@ data Action =

61 | EscapeByteA ByteString

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

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

64+ | EscapeIdentifier ByteString

65+ -- ^ Escape before substituting. Use for all sql identifiers like

66+ -- table, column names, etc. This is used by the 'Identifier' newtype

67+ -- wrapper.

64 | Many [Action]

68 | Many [Action]

65 -- ^ Concatenate a series of rendering actions.

69 -- ^ Concatenate a series of rendering actions.

66 deriving (Typeable)

70 deriving (Typeable)

68instance Show Action where

72instance Show Action where

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

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

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

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

71− show (EscapeByteA b) = "EscapeByteA " ++ show b

75+ show (EscapeByteA b) = "EscapeByteA " ++ show b

76+ show (EscapeIdentifier b) = "EscapeIdentifier " ++ show b

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

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

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

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

75class ToField a where

80class ToField a where

@@ -174,6 +179,18 @@ instance ToField (Binary LB.ByteString) where

174 toField (Binary bs) = (EscapeByteA . SB.concat . LB.toChunks) bs

179 toField (Binary bs) = (EscapeByteA . SB.concat . LB.toChunks) bs

175 {-# INLINE toField #-}

180 {-# INLINE toField #-}

176

181

182+instance ToField Identifier where

183+ toField (Identifier bs) = EscapeIdentifier bs

184+ {-# INLINE toField #-}

185+

186+instance ToField QualifiedIdentifier where

187+ toField (QualifiedIdentifier (Just s) t) = Many [ EscapeIdentifier s

188+ , Plain (fromChar '.')

189+ , EscapeIdentifier t

190+ ]

191+ toField (QualifiedIdentifier Nothing t) = EscapeIdentifier t

192+ {-# INLINE toField #-}

193+

177instance ToField SB.ByteString where

194instance ToField SB.ByteString where

178 toField = Escape

195 toField = Escape

179 {-# INLINE toField #-}

196 {-# INLINE toField #-}

src/Database/PostgreSQL/Simple/Types.hs+13

@@ -20,6 +20,8 @@ module Database.PostgreSQL.Simple.Types

20 , Only(..)

21 , In(..)

22 , Binary(..)

23+ , Identifier(..)

24+ , QualifiedIdentifier(..)

23 , Query(..)

25 , Query(..)

24 , Oid(..)

26 , Oid(..)

25 , (:.)(..)

27 , (:.)(..)

@@ -118,6 +120,17 @@ newtype In a = In a

118newtype Binary a = Binary {fromBinary :: a}

120newtype Binary a = Binary {fromBinary :: a}

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

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

120

122

123+-- | Wrap text for use as sql identifier, i.e. a table or column name.

124+newtype Identifier = Identifier {fromIdentifier :: ByteString}

125+ deriving (Eq, Ord, Read, Show, Typeable)

126+

127+instance IsString Identifier where

128+ fromString = Identifier . toByteString . Utf8.fromString

129+

130+-- | Wrap text for use as (maybe) qualified identifier, i.e. a table

131+-- with schema, or column with table.

132+data QualifiedIdentifier = QualifiedIdentifier (Maybe ByteString) ByteString

133+ deriving (Eq, Ord, Read, Show, Typeable)

121

134

122-- | Wrap a list for use as a PostgreSQL array.

135-- | Wrap a list for use as a PostgreSQL array.

123newtype PGArray a = PGArray {fromPGArray :: [a]}

136newtype PGArray a = PGArray {fromPGArray :: [a]}