46004ea · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #6 from echatav/remove-tabulation

Remove tabulation & older PR

commit46004eaabde36350a798838ccb242f3e07b46d2b authorEitan Chatav <eitan.chatav@gmail.com> dateSun 23 Apr 2017, 21:40 (10 years ago) parent82d8618 7034fb3

4 files changed+56−46

compare with dev

unifiedsplit

squeel-postgresql/squeel-postgresql.cabal+1−1 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+8−3 squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+37−38 squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+10−4

squeel-postgresql/squeel-postgresql.cabal+1−1

@@ -36,7 +36,7 @@ library

3636 , uuid

3737 , vinyl

3838

39−test-suite blockapps-data-test

39+test-suite squeel-postgresql-test

4040 default-language: Haskell2010

4141 type: exitcode-stdio-1.0

4242 hs-source-dirs: test

squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+8−3

@@ -24,6 +24,7 @@ import Data.Proxy

2424import Data.Text (Text)

2525import Data.Vinyl

2626import Data.Vinyl.Functor

27+import GHC.TypeLits

2728

2829import qualified Database.PostgreSQL.LibPQ as LibPQ

2930

@@ -33,9 +34,13 @@ import Squeel.PostgreSQL.Type

3334

3435newtype Connection db = Connection { unConnection :: LibPQ.Connection }

3536

36−newtype PQ db0 db1 m x = PQ

37− { runPQ :: Connection db0 -> m (x, Connection db1) }

38− deriving Functor

37+newtype PQ

38+ (db0 :: [(Symbol,[(Symbol,PGType)])])

39+ (db1 :: [(Symbol,[(Symbol,PGType)])])

40+ (m :: * -> *)

41+ (x :: *) =

42+ PQ { runPQ :: Connection db0 -> m (x, Connection db1) }

43+ deriving Functor

3944

4045evalPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m x

4146evalPQ (PQ pq) = fmap fst . pq

squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+37−38

@@ -96,8 +96,11 @@ instance (KnownSymbol label, AllAliased (x' ': xs))

