module PostgREST.Statements (
createWriteStatement
, createReadStatement
, callProcStatement
, createExplainStatement
) where
import Control.Lens ((^?))
import Data.Aeson as JSON
import qualified Data.Aeson.Lens as L
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as H
import PostgREST.Private.Common
import PostgREST.Private.QueryFragment
import PostgREST.Types
import Protolude hiding (cast,
replace, toS)
import Protolude.Conv (toS)
import Text.InterpolatedString.Perl6 (qc)
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Text [GucHeader])
createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] -> PgVersion ->
H.Statement ByteString ResultsWithCount
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
unicodeStatement sql (param HE.unknown) decodeStandard True
where
sql = [qc|
WITH
{sourceCTEName} AS ({mutateQuery})
SELECT
'' AS total_result_set,
pg_catalog.count(_postgrest_t) AS page_total,
{locF} AS header,
{bodyF} AS body,
{responseHeadersF pgVer} AS response_headers
FROM ({selectF}) _postgrest_t |]
locF =
if isInsert && rep `elem` [Full, HeadersOnly]
then unwords [
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
"ELSE " <> noLocationF,
"END"]
else noLocationF
bodyF
| rep `elem` [None, HeadersOnly] = "''"
| asCsv = asCsvF
| wantSingle = asJsonSingleF
| otherwise = asJsonF
selectF
| rep `elem` [None, HeadersOnly] = "SELECT * FROM " <> sourceCTEName
| otherwise = selectQuery
decodeStandard :: HD.Result ResultsWithCount
decodeStandard =
fromMaybe (Nothing, 0, [], mempty, Right []) <$> HD.rowMaybe standardRow
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Statement () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
unicodeStatement sql HE.noParams decodeStandard False
where
sql = [qc|
WITH
{sourceCTEName} AS ({selectQuery})
{countCTEF}
SELECT
{countResultF} AS total_result_set,
pg_catalog.count(_postgrest_t) AS page_total,
{noLocationF} AS header,
{bodyF} AS body,
{responseHeadersF pgVer} AS response_headers
FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| asCsv = asCsvF
| isSingle = asJsonSingleF
| isJust binaryField = asBinaryF $ fromJust binaryField
| otherwise = asJsonF
decodeStandard :: HD.Result ResultsWithCount
decodeStandard =
HD.singleRow standardRow
standardRow :: HD.Row ResultsWithCount
standardRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> column header <*> column HD.bytea <*> column decodeGucHeaders
where
header = HD.array $ HD.dimension replicateM $ element HD.bytea
type ProcResults = (Maybe Int64, Int64, ByteString, Either Text [GucHeader])
callProcStatement :: Bool -> SqlQuery -> SqlQuery -> SqlQuery -> Bool ->
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Statement ByteString ProcResults
callProcStatement returnsScalar callProcQuery selectQuery countQuery countTotal isSingle asCsv asBinary multObjects binaryField pgVer =
unicodeStatement sql (param HE.unknown) decodeProc True
where
sql = [qc|
WITH {sourceCTEName} AS ({callProcQuery})
{countCTEF}
SELECT
{countResultF} AS total_result_set,
pg_catalog.count(_postgrest_t) AS page_total,
{bodyF} AS body,
{responseHeadersF pgVer} AS response_headers
FROM ({selectQuery}) _postgrest_t;|]
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| returnsScalar = scalarBodyF
| isSingle = asJsonSingleF
| asCsv = asCsvF
| isJust binaryField = asBinaryF $ fromJust binaryField
| otherwise = asJsonF
scalarBodyF
| asBinary = asBinaryF "pgrst_scalar"
| multObjects = "json_agg(_postgrest_t.pgrst_scalar)::character varying"
| otherwise = "(json_agg(_postgrest_t.pgrst_scalar)->0)::character varying"
decodeProc :: HD.Result ProcResults
decodeProc =
fromMaybe (Just 0, 0, mempty, Right []) <$> HD.rowMaybe procRow
where
procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> column HD.bytea <*> column decodeGucHeaders
createExplainStatement :: SqlQuery -> H.Statement () (Maybe Int64)
createExplainStatement countQuery =
unicodeStatement sql HE.noParams decodeExplain False
where
sql = [qc| EXPLAIN (FORMAT JSON) {countQuery} |]
decodeExplain :: HD.Result (Maybe Int64)
decodeExplain =
let row = HD.singleRow $ column HD.bytea in
(^? 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 Text [GucHeader])
decodeGucHeaders = first toS . JSON.eitherDecode . toS <$> HD.bytea