Moves some top level bindings to 'where' when it makes sense
This commit is contained in:
Diogo Biazus
+140
-148
@@ -4,23 +4,23 @@
|
|||||||
module PostgREST.QueryBuilder (
|
module PostgREST.QueryBuilder (
|
||||||
addRelations
|
addRelations
|
||||||
, addJoinConditions
|
, addJoinConditions
|
||||||
, requestToQuery
|
, asCsvF
|
||||||
, callProc
|
|
||||||
, pgFmtLit
|
|
||||||
, pgFmtIdent
|
|
||||||
, unquoted
|
|
||||||
, wrapQuery
|
|
||||||
, operators
|
|
||||||
, asJson
|
, asJson
|
||||||
, asJsonF
|
, asJsonF
|
||||||
, asJsonSingleF
|
, asJsonSingleF
|
||||||
, asCsvF
|
, callProc
|
||||||
, countF
|
|
||||||
, selectStarF
|
|
||||||
, locationF
|
|
||||||
, sourceSubqueryName
|
|
||||||
, countAllF
|
, countAllF
|
||||||
|
, countF
|
||||||
, countNoneF
|
, countNoneF
|
||||||
|
, locationF
|
||||||
|
, operators
|
||||||
|
, pgFmtIdent
|
||||||
|
, pgFmtLit
|
||||||
|
, requestToQuery
|
||||||
|
, selectStarF
|
||||||
|
, sourceSubqueryName
|
||||||
|
, unquoted
|
||||||
|
, wrapQuery
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Hasql as H
|
import qualified Hasql as H
|
||||||
@@ -29,23 +29,25 @@ import qualified Hasql.Postgres as P
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
|
||||||
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset)
|
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset)
|
||||||
import Control.Error
|
import Control.Error (note, fromMaybe, mapMaybe)
|
||||||
import Control.Monad (join)
|
import Control.Monad (join)
|
||||||
import Data.List (find)
|
import Data.List (find)
|
||||||
import Data.Monoid
|
import Data.Monoid ((<>))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import qualified Data.HashMap.Strict as H
|
import qualified Data.HashMap.Strict as H
|
||||||
import Control.Applicative
|
import Control.Applicative (empty, (<|>))
|
||||||
import Data.Tree
|
import Data.Tree (Tree(..))
|
||||||
import PostgREST.Types
|
import PostgREST.Types
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Text.Regex.TDFA ((=~))
|
import Text.Regex.TDFA ((=~))
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import Data.Scientific (FPFormat (..), formatScientific,
|
import Data.Scientific ( FPFormat (..)
|
||||||
isInteger)
|
, formatScientific
|
||||||
|
, isInteger
|
||||||
|
)
|
||||||
|
|
||||||
type PStmt = H.Stmt P.Postgres
|
type PStmt = H.Stmt P.Postgres
|
||||||
instance Monoid PStmt where
|
instance Monoid PStmt where
|
||||||
@@ -54,105 +56,7 @@ instance Monoid PStmt where
|
|||||||
mempty = B.Stmt "" empty True
|
mempty = B.Stmt "" empty True
|
||||||
type StatementT = PStmt -> PStmt
|
type StatementT = PStmt -> PStmt
|
||||||
|
|
||||||
sourceSubqueryName :: T.Text
|
addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
|
||||||
sourceSubqueryName = "pg_source"
|
|
||||||
|
|
||||||
countAllF :: T.Text
|
|
||||||
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
|
|
||||||
|
|
||||||
countNoneF :: T.Text
|
|
||||||
countNoneF = "null"
|
|
||||||
|
|
||||||
asCsvHeaderF :: T.Text
|
|
||||||
asCsvHeaderF =
|
|
||||||
"(SELECT string_agg(a.k, ',')" <>
|
|
||||||
" FROM (" <>
|
|
||||||
" SELECT json_object_keys(r)::TEXT as k" <>
|
|
||||||
" FROM ( " <>
|
|
||||||
" SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
|
|
||||||
" ) s" <>
|
|
||||||
" ) a" <>
|
|
||||||
")"
|
|
||||||
|
|
||||||
asCsvBodyF :: T.Text
|
|
||||||
asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
|
|
||||||
|
|
||||||
selectStarF :: T.Text
|
|
||||||
selectStarF = "SELECT * FROM " <> sourceSubqueryName
|
|
||||||
|
|
||||||
locationF :: [T.Text] -> T.Text
|
|
||||||
locationF pKeys =
|
|
||||||
"(" <>
|
|
||||||
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <>
|
|
||||||
" SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
|
|
||||||
" FROM s, json_each_text(s.r) AS json_data" <>
|
|
||||||
(
|
|
||||||
if null pKeys
|
|
||||||
then ""
|
|
||||||
else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')"
|
|
||||||
) <>
|
|
||||||
")"
|
|
||||||
|
|
||||||
countF :: T.Text
|
|
||||||
countF = "pg_catalog.count(t)"
|
|
||||||
|
|
||||||
asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
|
|
||||||
asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
|
|
||||||
|
|
||||||
asJsonF :: T.Text
|
|
||||||
asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
|
|
||||||
|
|
||||||
asCsvF :: T.Text
|
|
||||||
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
|
||||||
|
|
||||||
asJson :: StatementT
|
|
||||||
asJson s = s {
|
|
||||||
B.stmtTemplate =
|
|
||||||
"array_to_json(array_agg(row_to_json(t)))::character varying from ("
|
|
||||||
<> B.stmtTemplate s <> ") t" }
|
|
||||||
|
|
||||||
operators :: [(T.Text, T.Text)]
|
|
||||||
operators = [
|
|
||||||
("eq", "="),
|
|
||||||
("gte", ">="), -- has to be before gt (parsers)
|
|
||||||
("gt", ">"),
|
|
||||||
("lte", "<="), -- has to be before lt (parsers)
|
|
||||||
("lt", "<"),
|
|
||||||
("neq", "<>"),
|
|
||||||
("like", "like"),
|
|
||||||
("ilike", "ilike"),
|
|
||||||
("in", "in"),
|
|
||||||
("notin", "not in"),
|
|
||||||
("isnot", "is not"), -- has to be before is (parsers)
|
|
||||||
("is", "is"),
|
|
||||||
("@@", "@@"),
|
|
||||||
("@>", "@>"),
|
|
||||||
("<@", "<@")
|
|
||||||
]
|
|
||||||
|
|
||||||
wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text
|
|
||||||
wrapQuery source selectColumns returnSelect range =
|
|
||||||
withSourceF source <>
|
|
||||||
" SELECT " <>
|
|
||||||
T.intercalate ", " selectColumns <>
|
|
||||||
" " <>
|
|
||||||
fromF returnSelect ( limitF range )
|
|
||||||
|
|
||||||
unquoted :: JSON.Value -> T.Text
|
|
||||||
unquoted (JSON.String t) = t
|
|
||||||
unquoted (JSON.Number n) =
|
|
||||||
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
|
||||||
unquoted (JSON.Bool b) = cs . show $ b
|
|
||||||
unquoted v = cs $ JSON.encode v
|
|
||||||
|
|
||||||
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
|
|
||||||
callProc qi params = do
|
|
||||||
let args = T.intercalate "," $ map assignment (H.toList params)
|
|
||||||
B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
|
|
||||||
where
|
|
||||||
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
|
|
||||||
|
|
||||||
addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
|
|
||||||
addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
|
addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
|
||||||
case parentNode of
|
case parentNode of
|
||||||
Nothing -> Node (query, (table, Nothing)) <$> updatedForest
|
Nothing -> Node (query, (table, Nothing)) <$> updatedForest
|
||||||
@@ -166,7 +70,7 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
|
|||||||
where
|
where
|
||||||
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
||||||
findRelation s t1 t2 =
|
findRelation s t1 t2 =
|
||||||
find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
|
find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
|
||||||
|
|
||||||
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
|
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
|
||||||
addJoinConditions schema (Node (query, (n, r)) forest) =
|
addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||||
@@ -192,6 +96,97 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
|
|||||||
updatedForest = mapM (addJoinConditions schema) forest
|
updatedForest = mapM (addJoinConditions schema) forest
|
||||||
addCond q con = q{where_=con ++ where_ q}
|
addCond q con = q{where_=con ++ where_ q}
|
||||||
|
|
||||||
|
asCsvF :: T.Text
|
||||||
|
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
||||||
|
where
|
||||||
|
asCsvHeaderF =
|
||||||
|
"(SELECT string_agg(a.k, ',')" <>
|
||||||
|
" FROM (" <>
|
||||||
|
" SELECT json_object_keys(r)::TEXT as k" <>
|
||||||
|
" FROM ( " <>
|
||||||
|
" SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
|
||||||
|
" ) s" <>
|
||||||
|
" ) a" <>
|
||||||
|
")"
|
||||||
|
asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
|
||||||
|
|
||||||
|
asJson :: StatementT
|
||||||
|
asJson s = s {
|
||||||
|
B.stmtTemplate =
|
||||||
|
"array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
|
||||||
|
<> B.stmtTemplate s <> ") t" }
|
||||||
|
|
||||||
|
asJsonF :: T.Text
|
||||||
|
asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
|
||||||
|
|
||||||
|
asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
|
||||||
|
asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
|
||||||
|
|
||||||
|
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
|
||||||
|
callProc qi params = do
|
||||||
|
let args = T.intercalate "," $ map assignment (H.toList params)
|
||||||
|
B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
|
||||||
|
where
|
||||||
|
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
|
||||||
|
|
||||||
|
countAllF :: T.Text
|
||||||
|
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
|
||||||
|
|
||||||
|
countF :: T.Text
|
||||||
|
countF = "pg_catalog.count(t)"
|
||||||
|
|
||||||
|
countNoneF :: T.Text
|
||||||
|
countNoneF = "null"
|
||||||
|
|
||||||
|
locationF :: [T.Text] -> T.Text
|
||||||
|
locationF pKeys =
|
||||||
|
"(" <>
|
||||||
|
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <>
|
||||||
|
" SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
|
||||||
|
" FROM s, json_each_text(s.r) AS json_data" <>
|
||||||
|
(
|
||||||
|
if null pKeys
|
||||||
|
then ""
|
||||||
|
else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')"
|
||||||
|
) <>
|
||||||
|
")"
|
||||||
|
|
||||||
|
operators :: [(T.Text, T.Text)]
|
||||||
|
operators = [
|
||||||
|
("eq", "="),
|
||||||
|
("gte", ">="), -- has to be before gt (parsers)
|
||||||
|
("gt", ">"),
|
||||||
|
("lte", "<="), -- has to be before lt (parsers)
|
||||||
|
("lt", "<"),
|
||||||
|
("neq", "<>"),
|
||||||
|
("like", "like"),
|
||||||
|
("ilike", "ilike"),
|
||||||
|
("in", "in"),
|
||||||
|
("notin", "not in"),
|
||||||
|
("isnot", "is not"), -- has to be before is (parsers)
|
||||||
|
("is", "is"),
|
||||||
|
("@@", "@@"),
|
||||||
|
("@>", "@>"),
|
||||||
|
("<@", "<@")
|
||||||
|
]
|
||||||
|
|
||||||
|
pgFmtIdent :: T.Text -> T.Text
|
||||||
|
pgFmtIdent x =
|
||||||
|
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
|
||||||
|
if (cs escaped :: BS.ByteString) =~ danger
|
||||||
|
then "\"" <> escaped <> "\""
|
||||||
|
else escaped
|
||||||
|
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
|
||||||
|
|
||||||
|
pgFmtLit :: T.Text -> T.Text
|
||||||
|
pgFmtLit x =
|
||||||
|
let trimmed = trimNullChars x
|
||||||
|
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
|
||||||
|
slashed = T.replace "\\" "\\\\" escaped in
|
||||||
|
if T.isInfixOf "\\\\" escaped
|
||||||
|
then "E" <> slashed
|
||||||
|
else slashed
|
||||||
|
|
||||||
requestToQuery :: Text -> ApiRequest -> Text
|
requestToQuery :: Text -> ApiRequest -> Text
|
||||||
requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
|
requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
|
||||||
query
|
query
|
||||||
@@ -270,6 +265,27 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
|
|||||||
"RETURNING " <> fromQi qi <> ".*"
|
"RETURNING " <> fromQi qi <> ".*"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
selectStarF :: T.Text
|
||||||
|
selectStarF = "SELECT * FROM " <> sourceSubqueryName
|
||||||
|
|
||||||
|
sourceSubqueryName :: T.Text
|
||||||
|
sourceSubqueryName = "pg_source"
|
||||||
|
|
||||||
|
unquoted :: JSON.Value -> T.Text
|
||||||
|
unquoted (JSON.String t) = t
|
||||||
|
unquoted (JSON.Number n) =
|
||||||
|
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
||||||
|
unquoted (JSON.Bool b) = cs . show $ b
|
||||||
|
unquoted v = cs $ JSON.encode v
|
||||||
|
|
||||||
|
wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text
|
||||||
|
wrapQuery source selectColumns returnSelect range =
|
||||||
|
withSourceF source <>
|
||||||
|
" SELECT " <>
|
||||||
|
T.intercalate ", " selectColumns <>
|
||||||
|
" " <>
|
||||||
|
fromF returnSelect ( limitF range )
|
||||||
|
|
||||||
-- private functions
|
-- private functions
|
||||||
fromQi :: QualifiedIdentifier -> T.Text
|
fromQi :: QualifiedIdentifier -> T.Text
|
||||||
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
|
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
|
||||||
@@ -307,20 +323,15 @@ orderF ts =
|
|||||||
<> cs (otDirection t) <> " "
|
<> cs (otDirection t) <> " "
|
||||||
<> maybe "" cs (otNullOrder t) <> " "
|
<> maybe "" cs (otNullOrder t) <> " "
|
||||||
|
|
||||||
insertableText :: T.Text -> T.Text
|
|
||||||
insertableText = (<> "::unknown") . pgFmtLit
|
|
||||||
|
|
||||||
insertableValue :: JSON.Value -> T.Text
|
insertableValue :: JSON.Value -> T.Text
|
||||||
insertableValue JSON.Null = "null"
|
insertableValue JSON.Null = "null"
|
||||||
insertableValue v = insertableText $ unquoted v
|
insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
|
||||||
|
|
||||||
whiteList :: T.Text -> T.Text
|
whiteList :: T.Text -> T.Text
|
||||||
whiteList val = fromMaybe
|
whiteList val = fromMaybe
|
||||||
(cs (pgFmtLit val) <> "::unknown ")
|
(cs (pgFmtLit val) <> "::unknown ")
|
||||||
(find ((==) . T.toLower $ val) ["null","true","false"])
|
(find ((==) . T.toLower $ val) ["null","true","false"])
|
||||||
|
|
||||||
|
|
||||||
-- formating functions
|
|
||||||
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
||||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||||
@@ -369,24 +380,8 @@ pgFmtValue opCode val =
|
|||||||
|
|
||||||
pgFmtOperator :: T.Text -> T.Text
|
pgFmtOperator :: T.Text -> T.Text
|
||||||
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
|
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
|
||||||
|
where
|
||||||
pgFmtIdent :: T.Text -> T.Text
|
operatorsMap = M.fromList operators
|
||||||
pgFmtIdent x =
|
|
||||||
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
|
|
||||||
if (cs escaped :: BS.ByteString) =~ danger
|
|
||||||
then "\"" <> escaped <> "\""
|
|
||||||
else escaped
|
|
||||||
|
|
||||||
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
|
|
||||||
|
|
||||||
pgFmtLit :: T.Text -> T.Text
|
|
||||||
pgFmtLit x =
|
|
||||||
let trimmed = trimNullChars x
|
|
||||||
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
|
|
||||||
slashed = T.replace "\\" "\\\\" escaped in
|
|
||||||
if T.isInfixOf "\\\\" escaped
|
|
||||||
then "E" <> slashed
|
|
||||||
else slashed
|
|
||||||
|
|
||||||
pgFmtJsonPath :: Maybe JsonPath -> T.Text
|
pgFmtJsonPath :: Maybe JsonPath -> T.Text
|
||||||
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
|
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
|
||||||
@@ -397,9 +392,6 @@ pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
|
|||||||
pgFmtAsJsonPath Nothing = ""
|
pgFmtAsJsonPath Nothing = ""
|
||||||
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
|
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
|
||||||
|
|
||||||
operatorsMap :: M.Map T.Text T.Text
|
|
||||||
operatorsMap = M.fromList operators
|
|
||||||
|
|
||||||
trimNullChars :: T.Text -> T.Text
|
trimNullChars :: T.Text -> T.Text
|
||||||
trimNullChars = T.takeWhile (/= '\x0')
|
trimNullChars = T.takeWhile (/= '\x0')
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user