refactor: Move statements logic to own module
* Move gucHeader decoding to Statements
This commit is contained in:
steve-chavez
committed by
Steve Chávez
Steve Chávez
parent
620721dea7
commit
3c00f46e36
@@ -0,0 +1,210 @@
|
||||
{-|
|
||||
Module : PostgREST.Statements
|
||||
Description : PostgREST single SQL statements.
|
||||
|
||||
This module constructs single SQL statements that can be parametrized and prepared.
|
||||
|
||||
- It consumes the SqlQuery types generated by the QueryBuilder module.
|
||||
- It generates the body format and some headers of the final HTTP response.
|
||||
|
||||
TODO: Currently, createReadStatement is not using prepared statements, see https://github.com/PostgREST/postgrest/issues/718.
|
||||
-}
|
||||
module PostgREST.Statements (
|
||||
createWriteStatement
|
||||
, createReadStatement
|
||||
, callProcStatement
|
||||
) where
|
||||
|
||||
import Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Maybe
|
||||
import Data.Text (intercalate, unwords)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
import PostgREST.ApiRequest (PreferRepresentation (..))
|
||||
import PostgREST.QueryBuilder.Private
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate, replace)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
{-| The generic query result format used by API responses. The location header
|
||||
is represented as a list of strings containing variable bindings like
|
||||
@"k1=eq.42"@, or the empty list if there is no location header.
|
||||
-}
|
||||
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
|
||||
|
||||
createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
|
||||
PreferRepresentation -> [Text] ->
|
||||
H.Statement ByteString ResultsWithCount
|
||||
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
|
||||
unicodeStatement sql (param HE.unknown) decodeStandard True
|
||||
where
|
||||
sql = case rep of
|
||||
None -> [qc|
|
||||
WITH {sourceCTEName} AS ({mutateQuery})
|
||||
SELECT '', 0, {noLocationF}, '' |]
|
||||
HeadersOnly -> [qc|
|
||||
WITH {sourceCTEName} AS ({mutateQuery})
|
||||
SELECT {cols}
|
||||
FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
|
||||
Full -> [qc|
|
||||
WITH {sourceCTEName} AS ({mutateQuery})
|
||||
SELECT {cols}
|
||||
FROM ({selectQuery}) _postgrest_t |]
|
||||
|
||||
cols = intercalate ", " [
|
||||
"'' AS total_result_set", -- when updateing it does not make sense
|
||||
"pg_catalog.count(_postgrest_t) AS page_total",
|
||||
if isInsert
|
||||
then unwords [
|
||||
"CASE",
|
||||
"WHEN pg_catalog.count(_postgrest_t) = 1 THEN",
|
||||
"coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
|
||||
"ELSE " <> noLocationF,
|
||||
"END AS header"]
|
||||
else noLocationF <> "AS header",
|
||||
if rep == Full
|
||||
then bodyF <> " AS body"
|
||||
else "''"
|
||||
]
|
||||
|
||||
bodyF
|
||||
| asCsv = asCsvF
|
||||
| wantSingle = asJsonSingleF
|
||||
| otherwise = asJsonF
|
||||
|
||||
decodeStandard :: HD.Result ResultsWithCount
|
||||
decodeStandard =
|
||||
fromMaybe (Nothing, 0, [], "") <$> HD.rowMaybe standardRow
|
||||
|
||||
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
|
||||
H.Statement () ResultsWithCount
|
||||
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
|
||||
unicodeStatement sql HE.noParams decodeStandard False
|
||||
where
|
||||
sql = [qc|
|
||||
WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
|
||||
FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
|
||||
countResultF = if countTotal then "("<>countQuery<>")" else "null"
|
||||
cols = intercalate ", " [
|
||||
countResultF <> " AS total_result_set",
|
||||
"pg_catalog.count(_postgrest_t) AS page_total",
|
||||
noLocationF <> " AS header",
|
||||
bodyF <> " AS body"
|
||||
]
|
||||
bodyF
|
||||
| asCsv = asCsvF
|
||||
| isSingle = asJsonSingleF
|
||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||
| otherwise = asJsonF
|
||||
|
||||
decodeStandard :: HD.Result ResultsWithCount
|
||||
decodeStandard =
|
||||
HD.singleRow standardRow
|
||||
|
||||
{-| Read and Write api requests use a similar response format which includes
|
||||
various record counts and possible location header. This is the decoder
|
||||
for that common type of query.
|
||||
-}
|
||||
standardRow :: HD.Row ResultsWithCount
|
||||
standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
||||
<*> column header <*> column HD.bytea
|
||||
where
|
||||
header = HD.array $ HD.dimension replicateM $ element HD.bytea
|
||||
|
||||
type ProcResults = (Maybe Int64, Int64, ByteString, Either Text [GucHeader])
|
||||
|
||||
callProcStatement :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
|
||||
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
|
||||
H.Statement ByteString ProcResults
|
||||
callProcStatement qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
|
||||
unicodeStatement sql (param HE.unknown) decodeProc True
|
||||
where
|
||||
sql =[qc|
|
||||
WITH
|
||||
{argsRecord},
|
||||
{sourceCTEName} AS (
|
||||
{sourceBody}
|
||||
)
|
||||
SELECT
|
||||
{countResultF} AS total_result_set,
|
||||
pg_catalog.count(_postgrest_t) AS page_total,
|
||||
{bodyF} AS body,
|
||||
{responseHeaders} AS response_headers
|
||||
FROM ({selectQuery}) _postgrest_t;|]
|
||||
|
||||
(argsRecord, args)
|
||||
| paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
|
||||
| null pgArgs = (ignoredBody, "")
|
||||
| otherwise = (
|
||||
unwords [
|
||||
normalizedBody <> ",",
|
||||
"_args_record AS (",
|
||||
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
|
||||
intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
|
||||
")"]
|
||||
, intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))
|
||||
|
||||
sourceBody :: SqlFragment
|
||||
sourceBody
|
||||
| paramsAsSingleObject || null pgArgs =
|
||||
if returnsScalar
|
||||
then [qc| SELECT {fromQi qi}({args}) |]
|
||||
else [qc| SELECT * FROM {fromQi qi}({args}) |]
|
||||
| otherwise =
|
||||
if returnsScalar
|
||||
then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]
|
||||
else [qc| SELECT _.*
|
||||
FROM _args_record,
|
||||
LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]
|
||||
|
||||
bodyF
|
||||
| returnsScalar = scalarBodyF
|
||||
| isSingle = asJsonSingleF
|
||||
| asCsv = asCsvF
|
||||
| isJust binaryField = asBinaryF $ fromJust binaryField
|
||||
| otherwise = asJsonF
|
||||
|
||||
scalarBodyF
|
||||
| asBinary = asBinaryF _procName
|
||||
| otherwise = unwords [
|
||||
"CASE",
|
||||
"WHEN pg_catalog.count(_postgrest_t) = 1",
|
||||
"THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",
|
||||
"ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",
|
||||
"END"]
|
||||
|
||||
countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
|
||||
_procName = qiName qi
|
||||
responseHeaders =
|
||||
if pgVer >= pgVersion96
|
||||
then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
||||
else "'[]'" :: Text
|
||||
|
||||
decodeProc :: HD.Result ProcResults
|
||||
decodeProc =
|
||||
let row = fromMaybe (Just 0, 0, "[]", "[]") <$> HD.rowMaybe procRow in
|
||||
(\(a, b, c, d) -> (a, b, c, first toS $ JSON.eitherDecode $ toS d)) <$> row
|
||||
where
|
||||
procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
||||
<*> column HD.bytea <*> column HD.bytea
|
||||
|
||||
unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
|
||||
unicodeStatement = H.Statement . encodeUtf8
|
||||
|
||||
-- Helper hasql functions
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
element :: HD.Value a -> HD.Array a
|
||||
element = HD.element . HD.nonNullable
|
||||
|
||||
param :: HE.Value a -> HE.Params a
|
||||
param = HE.param . HE.nonNullable
|
||||
Reference in New Issue
Block a user