jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

perf: change Text queries to ByteString

Browse Source 
Improves performance by not utf8 encoding the whole query with
encodeUtf8. Only certain parts.

It's also a gradual step needed to use the Snippet type
from hasql-dynamic-statements.
This commit is contained in:
steve-chavez
2020-10-17 15:01:06 -05:00
committed by Steve Chavez
parent 7e3e19acbb
commit d1d0c6772a
7 changed files with 85 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+1 -1
View File
@@ -187,7 +187,7 @@ app dbStructure proc cols conf apiRequest =
, Just $ contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing , Just $ contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
, if null pkCols && isNothing (iOnConflict apiRequest) , if null pkCols && isNothing (iOnConflict apiRequest)
then Nothing then Nothing
else (\x -> ("Preference-Applied", encodeUtf8 (show x))) <$> iPreferResolution apiRequest else (\x -> ("Preference-Applied", BS.pack (show x))) <$> iPreferResolution apiRequest
] ++ ctHeaders)) (unwrapGucHeader <$> ghdrs) ] ++ ctHeaders)) (unwrapGucHeader <$> ghdrs)
if contentType == CTSingularJSON && queryTotal /= 1 if contentType == CTSingularJSON && queryTotal /= 1
then do then do
src/PostgREST/DbRequestBuilder.hs
+4 -3
View File
@@ -56,13 +56,14 @@ readRequest schema rootTableName maxRows allRels apiRequest =
rootWithRels :: Schema -> TableName -> [Relation] -> Action -> (QualifiedIdentifier, [Relation]) rootWithRels :: Schema -> TableName -> [Relation] -> Action -> (QualifiedIdentifier, [Relation])
rootWithRels schema rootTableName allRels action = case action of rootWithRels schema rootTableName allRels action = case action of
ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
_ -> (QualifiedIdentifier mempty sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc _ -> (QualifiedIdentifier mempty _sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
where where
_sourceCTEName = decodeUtf8 sourceCTEName
-- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation -- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
-- with {sourceCTEName}. This way findRel can find relationships with sourceCTEName. -- with {sourceCTEName}. This way findRel can find relationships with sourceCTEName.
toSourceRel :: Relation -> Maybe Relation toSourceRel :: Relation -> Maybe Relation
toSourceRel r@Relation{relTable=t} toSourceRel r@Relation{relTable=t}
| rootTableName == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}} | rootTableName == tableName t = Just $ r {relTable=t {tableName=_sourceCTEName}}
| otherwise = Nothing | otherwise = Nothing
-- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having -- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
@@ -228,7 +229,7 @@ getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, ta
-- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the -- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the
-- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid. -- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid.
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then mempty else schema) tbl removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFiltersOrdersRanges apiRequest rReq = do addFiltersOrdersRanges apiRequest rReq = do
src/PostgREST/Private/QueryFragment.hs
+41 -39
View File
@@ -7,13 +7,15 @@ Any function that outputs a SqlFragment should be in this module.
-} -}
module PostgREST.Private.QueryFragment where module PostgREST.Private.QueryFragment where
import qualified Data.ByteString.Char8 as BS (intercalate,
pack, unwords)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Maybe import Data.Maybe
import Data.Text (intercalate, import qualified Data.Text as T (intercalate,
isInfixOf, replace, isInfixOf, map,
toLower) null, replace,
import qualified Data.Text as T (map, null, takeWhile,
takeWhile) toLower)
import PostgREST.Types import PostgREST.Types
import Protolude hiding (cast, import Protolude hiding (cast,
intercalate, replace, intercalate, replace,
@@ -36,7 +38,7 @@ ignoredBody = "pgrst_ignored_body AS (SELECT $1::text) "
-- We do this in SQL to avoid processing the JSON in application code -- We do this in SQL to avoid processing the JSON in application code
normalizedBody :: SqlFragment normalizedBody :: SqlFragment
normalizedBody = normalizedBody =
unwords [ BS.unwords [
"pgrst_payload AS (SELECT $1::json AS json_data),", "pgrst_payload AS (SELECT $1::json AS json_data),",
"pgrst_body AS (", "pgrst_body AS (",
"SELECT", "SELECT",
@@ -49,17 +51,20 @@ normalizedBody =
selectBody :: SqlFragment selectBody :: SqlFragment
selectBody = "(SELECT val FROM pgrst_body)" selectBody = "(SELECT val FROM pgrst_body)"
pgFmtLit :: SqlFragment -> SqlFragment pgFmtLit :: Text -> SqlFragment
pgFmtLit x = pgFmtLit x =
let trimmed = trimNullChars x let trimmed = trimNullChars x
escaped = "'" <> replace "'" "''" trimmed <> "'" escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = replace "\\" "\\\\" escaped in slashed = T.replace "\\" "\\\\" escaped in
if "\\" `isInfixOf` escaped encodeUtf8 $ if "\\" `T.isInfixOf` escaped
then "E" <> slashed then "E" <> slashed
else slashed else slashed
pgFmtIdent :: SqlFragment -> SqlFragment pgFmtIdent :: Text -> SqlFragment
pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\"" pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
trimNullChars :: Text -> Text
trimNullChars = T.takeWhile (/= '\x0')
asCsvF :: SqlFragment asCsvF :: SqlFragment
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
@@ -92,16 +97,16 @@ locationF pKeys = [qc|(
WHERE json_data.key IN ('{fmtPKeys}') WHERE json_data.key IN ('{fmtPKeys}')
)|] )|]
where where
fmtPKeys = intercalate "','" pKeys fmtPKeys = T.intercalate "','" pKeys
fromQi :: QualifiedIdentifier -> SqlFragment fromQi :: QualifiedIdentifier -> SqlFragment
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n fromQi t = (if T.null s then mempty else pgFmtIdent s <> ".") <> pgFmtIdent n
where where
n = qiName t n = qiName t
s = qiSchema t s = qiSchema t
emptyOnFalse :: Text -> Bool -> Text emptyOnFalse :: SqlFragment -> Bool -> SqlFragment
emptyOnFalse val cond = if cond then "" else val emptyOnFalse val cond = if cond then mempty else val
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table "*" = fromQi table <> ".*"
@@ -112,13 +117,13 @@ pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias 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 " <> cast <> " )" <> 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 :: QualifiedIdentifier -> OrderTerm -> SqlFragment
pgFmtOrderTerm qi ot = unwords [ pgFmtOrderTerm qi ot = BS.unwords [
toS . pgFmtField qi $ otTerm ot, pgFmtField qi $ otTerm ot,
maybe "" show $ otDirection ot, BS.pack $ maybe mempty show $ otDirection ot,
maybe "" show $ otNullOrder ot] BS.pack $ maybe mempty show $ otNullOrder ot]
pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
@@ -131,39 +136,39 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
In vals -> pgFmtField table fld <> " " <> In vals -> pgFmtField table fld <> " " <>
let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')" 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 case (&&) (length vals == 1) . T.null <$> headMay vals of
Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") " Just False -> sqlOperator "in" <> "(" <> BS.intercalate ", " (unknownLiteral <$> vals) <> ") "
Just True -> emptyValForIn Just True -> emptyValForIn
Nothing -> emptyValForIn Nothing -> emptyValForIn
Fts op lang val -> Fts op lang val ->
pgFmtFieldOp op pgFmtFieldOp op
<> "(" <> "("
<> maybe "" ((<> ", ") . pgFmtLit) lang <> maybe mempty ((<> ", ") . pgFmtLit) lang
<> unknownLiteral val <> unknownLiteral val
<> ") " <> ") "
where where
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
sqlOperator o = HM.lookupDefault "=" o operators sqlOperator o = HM.lookupDefault "=" o operators
notOp = if hasNot then "NOT" else "" notOp = if hasNot then "NOT" else mempty
star c = if c == '*' then '%' else c star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit unknownLiteral = (<> "::unknown ") . pgFmtLit
whiteList :: Text -> SqlFragment whiteList :: Text -> SqlFragment
whiteList v = fromMaybe whiteList v = maybe
(toS (pgFmtLit v) <> "::unknown ") (pgFmtLit v <> "::unknown") encodeUtf8
(find ((==) . toLower $ v) ["null","true","false"]) (find ((==) . T.toLower $ v) ["null","true","false"])
pgFmtJoinCondition :: JoinCondition -> SqlFragment pgFmtJoinCondition :: JoinCondition -> SqlFragment
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) = pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2 pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")" pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> BS.intercalate (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
where notOp = if hasNot then "NOT" else "" where notOp = if hasNot then "NOT" else mempty
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
pgFmtJsonPath :: JsonPath -> SqlFragment pgFmtJsonPath :: JsonPath -> SqlFragment
pgFmtJsonPath = \case pgFmtJsonPath = \case
[] -> "" [] -> mempty
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs (JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
(J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
where where
@@ -171,7 +176,7 @@ pgFmtJsonPath = \case
pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int" pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"
pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
pgFmtAs _ [] Nothing = "" pgFmtAs _ [] Nothing = mempty
pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
Just (JKey key) -> " AS " <> pgFmtIdent key Just (JKey key) -> " AS " <> pgFmtIdent key
Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey) Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
@@ -179,12 +184,9 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
-- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ] -- `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": ..} ] -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp) where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
Nothing -> "" Nothing -> mempty
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
trimNullChars :: Text -> Text
trimNullChars = T.takeWhile (/= '\x0')
countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment) countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment)
countF countQuery shouldCount = countF countQuery shouldCount =
if shouldCount if shouldCount
@@ -199,21 +201,21 @@ returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
returningF qi returnings = returningF qi returnings =
if null 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 then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
else "RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings) else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
responseHeadersF :: PgVersion -> SqlFragment responseHeadersF :: PgVersion -> SqlFragment
responseHeadersF pgVer = responseHeadersF pgVer =
if pgVer >= pgVersion96 if pgVer >= pgVersion96
then currentSettingF "response.headers" then currentSettingF "response.headers"
else "null" :: Text else "null"
responseStatusF :: PgVersion -> SqlFragment responseStatusF :: PgVersion -> SqlFragment
responseStatusF pgVer = responseStatusF pgVer =
if pgVer >= pgVersion96 if pgVer >= pgVersion96
then currentSettingF "response.status" then currentSettingF "response.status"
else "null" :: Text else "null"
currentSettingF :: SqlFragment -> SqlFragment currentSettingF :: Text -> SqlFragment
currentSettingF setting = currentSettingF setting =
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15 -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')" "nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
src/PostgREST/QueryBuilder.hs
+31 -31
View File
@@ -20,9 +20,9 @@ module PostgREST.QueryBuilder (
, setLocalSearchPathQuery , setLocalSearchPathQuery
) where ) where
import qualified Data.Set as S import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import Data.Text (intercalate)
import Data.Tree (Tree (..)) import Data.Tree (Tree (..))
import Data.Maybe import Data.Maybe
@@ -36,14 +36,14 @@ import Protolude hiding (cast, intercalate,
readRequestToQuery :: ReadRequest -> SqlQuery readRequestToQuery :: ReadRequest -> SqlQuery
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) = readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
unwords [ BS.unwords [
"SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), "SELECT " <> BS.intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
"FROM " <> intercalate ", " (tabl : implJs), "FROM " <> BS.intercalate ", " (tabl : implJs),
unwords joins, BS.unwords joins,
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) ("WHERE " <> BS.intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
`emptyOnFalse` (null logicForest && null joinConditions_), `emptyOnFalse` (null logicForest && null joinConditions_),
("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts, ("ORDER BY " <> BS.intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (range == allRange) ("LIMIT " <> maybe "ALL" (BS.pack . show) (rangeLimit range) <> " OFFSET " <> (BS.pack . show) (rangeOffset range)) `emptyOnFalse` (range == allRange)
] ]
where where
implJs = fromQi <$> implJoins implJs = fromQi <$> implJoins
@@ -71,27 +71,27 @@ getJoinsSelects (Node (_, (_, Nothing, _, _, _)) _) _ = ([], [])
mutateRequestToQuery :: MutateRequest -> SqlQuery mutateRequestToQuery :: MutateRequest -> SqlQuery
mutateRequestToQuery (Insert mainQi iCols onConflct putConditions returnings) = mutateRequestToQuery (Insert mainQi iCols onConflct putConditions returnings) =
unwords [ BS.unwords [
"WITH " <> normalizedBody, "WITH " <> normalizedBody,
"INSERT INTO ", fromQi mainQi, if S.null iCols then " " else "(" <> cols <> ")", "INSERT INTO ", fromQi mainQi, if S.null iCols then " " else "(" <> cols <> ")",
unwords [ BS.unwords [
"SELECT " <> cols <> " FROM", "SELECT " <> cols <> " FROM",
"json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ") _", "json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ") _",
-- Only used for PUT -- Only used for PUT
("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) `emptyOnFalse` null putConditions], ("WHERE " <> BS.intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) `emptyOnFalse` null putConditions],
maybe "" (\(oncDo, oncCols) -> ( maybe "" (\(oncDo, oncCols) -> (
"ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of "ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
IgnoreDuplicates -> IgnoreDuplicates ->
"DO NOTHING" "DO NOTHING"
MergeDuplicates -> MergeDuplicates ->
if S.null iCols if S.null iCols
then "DO NOTHING" then "DO NOTHING"
else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols) else "DO UPDATE SET " <> BS.intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
) `emptyOnFalse` null oncCols) onConflct, ) `emptyOnFalse` null oncCols) onConflct,
returningF mainQi returnings returningF mainQi returnings
] ]
where where
cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
mutateRequestToQuery (Update mainQi uCols logicForest returnings) = mutateRequestToQuery (Update mainQi uCols logicForest returnings) =
if S.null uCols if S.null uCols
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
@@ -99,30 +99,30 @@ mutateRequestToQuery (Update mainQi uCols logicForest returnings) =
-- the select has to be based on "returnings" to make computed overloaded functions not throw -- the select has to be based on "returnings" to make computed overloaded functions not throw
then "WITH " <> ignoredBody <> "SELECT " <> empty_body_returned_columns <> " FROM " <> fromQi mainQi <> " WHERE false" then "WITH " <> ignoredBody <> "SELECT " <> empty_body_returned_columns <> " FROM " <> fromQi mainQi <> " WHERE false"
else else
unwords [ BS.unwords [
"WITH " <> normalizedBody, "WITH " <> normalizedBody,
"UPDATE " <> fromQi mainQi <> " SET " <> cols, "UPDATE " <> fromQi mainQi <> " SET " <> cols,
"FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ")) _ ", "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ")) _ ",
("WHERE " <> intercalate " AND " (pgFmtLogicTree mainQi <$> logicForest)) `emptyOnFalse` null logicForest, ("WHERE " <> BS.intercalate " AND " (pgFmtLogicTree mainQi <$> logicForest)) `emptyOnFalse` null logicForest,
returningF mainQi returnings returningF mainQi returnings
] ]
where where
cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols) cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
empty_body_returned_columns :: SqlFragment empty_body_returned_columns :: SqlFragment
empty_body_returned_columns empty_body_returned_columns
| null returnings = "NULL" | null returnings = "NULL"
| otherwise = intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings) | otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
mutateRequestToQuery (Delete mainQi logicForest returnings) = mutateRequestToQuery (Delete mainQi logicForest returnings) =
unwords [ BS.unwords [
"WITH " <> ignoredBody, "WITH " <> ignoredBody,
"DELETE FROM ", fromQi mainQi, "DELETE FROM ", fromQi mainQi,
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree mainQi) logicForest)) `emptyOnFalse` null logicForest, ("WHERE " <> BS.intercalate " AND " (map (pgFmtLogicTree mainQi) logicForest)) `emptyOnFalse` null logicForest,
returningF mainQi returnings returningF mainQi returnings
] ]
requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> [FieldName] -> SqlQuery requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> [FieldName] -> SqlQuery
requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings = requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
unwords [ BS.unwords [
"WITH", "WITH",
argsCTE, argsCTE,
sourceBody ] sourceBody ]
@@ -134,10 +134,10 @@ requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
| null pgArgs = (ignoredBody, "") | null pgArgs = (ignoredBody, "")
| paramsAsSingleObject = ("pgrst_args AS (SELECT NULL)", "$1::json") | paramsAsSingleObject = ("pgrst_args AS (SELECT NULL)", "$1::json")
| otherwise = ( | otherwise = (
unwords [ BS.unwords [
normalizedBody <> ",", normalizedBody <> ",",
"pgrst_args AS (", "pgrst_args AS (",
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (\a -> " " <> pgaType a) <> ")", "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (\a -> " " <> encodeUtf8 (pgaType a)) <> ")",
")"] ")"]
, if paramsAsMultipleObjects , if paramsAsMultipleObjects
then fmtArgs (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a)) then fmtArgs (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))
@@ -145,14 +145,14 @@ requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
) )
fmtArgs :: (PgArg -> SqlFragment) -> SqlFragment fmtArgs :: (PgArg -> SqlFragment) -> SqlFragment
fmtArgs argFrag = intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> argFrag a) <$> pgArgs) fmtArgs argFrag = BS.intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> argFrag a) <$> pgArgs)
sourceBody :: SqlFragment sourceBody :: SqlFragment
sourceBody sourceBody
| paramsAsMultipleObjects = | paramsAsMultipleObjects =
if returnsScalar if returnsScalar
then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args" then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
else unwords [ "SELECT pgrst_lat_args.*" else BS.unwords [ "SELECT pgrst_lat_args.*"
, "FROM pgrst_args," , "FROM pgrst_args,"
, "LATERAL ( SELECT " <> returned_columns <> " FROM " <> callIt <> " ) pgrst_lat_args" ] , "LATERAL ( SELECT " <> returned_columns <> " FROM " <> callIt <> " ) pgrst_lat_args" ]
| otherwise = | otherwise =
@@ -166,7 +166,7 @@ requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
returned_columns :: SqlFragment returned_columns :: SqlFragment
returned_columns returned_columns
| null returnings = "*" | null returnings = "*"
| otherwise = intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings) | otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
-- | SQL query meant for COUNTing the root node of the Tree. -- | SQL query meant for COUNTing the root node of the Tree.
@@ -175,14 +175,14 @@ requestToCallProcQuery qi pgArgs returnsScalar preferParams returnings =
-- inside the FROM target. -- inside the FROM target.
readRequestToCountQuery :: ReadRequest -> SqlQuery readRequestToCountQuery :: ReadRequest -> SqlQuery
readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) = readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
unwords [ BS.unwords [
"SELECT 1", "SELECT 1",
"FROM " <> fromQi qi, "FROM " <> fromQi qi,
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest ("WHERE " <> BS.intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
] ]
limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery
limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> show x) maxRows limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows
setLocalQuery :: Text -> (Text, Text) -> SqlQuery setLocalQuery :: Text -> (Text, Text) -> SqlQuery
setLocalQuery prefix (k, v) = setLocalQuery prefix (k, v) =
@@ -190,4 +190,4 @@ setLocalQuery prefix (k, v) =
setLocalSearchPathQuery :: [Text] -> SqlQuery setLocalSearchPathQuery :: [Text] -> SqlQuery
setLocalSearchPathQuery vals = setLocalSearchPathQuery vals =
"SET LOCAL search_path = " <> intercalate ", " (pgFmtLit <$> vals) <> ";" "SET LOCAL search_path = " <> BS.intercalate ", " (pgFmtLit <$> vals) <> ";"
src/PostgREST/Statements.hs
+5 -8
View File
@@ -46,7 +46,7 @@ createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] -> PgVersion -> PreferRepresentation -> [Text] -> PgVersion ->
H.Statement ByteString ResultsWithCount H.Statement ByteString ResultsWithCount
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer = createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
unicodeStatement sql (param HE.unknown) decodeStandard True H.Statement sql (param HE.unknown) decodeStandard True
where where
sql = [qc| sql = [qc|
WITH WITH
@@ -62,7 +62,7 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
locF = locF =
if isInsert && rep `elem` [Full, HeadersOnly] if isInsert && rep `elem` [Full, HeadersOnly]
then unwords [ then BS.unwords [
"CASE WHEN pg_catalog.count(_postgrest_t) = 1", "CASE WHEN pg_catalog.count(_postgrest_t) = 1",
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")", "THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
"ELSE " <> noLocationF, "ELSE " <> noLocationF,
@@ -87,7 +87,7 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Statement () ResultsWithCount H.Statement () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer = createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
unicodeStatement sql HE.noParams decodeStandard False H.Statement sql HE.noParams decodeStandard False
where where
sql = [qc| sql = [qc|
WITH WITH
@@ -132,7 +132,7 @@ callProcStatement :: Bool -> SqlQuery -> SqlQuery -> SqlQuery -> Bool ->
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Statement ByteString ProcResults H.Statement ByteString ProcResults
callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer = callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer =
unicodeStatement sql (param HE.unknown) decodeProc True H.Statement sql (param HE.unknown) decodeProc True
where where
sql = [qc| sql = [qc|
WITH {sourceCTEName} AS ({callProcQuery}) WITH {sourceCTEName} AS ({callProcQuery})
@@ -172,7 +172,7 @@ callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal
createExplainStatement :: SqlQuery -> H.Statement () (Maybe Int64) createExplainStatement :: SqlQuery -> H.Statement () (Maybe Int64)
createExplainStatement countQuery = createExplainStatement countQuery =
unicodeStatement sql HE.noParams decodeExplain False H.Statement sql HE.noParams decodeExplain False
where where
sql = [qc| EXPLAIN (FORMAT JSON) {countQuery} |] sql = [qc| EXPLAIN (FORMAT JSON) {countQuery} |]
-- | -- |
@@ -188,9 +188,6 @@ createExplainStatement countQuery =
let row = HD.singleRow $ column HD.bytea in let row = HD.singleRow $ column HD.bytea in
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row (^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
unicodeStatement = H.Statement . encodeUtf8
decodeGucHeaders :: HD.Value (Either SimpleError [GucHeader]) decodeGucHeaders :: HD.Value (Either SimpleError [GucHeader])
decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . toS <$> HD.bytea decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . toS <$> HD.bytea
src/PostgREST/Types.hs
+2 -2
View File
@@ -62,10 +62,10 @@ decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
ct' -> CTOther ct' ct' -> CTOther ct'
-- | A SQL query that can be executed independently -- | A SQL query that can be executed independently
type SqlQuery = Text type SqlQuery = ByteString
-- | A part of a SQL query that cannot be executed independently -- | A part of a SQL query that cannot be executed independently
type SqlFragment = Text type SqlFragment = ByteString
data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
instance Show PreferResolution where instance Show PreferResolution where
test/QueryCost.hs
+1 -1
View File
@@ -68,7 +68,7 @@ exec pool input query =
explainCost :: SqlQuery -> H.Statement ByteString (Maybe Int64) explainCost :: SqlQuery -> H.Statement ByteString (Maybe Int64)
explainCost query = explainCost query =
H.Statement (encodeUtf8 sql) (HE.param $ HE.nonNullable HE.unknown) decodeExplain False H.Statement sql (HE.param $ HE.nonNullable HE.unknown) decodeExplain False
where where
sql = "EXPLAIN (FORMAT JSON) " <> query sql = "EXPLAIN (FORMAT JSON) " <> query
decodeExplain :: HD.Result (Maybe Int64) decodeExplain :: HD.Result (Maybe Int64)