steve-chavez
8e58b56d5c
Change callProc/createWriteStatement to H.Snippet. Parametrize the inputs on the same SQLFragments by taking advantage of hasql-dynamic-statements. It's not necessary to parametrize every input, inlining with pgFmtLit can still be used for queries that can't be parametrized(like SET LOCALs). Also adds hasql-dynamic-statements to Nix and stack.
227 lines
9.1 KiB
Haskell
227 lines
9.1 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-|
|
|
Module : PostgREST.Private.QueryFragment
|
|
Description : Helper functions for PostgREST.QueryBuilder.
|
|
|
|
Any function that outputs a SqlFragment should be in this module.
|
|
-}
|
|
module PostgREST.Private.QueryFragment where
|
|
|
|
import qualified Data.ByteString.Char8 as BS (intercalate,
|
|
pack, unwords)
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.HashMap.Strict as HM
|
|
import Data.Maybe
|
|
import qualified Data.Text as T (intercalate,
|
|
isInfixOf, map,
|
|
null, replace,
|
|
takeWhile,
|
|
toLower)
|
|
import qualified Hasql.DynamicStatements.Snippet as H
|
|
import PostgREST.Types
|
|
import Protolude hiding (cast,
|
|
intercalate,
|
|
replace, toLower,
|
|
toS)
|
|
import Protolude.Conv (toS)
|
|
import Text.InterpolatedString.Perl6 (qc)
|
|
|
|
import qualified Hasql.Encoders as HE
|
|
|
|
noLocationF :: SqlFragment
|
|
noLocationF = "array[]::text[]"
|
|
|
|
-- |
|
|
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
|
|
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
|
-- We do this in SQL to avoid processing the JSON in application code
|
|
normalizedBody :: Maybe BL.ByteString -> H.Snippet
|
|
normalizedBody body =
|
|
"pgrst_payload AS (SELECT " <> jsonPlaceHolder body <> " AS json_data), " <>
|
|
H.sql (BS.unwords [
|
|
"pgrst_body AS (",
|
|
"SELECT",
|
|
"CASE WHEN json_typeof(json_data) = 'array'",
|
|
"THEN json_data",
|
|
"ELSE json_build_array(json_data)",
|
|
"END AS val",
|
|
"FROM pgrst_payload)"])
|
|
|
|
-- | Equivalent to "$1::json"
|
|
-- | TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
|
jsonPlaceHolder :: Maybe BL.ByteString -> H.Snippet
|
|
jsonPlaceHolder body =
|
|
H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json"
|
|
|
|
selectBody :: SqlFragment
|
|
selectBody = "(SELECT val FROM pgrst_body)"
|
|
|
|
pgFmtLit :: Text -> SqlFragment
|
|
pgFmtLit x =
|
|
let trimmed = trimNullChars x
|
|
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
|
|
slashed = T.replace "\\" "\\\\" escaped in
|
|
encodeUtf8 $ if "\\" `T.isInfixOf` escaped
|
|
then "E" <> slashed
|
|
else slashed
|
|
|
|
pgFmtIdent :: Text -> SqlFragment
|
|
pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
|
|
|
|
trimNullChars :: Text -> Text
|
|
trimNullChars = T.takeWhile (/= '\x0')
|
|
|
|
asCsvF :: SqlFragment
|
|
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
|
|
where
|
|
asCsvHeaderF =
|
|
"(SELECT coalesce(string_agg(a.k, ','), '')" <>
|
|
" FROM (" <>
|
|
" SELECT json_object_keys(r)::text as k" <>
|
|
" FROM ( " <>
|
|
" SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
|
|
" ) s" <>
|
|
" ) a" <>
|
|
")"
|
|
asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
|
|
|
|
asJsonF :: SqlFragment
|
|
asJsonF = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
|
|
|
|
asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
|
|
asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying "
|
|
|
|
asBinaryF :: FieldName -> SqlFragment
|
|
asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
|
|
|
|
locationF :: [Text] -> SqlFragment
|
|
locationF pKeys = [qc|(
|
|
WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
|
|
SELECT array_agg(json_data.key || '=eq.' || json_data.value)
|
|
FROM data CROSS JOIN json_each_text(data.row) AS json_data
|
|
WHERE json_data.key IN ('{fmtPKeys}')
|
|
)|]
|
|
where
|
|
fmtPKeys = T.intercalate "','" pKeys
|
|
|
|
fromQi :: QualifiedIdentifier -> SqlFragment
|
|
fromQi t = (if T.null s then mempty else pgFmtIdent s <> ".") <> pgFmtIdent n
|
|
where
|
|
n = qiName t
|
|
s = qiSchema t
|
|
|
|
emptyOnFalse :: SqlFragment -> Bool -> SqlFragment
|
|
emptyOnFalse val cond = if cond then mempty else val
|
|
|
|
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
|
|
pgFmtColumn table "*" = fromQi table <> ".*"
|
|
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
|
|
|
pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
|
|
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
|
|
|
|
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
|
|
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias
|
|
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> encodeUtf8 cast <> " )" <> pgFmtAs fName jp alias
|
|
|
|
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment
|
|
pgFmtOrderTerm qi ot = BS.unwords [
|
|
pgFmtField qi $ otTerm ot,
|
|
BS.pack $ maybe mempty show $ otDirection ot,
|
|
BS.pack $ maybe mempty show $ otNullOrder ot]
|
|
|
|
pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
|
|
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
|
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
|
"like" -> unknownLiteral (T.map star val)
|
|
"ilike" -> unknownLiteral (T.map star val)
|
|
"is" -> whiteList val
|
|
_ -> unknownLiteral val
|
|
|
|
In vals -> pgFmtField table fld <> " " <>
|
|
let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
|
|
case (&&) (length vals == 1) . T.null <$> headMay vals of
|
|
Just False -> sqlOperator "in" <> "(" <> BS.intercalate ", " (unknownLiteral <$> vals) <> ") "
|
|
Just True -> emptyValForIn
|
|
Nothing -> emptyValForIn
|
|
|
|
Fts op lang val ->
|
|
pgFmtFieldOp op
|
|
<> "("
|
|
<> maybe mempty ((<> ", ") . pgFmtLit) lang
|
|
<> unknownLiteral val
|
|
<> ") "
|
|
where
|
|
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
|
|
sqlOperator o = HM.lookupDefault "=" o operators
|
|
notOp = if hasNot then "NOT" else mempty
|
|
star c = if c == '*' then '%' else c
|
|
unknownLiteral = (<> "::unknown ") . pgFmtLit
|
|
whiteList :: Text -> SqlFragment
|
|
whiteList v = maybe
|
|
(pgFmtLit v <> "::unknown") encodeUtf8
|
|
(find ((==) . T.toLower $ v) ["null","true","false"])
|
|
|
|
pgFmtJoinCondition :: JoinCondition -> SqlFragment
|
|
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
|
pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
|
|
|
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
|
|
pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> BS.intercalate (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
|
where notOp = if hasNot then "NOT" else mempty
|
|
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
|
|
|
pgFmtJsonPath :: JsonPath -> SqlFragment
|
|
pgFmtJsonPath = \case
|
|
[] -> mempty
|
|
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
|
(J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
|
where
|
|
pgFmtJsonOperand (JKey k) = pgFmtLit k
|
|
pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"
|
|
|
|
pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
|
|
pgFmtAs _ [] Nothing = mempty
|
|
pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
|
|
Just (JKey key) -> " AS " <> pgFmtIdent key
|
|
Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
|
|
-- We get the lastKey because on:
|
|
-- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
|
|
-- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
|
|
where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
|
|
Nothing -> mempty
|
|
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
|
|
|
countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment)
|
|
countF countQuery shouldCount =
|
|
if shouldCount
|
|
then (
|
|
", pgrst_source_count AS (" <> countQuery <> ")"
|
|
, "(SELECT pg_catalog.count(*) FROM pgrst_source_count)" )
|
|
else (
|
|
mempty
|
|
, "null::bigint")
|
|
|
|
returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
|
|
returningF qi returnings =
|
|
if null returnings
|
|
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
|
|
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
|
|
|
|
responseHeadersF :: PgVersion -> SqlFragment
|
|
responseHeadersF pgVer =
|
|
if pgVer >= pgVersion96
|
|
then currentSettingF "response.headers"
|
|
else "null"
|
|
|
|
responseStatusF :: PgVersion -> SqlFragment
|
|
responseStatusF pgVer =
|
|
if pgVer >= pgVersion96
|
|
then currentSettingF "response.status"
|
|
else "null"
|
|
|
|
currentSettingF :: Text -> SqlFragment
|
|
currentSettingF setting =
|
|
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
|
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
|