9696 (x :& xs :: Rec (Aliased obj) ('(label, x) ': x' : xs)) =

9797 renderAliased render x <> ", " <> renderAllAliased render xs

9898

99−newtype Expression ps (xs :: [(Symbol,PGType)]) y =

100− UnsafeExpression { renderExpression :: ByteString }

99+newtype Expression

100+ (ps :: [PGType])

101+ (xs :: [(Symbol,PGType)])

102+ (y :: PGType) =

103+ UnsafeExpression { renderExpression :: ByteString }

101104

102105param1 :: Expression (p1:ps) cols p1

103106param1 = UnsafeExpression "$1"

@@ -170,8 +173,11 @@ instance OrdB (Expression ps xs y) where

170173 x <* y = UnsafeExpression $ renderExpression x <> "<" <> renderExpression y

171174 x <=* y = UnsafeExpression $ renderExpression x <> "<=" <> renderExpression y

172175

173−newtype Projection ps xs ys = UnsafeProjection

174− { renderProjection :: ByteString }

176+newtype Projection

177+ (ps :: [PGType])

178+ (xs :: [(Symbol,PGType)])

179+ (ys :: [(Symbol,PGType)]) =

180+ UnsafeProjection { renderProjection :: ByteString }

175181

176182star :: Projection ps xs xs

177183star = UnsafeProjection "*"

@@ -182,22 +188,18 @@ project

182188 -> Projection ps xs ys

183189project = UnsafeProjection . renderAllAliased renderExpression

184190

185−data Tabulation ps xss xs = UnsafeTabulation

186− { renderTabulation :: ByteString }

187−

188−data Relation ps xss xs = Relation

189− { tabulation :: Tabulation ps xss xs

191+data Relation ps xss xs = UnsafeRelation

192+ { relation :: ByteString

190193 , restriction :: Maybe (Expression ps xs 'PGBool)

191194 , limitation :: Maybe (Expression ps '[] 'PGInt8)

192195 , offsetting :: Maybe (Expression ps '[] 'PGInt8)

193196 }

194197

195198renderRelation :: Relation ps xss xs -> ByteString

196−renderRelation (Relation tab wh lim off) =

197− renderTabulation tab

198− <> maybe "" ((" WHERE " <>) . renderExpression) wh

199− <> maybe "" ((" LIMIT " <>) . renderExpression) lim

200− <> maybe "" ((" OFFSET " <>) . renderExpression) off

199+renderRelation (UnsafeRelation rel wh lim off) = rel

200+ <> maybe "" ((" WHERE " <>) . renderExpression) wh

201+ <> maybe "" ((" LIMIT " <>) . renderExpression) lim

202+ <> maybe "" ((" OFFSET " <>) . renderExpression) off

201203

202204where_

203205 :: Relation ps xss xs

@@ -231,9 +233,8 @@ ys `offset` n = ys

231233

232234instance HasField label xss xs

233235 => IsLabel label (Relation ps xss xs) where

234− fromLabel _ = Relation

235− { tabulation = UnsafeTabulation $

236− fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)

236+ fromLabel _ = UnsafeRelation

237+ { relation = fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)

237238 , restriction = Nothing

238239 , limitation = Nothing

239240 , offsetting = Nothing

@@ -247,40 +248,38 @@ ys `from` xs = UnsafeSelection $

247248 renderProjection ys <> " FROM " <> renderRelation xs

248249

249250subselect :: Selection ps xss ys -> Relation ps xss ys

250−subselect selection = Relation

251− { tabulation = UnsafeTabulation $ "SELECT " <> renderSelection selection

251+subselect selection = UnsafeRelation

252+ { relation = "SELECT " <> renderSelection selection

252253 , restriction = Nothing

253254 , limitation = Nothing

254255 , offsetting = Nothing

255256 }

256257

257−newtype Insertion ps xss xs = UnsafeInsertion

258− {renderInsertion :: ByteString }

258+newtype Query

259+ (ps :: [PGType])

260+ (xss :: [(Symbol,[(Symbol,PGType)])])

261+ (yss :: [(Symbol,[(Symbol,PGType)])])

262+ (zs :: [(Symbol,PGType)]) =

263+ UnsafeQuery { renderQuery :: ByteString }

264+newtype PreparedQuery ps xss yss zs =

265+ UnsafePreparedQuery { renderPreparedQuery :: ByteString }

266+

267+select :: Selection ps xss ys -> Query ps xss xss ys

268+select selection = UnsafeQuery $

269+ "SELECT " <> renderSelection selection <> ";"

259270

260−into

261− :: forall label xss xs ps

271+insertInto

272+ :: forall xss xs label ps

262273 . (HasField label xss xs, UnzipAliased xs)

263274 => Proxy label

264275 -> Rec (Aliased (Expression ps '[])) xs

265− -> Insertion ps xss xs

266−into table values = UnsafeInsertion $ "INTO "

276+ -> Query ps xss xss '[]

277+insertInto table values = UnsafeQuery $ "INSERT INTO "

267278 <> fieldName table (Proxy @xss) (Proxy @xs)

268279 <> " (" <> ByteString.intercalate ", " names

269280 <> ") VALUES ("

270281 <> ByteString.intercalate ", "

271282 (recordToList (rmap (Const . renderExpression) exprs))

272− <> ")"

283+ <> ");"

273284 where

274285 (names,exprs) = unzipAliased values

275−

276−newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }

277−newtype PreparedQuery ps xss yss zs =

278− UnsafePreparedQuery { renderPreparedQuery :: ByteString }

279−

280−select :: Selection ps xss ys -> Query ps xss xss ys

281−select selection = UnsafeQuery $

282− "SELECT " <> renderSelection selection <> ";"

283−

284−insert :: Insertion ps xss xs -> Query ps xss xss '[]

285−insert insertion = UnsafeQuery $

286− "INSERT " <> renderInsertion insertion <> ";"

squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+10−4

@@ -50,9 +50,15 @@ spec = do

5050 `shouldBe`

5151 "SELECT * FROM table1 OFFSET 1+2;"

5252 it "correctly render simple INSERTs" $ do

53− renderQuery (insert insertion)

53+ renderQuery (insertInto @Tables @Columns (Proxy @"table1")

54+ ((2 `As` #col1 :& 4 `As` #col2 :& RNil)))

5455 `shouldBe`

5556 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"

57+ it "should be safe against SQL injection in literal text" $ do

58+ pendingWith "gotta find an escape function"

59+ -- renderQuery (select (literalText `from` table1))

60+ -- `shouldBe`

61+ -- "SELECT '\\'DROP TABLE table1;' AS literal FROM table1;"

5662

5763type Columns = '[ '("col1", 'PGInt4), '("col2", 'PGInt4)]

5864type Tables = '[ '("table1", Columns)]

@@ -60,11 +66,11 @@ type Tables = '[ '("table1", Columns)]

6066sumAndCol1 :: Projection '[] Columns '[ '("sum", 'PGInt4), '("col1", 'PGInt4)]

6167sumAndCol1 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

6268

69+literalText :: Projection '[] Columns '[ '("literal", 'PGText)]

70+literalText = project ("\';DROP TABLE table1;" `As` #literal :& RNil)

71+

6372table1 :: Relation '[] Tables Columns

6473table1 = #table1

6574

6675parameterizedTable1 :: Relation '[ 'PGInt8] Tables Columns

6776parameterizedTable1 = #table1

68−

69−insertion :: Insertion '[] Tables Columns

70−insertion = into (Proxy @"table1") (2 `As` #col1 :& 4 `As` #col2 :& RNil)