46004ea · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge pull request #6 from echatav/remove-tabulation

46004eaEitan Chatav10 years ago

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

compare with dev

unifiedsplit

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

36 , uuid

37 , vinyl

39−test-suite blockapps-data-test

39+test-suite squeel-postgresql-test

40 default-language: Haskell2010

41 type: exitcode-stdio-1.0

42 hs-source-dirs: test

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

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

24import Data.Text (Text)

25import Data.Vinyl

26import Data.Vinyl.Functor

27+import GHC.TypeLits

28import qualified Database.PostgreSQL.LibPQ as LibPQ

29import qualified Database.PostgreSQL.LibPQ as LibPQ

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

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

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

36−newtype PQ db0 db1 m x = PQ

37+newtype PQ

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

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

40+ (m :: * -> *)

41+ (x :: *) =

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

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

38− deriving Functor

43+ deriving Functor

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

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

41evalPQ (PQ pq) = fmap fst . pq

46evalPQ (PQ pq) = fmap fst . pq

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

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

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

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

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

99+newtype Expression

100+ (ps :: [PGType])

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

102+ (y :: PGType) =

100− UnsafeExpression { renderExpression :: ByteString }

103+ UnsafeExpression { renderExpression :: ByteString }

101

104

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

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

103param1 = UnsafeExpression "$1"

106param1 = UnsafeExpression "$1"

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

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

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

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

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

172

175

173−newtype Projection ps xs ys = UnsafeProjection

176+newtype Projection

177+ (ps :: [PGType])

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

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

174− { renderProjection :: ByteString }

180+ UnsafeProjection { renderProjection :: ByteString }

175

181

176star :: Projection ps xs xs

182star :: Projection ps xs xs

177star = UnsafeProjection "*"

183star = UnsafeProjection "*"

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

182 -> Projection ps xs ys

188 -> Projection ps xs ys

183project = UnsafeProjection . renderAllAliased renderExpression

189project = UnsafeProjection . renderAllAliased renderExpression

184

190

185−data Tabulation ps xss xs = UnsafeTabulation

191+data Relation ps xss xs = UnsafeRelation

186− { renderTabulation :: ByteString }

192+ { relation :: ByteString

187−

188−data Relation ps xss xs = Relation

189− { tabulation :: Tabulation ps xss xs

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

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

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

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

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

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

193 }

196 }

194

197

195renderRelation :: Relation ps xss xs -> ByteString

198renderRelation :: Relation ps xss xs -> ByteString

196−renderRelation (Relation tab wh lim off) =

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

197− renderTabulation tab

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

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

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

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

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

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

201

203

202where_

204where_

203 :: Relation ps xss xs

205 :: Relation ps xss xs

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

231

233

232instance HasField label xss xs

234instance HasField label xss xs

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

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

234− fromLabel _ = Relation

236+ fromLabel _ = UnsafeRelation

235− { tabulation = UnsafeTabulation $

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

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

237 , restriction = Nothing

238 , restriction = Nothing

238 , limitation = Nothing

239 , limitation = Nothing

239 , offsetting = Nothing

240 , offsetting = Nothing

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

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

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

248

249

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

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

250−subselect selection = Relation

251+subselect selection = UnsafeRelation

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

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

252 , restriction = Nothing

253 , restriction = Nothing

253 , limitation = Nothing

254 , limitation = Nothing

254 , offsetting = Nothing

255 , offsetting = Nothing

255 }

256 }

256

257

257−newtype Insertion ps xss xs = UnsafeInsertion

258+newtype Query

258− {renderInsertion :: ByteString }

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 <> ";"

259

270

260−into

271+insertInto

261− :: forall label xss xs ps

272+ :: forall xss xs label ps

262 . (HasField label xss xs, UnzipAliased xs)

273 . (HasField label xss xs, UnzipAliased xs)

263 => Proxy label

274 => Proxy label

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

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

265− -> Insertion ps xss xs

276+ -> Query ps xss xss '[]

266−into table values = UnsafeInsertion $ "INTO "

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

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

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

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

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

269 <> ") VALUES ("

280 <> ") VALUES ("

270 <> ByteString.intercalate ", "

281 <> ByteString.intercalate ", "

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

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

272− <> ")"

283+ <> ");"

273 where

284 where

274 (names,exprs) = unzipAliased values

285 (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

50 `shouldBe`

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

52 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)))

54 `shouldBe`

55 `shouldBe`

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

56 "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;"

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

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

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

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

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

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

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

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

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

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

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

71+

63table1 :: Relation '[] Tables Columns

72table1 :: Relation '[] Tables Columns

64table1 = #table1

73table1 = #table1

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

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

67parameterizedTable1 = #table1

76parameterizedTable1 = #table1

68−

69−insertion :: Insertion '[] Tables Columns

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