Moves all PgQuery module to QueryBuilder
This commit is contained in:
Diogo Biazus
@@ -69,7 +69,6 @@ executable postgrest
|
||||
, PostgREST.Error
|
||||
, PostgREST.Middleware
|
||||
, PostgREST.Parsers
|
||||
, PostgREST.PgQuery
|
||||
, PostgREST.DbStructure
|
||||
, PostgREST.QueryBuilder
|
||||
, PostgREST.RangeQuery
|
||||
@@ -133,7 +132,6 @@ library
|
||||
, PostgREST.Error
|
||||
, PostgREST.Middleware
|
||||
, PostgREST.Parsers
|
||||
, PostgREST.PgQuery
|
||||
, PostgREST.DbStructure
|
||||
, PostgREST.QueryBuilder
|
||||
, PostgREST.RangeQuery
|
||||
@@ -164,7 +162,6 @@ Test-Suite spec
|
||||
, PostgREST.Error
|
||||
, PostgREST.Middleware
|
||||
, PostgREST.Parsers
|
||||
, PostgREST.PgQuery
|
||||
, PostgREST.DbStructure
|
||||
, PostgREST.QueryBuilder
|
||||
, PostgREST.RangeQuery
|
||||
|
||||
+16
-2
@@ -45,9 +45,23 @@ import qualified Hasql.Postgres as P
|
||||
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Parsers
|
||||
import PostgREST.PgQuery
|
||||
import PostgREST.DbStructure
|
||||
import PostgREST.QueryBuilder
|
||||
import PostgREST.QueryBuilder ( asJson
|
||||
, callProc
|
||||
, asCsvF
|
||||
, asJsonF
|
||||
, selectStarF
|
||||
, countF
|
||||
, locationF
|
||||
, asJsonSingleF
|
||||
, addJoinConditions
|
||||
, sourceSubqueryName
|
||||
, requestToQuery
|
||||
, wrapQuery
|
||||
, countAllF
|
||||
, countNoneF
|
||||
, addRelations
|
||||
)
|
||||
import PostgREST.RangeQuery
|
||||
import PostgREST.Types
|
||||
import PostgREST.Auth (tokenJWT)
|
||||
|
||||
@@ -27,7 +27,7 @@ import Data.Monoid ((<>))
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Clock (NominalDiffTime)
|
||||
import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, unquoted)
|
||||
import PostgREST.QueryBuilder (pgFmtLit, pgFmtIdent, unquoted)
|
||||
import qualified Web.JWT as JWT
|
||||
import qualified Data.HashMap.Lazy as H
|
||||
|
||||
|
||||
@@ -20,7 +20,6 @@ import Data.Text (Text, split)
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Postgres as P
|
||||
import qualified Hasql.Backend as B
|
||||
import PostgREST.PgQuery ()
|
||||
import PostgREST.Types
|
||||
|
||||
import GHC.Exts (groupWith)
|
||||
|
||||
@@ -10,7 +10,7 @@ import Data.Text (Text)
|
||||
import Data.Tree
|
||||
import PostgREST.Types
|
||||
import Text.ParserCombinators.Parsec hiding (many, (<|>))
|
||||
import PostgREST.PgQuery (operators)
|
||||
import PostgREST.QueryBuilder (operators)
|
||||
|
||||
pRequestSelect :: Text -> Parser ApiRequest
|
||||
pRequestSelect rootNodeName = do
|
||||
|
||||
@@ -1,309 +0,0 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module PostgREST.PgQuery (
|
||||
fromQi
|
||||
, insertableValue
|
||||
, wrapQuery
|
||||
, asJson
|
||||
, callProc
|
||||
, unquoted
|
||||
, operators
|
||||
|
||||
-- format functions
|
||||
, pgFmtLit
|
||||
, pgFmtIdent
|
||||
, pgFmtValue
|
||||
, pgFmtCondition
|
||||
, pgFmtColumn
|
||||
, pgFmtJsonPath
|
||||
, pgFmtTable
|
||||
, pgFmtField
|
||||
, pgFmtSelectItem
|
||||
, pgFmtAsJsonPath
|
||||
|
||||
-- query fragments
|
||||
, sourceSubqueryName
|
||||
, orderF
|
||||
, countNoneF
|
||||
, countAllF
|
||||
, countF
|
||||
, locationF
|
||||
, asCsvF
|
||||
, asJsonSingleF
|
||||
, asJsonF
|
||||
, selectStarF
|
||||
|
||||
, StatementT
|
||||
) where
|
||||
|
||||
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Backend as B
|
||||
import qualified Hasql.Postgres as P
|
||||
import PostgREST.RangeQuery
|
||||
import PostgREST.Types
|
||||
|
||||
import Control.Monad (join)
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Functor
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import qualified Data.List as L
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Monoid
|
||||
import Data.Scientific (FPFormat (..), formatScientific,
|
||||
isInteger)
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.Text as T
|
||||
import Data.Vector (empty)
|
||||
import Text.Regex.TDFA ((=~))
|
||||
|
||||
import Prelude
|
||||
import qualified Data.Map as M
|
||||
|
||||
type PStmt = H.Stmt P.Postgres
|
||||
instance Monoid PStmt where
|
||||
mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
|
||||
B.Stmt (query <> query') (params <> params') (prep && prep')
|
||||
mempty = B.Stmt "" empty True
|
||||
type StatementT = PStmt -> PStmt
|
||||
data JsonbPath =
|
||||
ColIdentifier T.Text
|
||||
| KeyIdentifier T.Text
|
||||
| SingleArrow JsonbPath JsonbPath
|
||||
| DoubleArrow JsonbPath JsonbPath
|
||||
deriving (Show)
|
||||
|
||||
|
||||
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"),
|
||||
("@@", "@@"),
|
||||
("@>", "@>"),
|
||||
("<@", "<@")
|
||||
]
|
||||
|
||||
operatorsMap :: M.Map T.Text T.Text
|
||||
operatorsMap = M.fromList operators
|
||||
|
||||
asJson :: StatementT
|
||||
asJson s = s {
|
||||
B.stmtTemplate =
|
||||
"array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
|
||||
<> B.stmtTemplate s <> ") t" }
|
||||
|
||||
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
|
||||
|
||||
whiteList :: T.Text -> T.Text
|
||||
whiteList val = fromMaybe
|
||||
(cs (pgFmtLit val) <> "::unknown ")
|
||||
(L.find ((==) . T.toLower $ val) ["null","true","false"])
|
||||
|
||||
trimNullChars :: T.Text -> T.Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
|
||||
fromQi :: QualifiedIdentifier -> T.Text
|
||||
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
|
||||
where
|
||||
n = qiName t
|
||||
s = qiSchema t
|
||||
|
||||
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
|
||||
|
||||
insertableText :: T.Text -> T.Text
|
||||
insertableText = (<> "::unknown") . pgFmtLit
|
||||
|
||||
insertableValue :: JSON.Value -> T.Text
|
||||
insertableValue JSON.Null = "null"
|
||||
insertableValue v = insertableText $ unquoted 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 )
|
||||
|
||||
|
||||
-- query fragments
|
||||
sourceSubqueryName :: T.Text
|
||||
sourceSubqueryName = "pg_source"
|
||||
|
||||
withSourceF :: T.Text -> T.Text
|
||||
withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
|
||||
|
||||
countF :: T.Text
|
||||
countF = "pg_catalog.count(t)"
|
||||
|
||||
countAllF :: T.Text
|
||||
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
|
||||
|
||||
countNoneF :: T.Text
|
||||
countNoneF = "null"
|
||||
|
||||
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 "
|
||||
|
||||
asCsvF :: T.Text
|
||||
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
||||
|
||||
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
|
||||
|
||||
fromF :: T.Text -> T.Text -> T.Text
|
||||
fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
|
||||
|
||||
limitF :: Maybe NonnegRange -> T.Text
|
||||
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
|
||||
where
|
||||
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
|
||||
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
|
||||
|
||||
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 <> "')"
|
||||
) <>
|
||||
")"
|
||||
|
||||
orderF :: [OrderTerm] -> T.Text
|
||||
orderF ts =
|
||||
if L.null ts
|
||||
then ""
|
||||
else "ORDER BY " <> clause
|
||||
where
|
||||
clause = T.intercalate "," (map queryTerm ts)
|
||||
queryTerm :: OrderTerm -> T.Text
|
||||
queryTerm t = " "
|
||||
<> cs (pgFmtIdent $ otTerm t) <> " "
|
||||
<> cs (otDirection t) <> " "
|
||||
<> maybe "" cs (otNullOrder t) <> " "
|
||||
|
||||
-- formating functions
|
||||
|
||||
pgFmtValue :: T.Text -> T.Text -> T.Text
|
||||
pgFmtValue opCode val =
|
||||
case opCode of
|
||||
"like" -> unknownLiteral $ T.map star val
|
||||
"ilike" -> unknownLiteral $ T.map star val
|
||||
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
|
||||
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
|
||||
"@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
|
||||
_ -> unknownLiteral val
|
||||
where
|
||||
star c = if c == '*' then '%' else c
|
||||
unknownLiteral = (<> "::unknown ") . pgFmtLit
|
||||
|
||||
pgFmtOperator :: T.Text -> T.Text
|
||||
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
|
||||
|
||||
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
|
||||
|
||||
pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
|
||||
pgFmtCondition table (Filter (col,jp) ops val) =
|
||||
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
|
||||
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
|
||||
where
|
||||
headPredicate:rest = T.split (=='.') ops
|
||||
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
|
||||
opCode = hasNot (head rest) headPredicate
|
||||
notOp = hasNot headPredicate ""
|
||||
sqlCol = case val of
|
||||
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
|
||||
VForeignKey qi _ -> pgFmtColumn qi col
|
||||
sqlValue = valToStr val
|
||||
getInner v = case v of
|
||||
VText s -> s
|
||||
_ -> ""
|
||||
valToStr v = case v of
|
||||
VText s -> pgFmtValue opCode s
|
||||
VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
|
||||
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
|
||||
_ -> ""
|
||||
|
||||
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||
|
||||
pgFmtJsonPath :: Maybe JsonPath -> T.Text
|
||||
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
|
||||
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
|
||||
pgFmtJsonPath _ = ""
|
||||
|
||||
pgFmtTable :: Table -> T.Text
|
||||
pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
|
||||
|
||||
pgFmtField :: QualifiedIdentifier -> Field -> T.Text
|
||||
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
|
||||
|
||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
|
||||
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
|
||||
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
|
||||
|
||||
pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
|
||||
pgFmtAsJsonPath Nothing = ""
|
||||
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
|
||||
+293
-41
@@ -1,21 +1,156 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module PostgREST.QueryBuilder (
|
||||
addRelations
|
||||
, addJoinConditions
|
||||
, requestToQuery
|
||||
, callProc
|
||||
, pgFmtLit
|
||||
, pgFmtIdent
|
||||
, unquoted
|
||||
, wrapQuery
|
||||
, operators
|
||||
, asJson
|
||||
, asJsonF
|
||||
, asJsonSingleF
|
||||
, asCsvF
|
||||
, countF
|
||||
, selectStarF
|
||||
, locationF
|
||||
, sourceSubqueryName
|
||||
, countAllF
|
||||
, countNoneF
|
||||
) where
|
||||
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Backend as B
|
||||
import qualified Hasql.Postgres as P
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset)
|
||||
import Control.Error
|
||||
import Control.Monad (join)
|
||||
import Data.List (find)
|
||||
import Data.Monoid
|
||||
import Data.Text hiding (filter, find, foldr, head, last, map,
|
||||
null, zipWith, concatMap)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Control.Applicative
|
||||
import Data.Tree
|
||||
import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, pgFmtCondition, insertableValue
|
||||
, orderF, pgFmtJsonPath, sourceSubqueryName, pgFmtIdent)
|
||||
import PostgREST.Types
|
||||
import qualified Data.Map as M
|
||||
import Text.Regex.TDFA ((=~))
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Scientific (FPFormat (..), formatScientific,
|
||||
isInteger)
|
||||
|
||||
type PStmt = H.Stmt P.Postgres
|
||||
instance Monoid PStmt where
|
||||
mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
|
||||
B.Stmt (query <> query') (params <> params') (prep && prep')
|
||||
mempty = B.Stmt "" empty True
|
||||
type StatementT = PStmt -> PStmt
|
||||
|
||||
sourceSubqueryName :: T.Text
|
||||
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) =
|
||||
@@ -31,21 +166,7 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
|
||||
where
|
||||
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
||||
findRelation s t1 t2 =
|
||||
find (\r -> s == tableSchema r && t1 == relTable r && t2 == relFTable r) allRelations
|
||||
|
||||
getJoinConditions :: Relation -> [Filter]
|
||||
getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) =
|
||||
case typ of
|
||||
Child -> zipWith (toFilter tN ftN) cs fcs
|
||||
Parent -> zipWith (toFilter tN ftN) cs fcs
|
||||
Many -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
|
||||
where
|
||||
s = tableSchema t
|
||||
tN = tableName t
|
||||
ftN = tableName ft
|
||||
ltN = fromMaybe "" (tableName <$> lt)
|
||||
toFilter :: Text -> Text -> Column -> Column -> Filter
|
||||
toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
|
||||
find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
|
||||
|
||||
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
|
||||
addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||
@@ -80,11 +201,11 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
|
||||
tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
|
||||
qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
|
||||
toQi t = QualifiedIdentifier (tblSchema t) t
|
||||
query = Data.Text.unwords [
|
||||
("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
|
||||
"SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
|
||||
"FROM ", intercalate ", " (map (fromQi . toQi) tbls),
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
query = T.unwords [
|
||||
("WITH " <> T.intercalate ", " withs) `emptyOnNull` withs,
|
||||
"SELECT ", T.intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
|
||||
"FROM ", T.intercalate ", " (map (fromQi . toQi) tbls),
|
||||
("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
orderF (fromMaybe [] ord)
|
||||
]
|
||||
(withs, selects) = foldr getQueryParts ([],[]) forest
|
||||
@@ -116,13 +237,13 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
|
||||
query
|
||||
where
|
||||
qi = QualifiedIdentifier schema mainTbl
|
||||
query = Data.Text.unwords [
|
||||
query = T.unwords [
|
||||
"INSERT INTO ", fromQi qi,
|
||||
" (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
|
||||
"VALUES " <> intercalate ", "
|
||||
" (" <> T.intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
|
||||
"VALUES " <> T.intercalate ", "
|
||||
( map (\v ->
|
||||
"(" <>
|
||||
intercalate ", " ( map insertableValue v ) <>
|
||||
T.intercalate ", " ( map insertableValue v ) <>
|
||||
")"
|
||||
) vals
|
||||
),
|
||||
@@ -132,10 +253,10 @@ requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) =
|
||||
query
|
||||
where
|
||||
qi = QualifiedIdentifier schema mainTbl
|
||||
query = Data.Text.unwords [
|
||||
query = T.unwords [
|
||||
"UPDATE ", fromQi qi,
|
||||
" SET " <> intercalate ", " (map formatSet (M.toList setWith)) <> " ",
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
" SET " <> T.intercalate ", " (map formatSet (M.toList setWith)) <> " ",
|
||||
("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
"RETURNING " <> fromQi qi <> ".*"
|
||||
]
|
||||
formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v
|
||||
@@ -143,22 +264,153 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
|
||||
query
|
||||
where
|
||||
qi = QualifiedIdentifier schema mainTbl
|
||||
query = Data.Text.unwords [
|
||||
query = T.unwords [
|
||||
"DELETE FROM ", fromQi qi,
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
"RETURNING " <> fromQi qi <> ".*"
|
||||
]
|
||||
|
||||
-- private functions
|
||||
getJoinConditions :: Relation -> [Filter]
|
||||
getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
|
||||
case typ of
|
||||
Child -> zipWith (toFilter t ft) cs fcs
|
||||
Parent -> zipWith (toFilter t ft) cs fcs
|
||||
Many -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
|
||||
fromQi :: QualifiedIdentifier -> T.Text
|
||||
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
|
||||
where
|
||||
toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
|
||||
toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
|
||||
n = qiName t
|
||||
s = qiSchema t
|
||||
|
||||
getJoinConditions :: Relation -> [Filter]
|
||||
getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
|
||||
case typ of
|
||||
Child -> zipWith (toFilter tN ftN) cols fcs
|
||||
Parent -> zipWith (toFilter tN ftN) cols fcs
|
||||
Many -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
|
||||
where
|
||||
s = tableSchema t
|
||||
tN = tableName t
|
||||
ftN = tableName ft
|
||||
ltN = fromMaybe "" (tableName <$> lt)
|
||||
toFilter :: Text -> Text -> Column -> Column -> Filter
|
||||
toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
|
||||
|
||||
emptyOnNull :: Text -> [a] -> Text
|
||||
emptyOnNull val x = if null x then "" else val
|
||||
|
||||
orderF :: [OrderTerm] -> T.Text
|
||||
orderF ts =
|
||||
if null ts
|
||||
then ""
|
||||
else "ORDER BY " <> clause
|
||||
where
|
||||
clause = T.intercalate "," (map queryTerm ts)
|
||||
queryTerm :: OrderTerm -> T.Text
|
||||
queryTerm t = " "
|
||||
<> cs (pgFmtIdent $ otTerm t) <> " "
|
||||
<> cs (otDirection t) <> " "
|
||||
<> maybe "" cs (otNullOrder t) <> " "
|
||||
|
||||
insertableText :: T.Text -> T.Text
|
||||
insertableText = (<> "::unknown") . pgFmtLit
|
||||
|
||||
insertableValue :: JSON.Value -> T.Text
|
||||
insertableValue JSON.Null = "null"
|
||||
insertableValue v = insertableText $ unquoted v
|
||||
|
||||
whiteList :: T.Text -> T.Text
|
||||
whiteList val = fromMaybe
|
||||
(cs (pgFmtLit val) <> "::unknown ")
|
||||
(find ((==) . T.toLower $ val) ["null","true","false"])
|
||||
|
||||
|
||||
-- formating functions
|
||||
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
|
||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||
|
||||
pgFmtField :: QualifiedIdentifier -> Field -> T.Text
|
||||
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
|
||||
|
||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
|
||||
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
|
||||
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
|
||||
|
||||
pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
|
||||
pgFmtCondition table (Filter (col,jp) ops val) =
|
||||
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
|
||||
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
|
||||
where
|
||||
headPredicate:rest = T.split (=='.') ops
|
||||
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
|
||||
opCode = hasNot (head rest) headPredicate
|
||||
notOp = hasNot headPredicate ""
|
||||
sqlCol = case val of
|
||||
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
|
||||
VForeignKey qi _ -> pgFmtColumn qi col
|
||||
sqlValue = valToStr val
|
||||
getInner v = case v of
|
||||
VText s -> s
|
||||
_ -> ""
|
||||
valToStr v = case v of
|
||||
VText s -> pgFmtValue opCode s
|
||||
VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
|
||||
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
|
||||
_ -> ""
|
||||
|
||||
pgFmtValue :: T.Text -> T.Text -> T.Text
|
||||
pgFmtValue opCode val =
|
||||
case opCode of
|
||||
"like" -> unknownLiteral $ T.map star val
|
||||
"ilike" -> unknownLiteral $ T.map star val
|
||||
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
|
||||
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
|
||||
"@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
|
||||
_ -> unknownLiteral val
|
||||
where
|
||||
star c = if c == '*' then '%' else c
|
||||
unknownLiteral = (<> "::unknown ") . pgFmtLit
|
||||
|
||||
pgFmtOperator :: T.Text -> T.Text
|
||||
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
|
||||
|
||||
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
|
||||
|
||||
pgFmtJsonPath :: Maybe JsonPath -> T.Text
|
||||
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
|
||||
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
|
||||
pgFmtJsonPath _ = ""
|
||||
|
||||
pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
|
||||
pgFmtAsJsonPath Nothing = ""
|
||||
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
|
||||
|
||||
operatorsMap :: M.Map T.Text T.Text
|
||||
operatorsMap = M.fromList operators
|
||||
|
||||
trimNullChars :: T.Text -> T.Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
|
||||
withSourceF :: T.Text -> T.Text
|
||||
withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
|
||||
|
||||
fromF :: T.Text -> T.Text -> T.Text
|
||||
fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
|
||||
|
||||
limitF :: Maybe NonnegRange -> T.Text
|
||||
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
|
||||
where
|
||||
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
|
||||
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
|
||||
|
||||
Reference in New Issue
Block a user