Qualifies columns used in WHERE clauses so we can use computed columns as filters

This commit is contained in:
Diogo Biazus
2015-07-10 12:35:24 -04:00
parent c0d44232a5
commit c76864a653
5 changed files with 55 additions and 32 deletions
+23 -22
View File
@@ -51,9 +51,9 @@ app conf reqBody req =
return $ responseLBS status200 [jsonH] $ cs body
([table], "OPTIONS") -> do
let t = QualifiedTable schema (cs table)
cols <- columns t
pkey <- map cs <$> primaryKeyColumns t
let qt = qualify table
cols <- columns qt
pkey <- map cs <$> primaryKeyColumns qt
return $ responseLBS status200 [jsonH, allOrigins]
$ encode (TableOptions cols pkey)
@@ -61,15 +61,15 @@ app conf reqBody req =
if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else do
let qt = QualifiedTable schema (cs table)
let select = B.Stmt "select " V.empty True <>
let qt = qualify table
select = B.Stmt "select " V.empty True <>
parentheticT (
whereT qq $ countRows qt
whereT qt qq $ countRows qt
) <> commaq <> (
asJsonWithCount
. limitT range
. orderT (orderParse qq)
. whereT qq
. whereT qt qq
$ selectStar qt
)
row <- H.maybeEx select
@@ -128,7 +128,7 @@ app conf reqBody req =
encode . object $ [("message", String "Failed authentication.")]
([table], "POST") -> do
let qt = QualifiedTable schema (cs table)
let qt = qualify table
echoRequested = lookup "Prefer" hdrs == Just "return=representation"
parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
parsed = if lookup "Content-Type" hdrs == Just "text/csv"
@@ -164,7 +164,7 @@ app conf reqBody req =
([table], "PUT") ->
handleJsonObj reqBody $ \obj -> do
let qt = QualifiedTable schema (cs table)
let qt = qualify table
primaryKeys <- primaryKeyColumns qt
let specifiedKeys = map (cs . fst) qq
if S.fromList primaryKeys /= S.fromList specifiedKeys
@@ -177,7 +177,7 @@ app conf reqBody req =
then do
let vals = M.elems obj
H.unitEx $ iffNotT
(whereT qq $ update qt cols vals)
(whereT qt qq $ update qt cols vals)
(insertSelect qt cols vals)
return $ responseLBS status204 [ jsonH ] ""
@@ -188,9 +188,9 @@ app conf reqBody req =
([table], "PATCH") ->
handleJsonObj reqBody $ \obj -> do
let qt = QualifiedTable schema (cs table)
let qt = qualify table
up = returningStarT
. whereT qq
. whereT qt qq
$ update qt (map cs $ M.keys obj) (M.elems obj)
patch = withT up "t" $ B.Stmt
"select count(t), array_to_json(array_agg(row_to_json(t)))::character varying"
@@ -207,10 +207,10 @@ app conf reqBody req =
return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
([table], "DELETE") -> do
let qt = QualifiedTable schema (cs table)
let qt = qualify table
let del = countT
. returningStarT
. whereT qq
. whereT qt qq
$ deleteFrom qt
row <- H.maybeEx del
let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
@@ -222,15 +222,16 @@ app conf reqBody req =
return $ responseLBS status404 [] ""
where
path = pathInfo req
verb = requestMethod req
qq = queryString req
hdrs = requestHeaders req
schema = requestedSchema (cs $ configV1Schema conf) hdrs
path = pathInfo req
verb = requestMethod req
qq = queryString req
qualify = QualifiedTable schema
hdrs = requestHeaders req
schema = requestedSchema (cs $ configV1Schema conf) hdrs
authenticator = cs $ configDbUser conf
jwtSecret = cs $ configJwtSecret conf
range = rangeRequested hdrs
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
jwtSecret = cs $ configJwtSecret conf
range = rangeRequested hdrs
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
sqlError :: t
sqlError = undefined