e1253f2 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Merge pull request #100 from ibotty/master

add sql identifier newtype using PQ.escapeIdentifier

commite1253f2dfa6d1b5577dd94a399a8e84299d293dc authorLeon P Smith <leon@melding-monads.com> dateMon 17 Mar 2014, 05:51 (13 years ago) parentdbd60f8 7899bdc

4 files changed+69−21

compare with master

unifiedsplit

postgresql-simple.cabal+3−2 src/Database/PostgreSQL/Simple.hs+25−15 src/Database/PostgreSQL/Simple/ToField.hs+21−4 src/Database/PostgreSQL/Simple/Types.hs+20

postgresql-simple.cabal+3−2

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

11Name: postgresql-simple

2−Version: 0.4.0.2

2+Version: 0.4.0.3

33Synopsis: Mid-Level PostgreSQL client library

44Description:

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

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

5959 blaze-textual,

6060 bytestring >= 0.9,

6161 containers,

62− postgresql-libpq >= 0.8,

62+ hashable,

63+ postgresql-libpq >= 0.9,

6364 template-haskell,

6465 text >= 0.11.1,

6566 time,

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

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

287287 skipSpace = B.dropWhile isSpace_ascii

288288

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

290−escapeStringConn conn s =

291− withConnection conn $ \c ->

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

290+escapeStringConn = escapeWrap PQ.escapeStringConn

291+

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

293+escapeIdentifier = escapeWrap PQ.escapeIdentifier

293294

294295escapeByteaConn :: 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 =

296303 withConnection conn $ \c ->

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

304+ f c s >>= checkError c

298305

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

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

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

302309

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

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

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

306− (inQuotes . fromByteString)

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

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

307314 utf8ToString = T.unpack . TE.decodeUtf8

308− sub (Plain b) = pure b

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

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

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

315+ sub (Plain b) = pure b

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

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

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

319+ escapeIdentifier conn s

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

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

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

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

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

606615 , fmtQuery = q

607616 , fmtParams = map twiddle xs

608617 }

609− where twiddle (Plain b) = toByteString b

610− twiddle (Escape s) = s

611− twiddle (EscapeByteA s) = s

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

618+ where twiddle (Plain b) = toByteString b

619+ twiddle (Escape s) = s

620+ twiddle (EscapeByteA s) = s

621+ twiddle (EscapeIdentifier s) = s

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

613623

614624-- $use

615625--

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

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

6161 | EscapeByteA ByteString

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

6363 -- 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.

6468 | Many [Action]

6569 -- ^ Concatenate a series of rendering actions.

6670 deriving (Typeable)

6771

6872instance Show Action where

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

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

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

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

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

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

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

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

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

7378

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

7580class ToField a where

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

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

175180 {-# INLINE toField #-}

176181

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+

177194instance ToField SB.ByteString where

178195 toField = Escape

179196 {-# INLINE toField #-}

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

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

2020 , Only(..)

2121 , In(..)

2222 , Binary(..)

23+ , Identifier(..)

24+ , QualifiedIdentifier(..)

2325 , Query(..)

2426 , Oid(..)

2527 , (:.)(..)

@@ -30,6 +32,7 @@ module Database.PostgreSQL.Simple.Types

3032import Blaze.ByteString.Builder (toByteString)

3133import Control.Arrow (first)

3234import Data.ByteString (ByteString)

35+import Data.Hashable (Hashable(hashWithSalt))

3336import Data.Monoid (Monoid(..))

3437import Data.String (IsString(..))

3538import Data.Typeable (Typeable)

@@ -118,6 +121,23 @@ newtype In a = In a

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

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

120123

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

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

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

127+

128+instance IsString Identifier where

129+ fromString = Identifier . toByteString . Utf8.fromString

130+

131+instance Hashable Identifier where

132+ hashWithSalt i (Identifier t) = hashWithSalt i t

133+

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

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

136+data QualifiedIdentifier = QualifiedIdentifier (Maybe ByteString) ByteString

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

138+

139+instance Hashable QualifiedIdentifier where

140+ hashWithSalt i (QualifiedIdentifier q t) = hashWithSalt i (q, t)

121141

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

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