refactor: Move statements logic to own module

* Move gucHeader decoding to Statements
This commit is contained in:
steve-chavez
2019-09-11 12:01:41 -05:00
committed by Steve Chávez
parent 620721dea7
commit 3c00f46e36
8 changed files with 239 additions and 256 deletions
+1 -3
View File
@@ -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
+7 -8
View File
@@ -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
+10 -26
View File
@@ -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
+11 -36
View File
@@ -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
-88
View File
@@ -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
+210
View File
@@ -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