refactor: Move statements logic to own module
* Move gucHeader decoding to Statements
This commit is contained in:
committed by
Steve Chávez
parent
620721dea7
commit
3c00f46e36
+1
-3
@@ -36,13 +36,11 @@ library
|
||||
PostgREST.OpenAPI
|
||||
PostgREST.Parsers
|
||||
PostgREST.QueryBuilder
|
||||
PostgREST.Statements
|
||||
PostgREST.RangeQuery
|
||||
PostgREST.Types
|
||||
other-modules: Paths_postgrest
|
||||
PostgREST.QueryBuilder.Private
|
||||
PostgREST.QueryBuilder.Procedure
|
||||
PostgREST.QueryBuilder.ReadStatement
|
||||
PostgREST.QueryBuilder.WriteStatement
|
||||
hs-source-dirs: src
|
||||
build-depends: base >= 4.9 && < 4.13
|
||||
, HTTP >= 4000.3.7 && < 4000.4
|
||||
|
||||
@@ -26,7 +26,6 @@ import qualified Hasql.Transaction as H
|
||||
import qualified Hasql.Transaction as HT
|
||||
import qualified Hasql.Transaction.Sessions as HT
|
||||
|
||||
import Data.Aeson as JSON
|
||||
import Data.Function (id)
|
||||
import Data.IORef (IORef, readIORef)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
@@ -56,12 +55,13 @@ import PostgREST.Error (PgError (..), SimpleError (..),
|
||||
import PostgREST.Middleware
|
||||
import PostgREST.OpenAPI
|
||||
import PostgREST.Parsers (pRequestColumns)
|
||||
import PostgREST.QueryBuilder (callProc, createReadStatement,
|
||||
createWriteStatement,
|
||||
requestToCountQuery,
|
||||
import PostgREST.QueryBuilder (requestToCountQuery,
|
||||
requestToQuery)
|
||||
import PostgREST.RangeQuery (allRange, contentRangeH,
|
||||
rangeStatusHeader)
|
||||
import PostgREST.Statements (callProcStatement,
|
||||
createReadStatement,
|
||||
createWriteStatement)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (Proxy, intercalate)
|
||||
|
||||
@@ -282,15 +282,14 @@ app dbStructure proc cols conf apiRequest =
|
||||
Right ((q, cq), bField) -> do
|
||||
let singular = contentType == CTSingularJSON
|
||||
row <- H.statement (toS $ pjRaw pJson) $
|
||||
callProc qi (specifiedProcArgs cols proc) returnsScalar q cq shouldCount
|
||||
callProcStatement qi (specifiedProcArgs cols proc) returnsScalar q cq shouldCount
|
||||
singular (iPreferSingleObjectParameter apiRequest)
|
||||
(contentType == CTTextCSV)
|
||||
(contentType `elem` rawContentTypes) bField
|
||||
(pgVersion dbStructure)
|
||||
let (tableTotal, queryTotal, body, jsonHeaders) = row
|
||||
let (tableTotal, queryTotal, body, gucHeaders) = row
|
||||
(status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal
|
||||
decodedHeaders = first toS $ JSON.eitherDecode $ toS jsonHeaders :: Either Text [GucHeader]
|
||||
case decodedHeaders of
|
||||
case gucHeaders of
|
||||
Left _ -> return . errorResponseFor $ GucHeadersError
|
||||
Right hs ->
|
||||
if singular && queryTotal /= 1
|
||||
|
||||
@@ -4,44 +4,35 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-|
|
||||
Module : PostgREST.QueryBuilder
|
||||
Description : PostgREST SQL generating functions.
|
||||
Description : PostgREST SQL fragments generating functions.
|
||||
|
||||
This module provides functions to consume data types that
|
||||
represent database objects (e.g. Relation, Schema, SqlQuery)
|
||||
and produces SQL Statements.
|
||||
and produces SQL fragments.
|
||||
|
||||
Any function that outputs a SQL fragment should be in this module.
|
||||
-}
|
||||
module PostgREST.QueryBuilder (
|
||||
callProc
|
||||
, createReadStatement
|
||||
, createWriteStatement
|
||||
, requestToQuery
|
||||
requestToQuery
|
||||
, requestToCountQuery
|
||||
, unquoted
|
||||
, ResultsWithCount
|
||||
, pgFmtSetLocal
|
||||
, pgFmtSetLocalSearchPath
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Data.Scientific (FPFormat (..), formatScientific, isInteger)
|
||||
import Data.Text (intercalate, unwords)
|
||||
import Data.Tree (Tree (..))
|
||||
import Data.Text (intercalate, unwords)
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
import PostgREST.QueryBuilder.Private
|
||||
import PostgREST.QueryBuilder.Procedure
|
||||
import PostgREST.QueryBuilder.ReadStatement
|
||||
import PostgREST.QueryBuilder.WriteStatement
|
||||
import PostgREST.RangeQuery (allRange, rangeLimit,
|
||||
rangeOffset)
|
||||
import PostgREST.RangeQuery (allRange, rangeLimit,
|
||||
rangeOffset)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate, replace)
|
||||
import Protolude hiding (cast, intercalate,
|
||||
replace)
|
||||
|
||||
requestToCountQuery :: Schema -> DbRequest -> SqlQuery
|
||||
requestToCountQuery _ (DbMutate _) = witness
|
||||
@@ -144,10 +135,3 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
|
||||
]
|
||||
where
|
||||
qi = QualifiedIdentifier schema mainTbl
|
||||
|
||||
unquoted :: JSON.Value -> Text
|
||||
unquoted (JSON.String t) = t
|
||||
unquoted (JSON.Number n) =
|
||||
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
||||
unquoted (JSON.Bool b) = show b
|
||||
unquoted v = toS $ JSON.encode v
|
||||
|
||||
@@ -5,51 +5,22 @@ Description : Helper functions for PostgREST.QueryBuilder.
|
||||
-}
|
||||
module PostgREST.QueryBuilder.Private where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Maybe
|
||||
import Data.Scientific (FPFormat (..),
|
||||
formatScientific,
|
||||
isInteger)
|
||||
import Data.Text (intercalate,
|
||||
isInfixOf, replace,
|
||||
toLower, unwords)
|
||||
import qualified Data.Text as T (map, null,
|
||||
takeWhile)
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate, replace)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
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
|
||||
|
||||
{-| 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)
|
||||
|
||||
{-| 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
|
||||
|
||||
noLocationF :: Text
|
||||
noLocationF = "array[]::text[]"
|
||||
|
||||
@@ -131,9 +102,6 @@ fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
|
||||
n = qiName t
|
||||
s = qiSchema t
|
||||
|
||||
unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b
|
||||
unicodeStatement = H.Statement . T.encodeUtf8
|
||||
|
||||
emptyOnFalse :: Text -> Bool -> Text
|
||||
emptyOnFalse val cond = if cond then "" else val
|
||||
|
||||
@@ -227,3 +195,10 @@ pgFmtSetLocalSearchPath vals =
|
||||
|
||||
trimNullChars :: Text -> Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
|
||||
unquoted :: JSON.Value -> Text
|
||||
unquoted (JSON.String t) = t
|
||||
unquoted (JSON.Number n) =
|
||||
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
|
||||
unquoted (JSON.Bool b) = show b
|
||||
unquoted v = toS $ JSON.encode v
|
||||
|
||||
@@ -1,88 +0,0 @@
|
||||
module PostgREST.QueryBuilder.Procedure where
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Text (intercalate, unwords)
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
import PostgREST.QueryBuilder.Private
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate, replace)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
|
||||
|
||||
callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
|
||||
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
|
||||
H.Statement ByteString ProcResults
|
||||
callProc 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 =
|
||||
fromMaybe (Just 0, 0, "[]", "[]") <$> HD.rowMaybe procRow
|
||||
where
|
||||
procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
||||
<*> column HD.bytea <*> column HD.bytea
|
||||
@@ -1,37 +0,0 @@
|
||||
module PostgREST.QueryBuilder.ReadStatement where
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Text (intercalate)
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
import PostgREST.QueryBuilder.Private
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate, replace)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
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
|
||||
@@ -1,58 +0,0 @@
|
||||
module PostgREST.QueryBuilder.WriteStatement where
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Text (intercalate, unwords)
|
||||
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)
|
||||
|
||||
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) decodeStandardMay 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
|
||||
|
||||
decodeStandardMay :: HD.Result ResultsWithCount
|
||||
decodeStandardMay =
|
||||
fromMaybe (Nothing, 0, [], "") <$> HD.rowMaybe standardRow
|
||||
@@ -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