Update hasql
Move to hasql 1.3.
This commit is contained in:
Ben Gamari
+3
-3
@@ -64,9 +64,9 @@ library
|
||||
, contravariant-extras
|
||||
, either
|
||||
, gitrev
|
||||
, hasql == 1.1
|
||||
, hasql-pool == 0.4.3
|
||||
, hasql-transaction == 0.5.2
|
||||
, hasql >= 1.3
|
||||
, hasql-pool >= 0.5
|
||||
, hasql-transaction >= 0.7
|
||||
, heredoc
|
||||
, HTTP
|
||||
, http-types
|
||||
|
||||
@@ -102,7 +102,7 @@ findProc qi payloadKeys paramsAsSingleObject allProcs =
|
||||
else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x))
|
||||
) <$> procs
|
||||
|
||||
transactionMode :: Maybe ProcDescription -> Action -> H.Mode
|
||||
transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
|
||||
transactionMode proc action =
|
||||
case action of
|
||||
ActionRead -> HT.Read
|
||||
@@ -131,7 +131,7 @@ app dbStructure proc conf apiRequest =
|
||||
Right ((q, cq), bField) -> do
|
||||
let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
|
||||
(contentType == CTTextCSV) bField
|
||||
row <- H.query () stm
|
||||
row <- H.statement () stm
|
||||
let (tableTotal, queryTotal, _ , body) = row
|
||||
(status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
canonical = iCanonicalQS apiRequest
|
||||
@@ -162,7 +162,7 @@ app dbStructure proc conf apiRequest =
|
||||
stm = createWriteStatement sq mq
|
||||
(contentType == CTSingularJSON) isSingle
|
||||
(contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
|
||||
row <- H.query (toS pjRaw) stm
|
||||
row <- H.statement (toS pjRaw) stm
|
||||
let (_, _, fs, body) = extractQueryResult row
|
||||
headers = catMaybes [
|
||||
if null fs
|
||||
@@ -191,7 +191,7 @@ app dbStructure proc conf apiRequest =
|
||||
let stm = createWriteStatement sq mq
|
||||
(contentType == CTSingularJSON) False (contentType == CTTextCSV)
|
||||
(iPreferRepresentation apiRequest) []
|
||||
row <- H.query (toS pjRaw) stm
|
||||
row <- H.statement (toS pjRaw) stm
|
||||
let (_, queryTotal, _, body) = extractQueryResult row
|
||||
if contentType == CTSingularJSON
|
||||
&& queryTotal /= 1
|
||||
@@ -224,7 +224,7 @@ app dbStructure proc conf apiRequest =
|
||||
else if S.fromList colNames /= pjKeys
|
||||
then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT"
|
||||
else do
|
||||
row <- H.query (toS pjRaw) $
|
||||
row <- H.statement (toS pjRaw) $
|
||||
createWriteStatement sq mq (contentType == CTSingularJSON) False
|
||||
(contentType == CTTextCSV) (iPreferRepresentation apiRequest) []
|
||||
let (_, queryTotal, _, body) = extractQueryResult row
|
||||
@@ -248,7 +248,7 @@ app dbStructure proc conf apiRequest =
|
||||
(contentType == CTSingularJSON) False
|
||||
(contentType == CTTextCSV)
|
||||
(iPreferRepresentation apiRequest) []
|
||||
row <- H.query mempty stm
|
||||
row <- H.statement mempty stm
|
||||
let (_, queryTotal, _, body) = extractQueryResult row
|
||||
r = contentRangeH 1 0 $
|
||||
toInteger <$> if shouldCount then Just queryTotal else Nothing
|
||||
@@ -287,7 +287,7 @@ app dbStructure proc conf apiRequest =
|
||||
PJArray _ -> False
|
||||
singular = contentType == CTSingularJSON
|
||||
specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)
|
||||
row <- H.query (toS pjRaw) $
|
||||
row <- H.statement (toS pjRaw) $
|
||||
callProc qi specifiedPgArgs returnsScalar q cq shouldCount
|
||||
singular (iPreferSingleObjectParameter apiRequest)
|
||||
(contentType == CTTextCSV)
|
||||
@@ -316,7 +316,7 @@ app dbStructure proc conf apiRequest =
|
||||
toTableInfo :: [Table] -> [(Table, [Column], [Text])]
|
||||
toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
|
||||
encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
|
||||
body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
|
||||
body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs
|
||||
return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
|
||||
|
||||
_ -> return notFound
|
||||
|
||||
@@ -14,7 +14,7 @@ module PostgREST.DbStructure (
|
||||
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Query as H
|
||||
import qualified Hasql.Statement as H
|
||||
|
||||
import Control.Applicative
|
||||
import qualified Data.HashMap.Strict as M
|
||||
@@ -34,12 +34,12 @@ import Unsafe (unsafeHead)
|
||||
|
||||
getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
|
||||
getDbStructure schema pgVer = do
|
||||
tabs <- H.query () allTables
|
||||
cols <- H.query schema $ allColumns tabs
|
||||
syns <- H.query schema $ allSynonyms cols
|
||||
childRels <- H.query () $ allChildRelations tabs cols
|
||||
keys <- H.query () $ allPrimaryKeys tabs
|
||||
procs <- H.query schema allProcs
|
||||
tabs <- H.statement () allTables
|
||||
cols <- H.statement schema $ allColumns tabs
|
||||
syns <- H.statement schema $ allSynonyms cols
|
||||
childRels <- H.statement () $ allChildRelations tabs cols
|
||||
keys <- H.statement () $ allPrimaryKeys tabs
|
||||
procs <- H.statement schema allProcs
|
||||
|
||||
let rels = addManyToManyRelations . addParentRelations $ addViewRelations syns childRels
|
||||
cols' = addForeignKeys rels cols
|
||||
@@ -56,70 +56,70 @@ getDbStructure schema pgVer = do
|
||||
|
||||
decodeTables :: HD.Result [Table]
|
||||
decodeTables =
|
||||
HD.rowsList tblRow
|
||||
HD.rowList tblRow
|
||||
where
|
||||
tblRow = Table <$> HD.value HD.text
|
||||
<*> HD.value HD.text
|
||||
<*> HD.nullableValue HD.text
|
||||
<*> HD.value HD.bool
|
||||
tblRow = Table <$> HD.column HD.text
|
||||
<*> HD.column HD.text
|
||||
<*> HD.nullableColumn HD.text
|
||||
<*> HD.column HD.bool
|
||||
|
||||
decodeColumns :: [Table] -> HD.Result [Column]
|
||||
decodeColumns tables =
|
||||
mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
|
||||
mapMaybe (columnFromRow tables) <$> HD.rowList colRow
|
||||
where
|
||||
colRow =
|
||||
(,,,,,,,,,,,)
|
||||
<$> HD.value HD.text <*> HD.value HD.text
|
||||
<*> HD.value HD.text <*> HD.nullableValue HD.text
|
||||
<*> HD.value HD.int4 <*> HD.value HD.bool
|
||||
<*> HD.value HD.text <*> HD.value HD.bool
|
||||
<*> HD.nullableValue HD.int4
|
||||
<*> HD.nullableValue HD.int4
|
||||
<*> HD.nullableValue HD.text
|
||||
<*> HD.nullableValue HD.text
|
||||
<$> HD.column HD.text <*> HD.column HD.text
|
||||
<*> HD.column HD.text <*> HD.nullableColumn HD.text
|
||||
<*> HD.column HD.int4 <*> HD.column HD.bool
|
||||
<*> HD.column HD.text <*> HD.column HD.bool
|
||||
<*> HD.nullableColumn HD.int4
|
||||
<*> HD.nullableColumn HD.int4
|
||||
<*> HD.nullableColumn HD.text
|
||||
<*> HD.nullableColumn HD.text
|
||||
|
||||
decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
|
||||
decodeRelations tables cols =
|
||||
mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
|
||||
mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow
|
||||
where
|
||||
relRow = (,,,,,)
|
||||
<$> HD.value HD.text
|
||||
<*> HD.value HD.text
|
||||
<*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
|
||||
<*> HD.value HD.text
|
||||
<*> HD.value HD.text
|
||||
<*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))
|
||||
<$> HD.column HD.text
|
||||
<*> HD.column HD.text
|
||||
<*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
|
||||
<*> HD.column HD.text
|
||||
<*> HD.column HD.text
|
||||
<*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
|
||||
|
||||
decodePks :: [Table] -> HD.Result [PrimaryKey]
|
||||
decodePks tables =
|
||||
mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow
|
||||
mapMaybe (pkFromRow tables) <$> HD.rowList pkRow
|
||||
where
|
||||
pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
|
||||
pkRow = (,,) <$> HD.column HD.text <*> HD.column HD.text <*> HD.column HD.text
|
||||
|
||||
decodeSynonyms :: [Column] -> HD.Result [Synonym]
|
||||
decodeSynonyms cols =
|
||||
mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
|
||||
mapMaybe (synonymFromRow cols) <$> HD.rowList synRow
|
||||
where
|
||||
synRow = (,,,,,)
|
||||
<$> HD.value HD.text <*> HD.value HD.text
|
||||
<*> HD.value HD.text <*> HD.value HD.text
|
||||
<*> HD.value HD.text <*> HD.value HD.text
|
||||
<$> HD.column HD.text <*> HD.column HD.text
|
||||
<*> HD.column HD.text <*> HD.column HD.text
|
||||
<*> HD.column HD.text <*> HD.column HD.text
|
||||
|
||||
decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
|
||||
decodeProcs =
|
||||
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
|
||||
map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowsList tblRow
|
||||
map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow
|
||||
where
|
||||
tblRow = ProcDescription
|
||||
<$> HD.value HD.text
|
||||
<*> HD.nullableValue HD.text
|
||||
<*> (parseArgs <$> HD.value HD.text)
|
||||
<$> HD.column HD.text
|
||||
<*> HD.nullableColumn HD.text
|
||||
<*> (parseArgs <$> HD.column HD.text)
|
||||
<*> (parseRetType
|
||||
<$> HD.value HD.text
|
||||
<*> HD.value HD.text
|
||||
<*> HD.value HD.bool
|
||||
<*> HD.value HD.char)
|
||||
<*> (parseVolatility <$> HD.value HD.char)
|
||||
<$> HD.column HD.text
|
||||
<*> HD.column HD.text
|
||||
<*> HD.column HD.bool
|
||||
<*> HD.column HD.char)
|
||||
<*> (parseVolatility <$> HD.column HD.char)
|
||||
|
||||
addName :: ProcDescription -> (Text, ProcDescription)
|
||||
addName pd = (pdName pd, pd)
|
||||
@@ -155,11 +155,11 @@ decodeProcs =
|
||||
| v == 's' = Stable
|
||||
| otherwise = Volatile -- only 'v' can happen here
|
||||
|
||||
allProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
|
||||
allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True
|
||||
allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
|
||||
allProcs = H.Statement (toS procsSqlQuery) (HE.param HE.text) decodeProcs True
|
||||
|
||||
accessibleProcs :: H.Query Schema (M.HashMap Text [ProcDescription])
|
||||
accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
|
||||
accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
|
||||
accessibleProcs = H.Statement (toS sql) (HE.param HE.text) decodeProcs True
|
||||
where
|
||||
sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
|
||||
|
||||
@@ -182,9 +182,9 @@ procsSqlQuery = [q|
|
||||
WHERE pn.nspname = $1
|
||||
|]
|
||||
|
||||
schemaDescription :: H.Query Schema (Maybe Text)
|
||||
schemaDescription :: H.Statement Schema (Maybe Text)
|
||||
schemaDescription =
|
||||
H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
|
||||
H.Statement sql (HE.param HE.text) (join <$> HD.rowMaybe (HD.nullableColumn HD.text)) True
|
||||
where
|
||||
sql = [q|
|
||||
select
|
||||
@@ -195,9 +195,9 @@ schemaDescription =
|
||||
where
|
||||
n.nspname = $1 |]
|
||||
|
||||
accessibleTables :: H.Query Schema [Table]
|
||||
accessibleTables :: H.Statement Schema [Table]
|
||||
accessibleTables =
|
||||
H.statement sql (HE.value HE.text) decodeTables True
|
||||
H.Statement sql (HE.param HE.text) decodeTables True
|
||||
where
|
||||
sql = [q|
|
||||
select
|
||||
@@ -324,9 +324,9 @@ addViewPrimaryKeys syns = concatMap (\pk ->
|
||||
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in
|
||||
pk : viewPks)
|
||||
|
||||
allTables :: H.Query () [Table]
|
||||
allTables :: H.Statement () [Table]
|
||||
allTables =
|
||||
H.statement sql HE.unit decodeTables True
|
||||
H.Statement sql HE.unit decodeTables True
|
||||
where
|
||||
sql = [q|
|
||||
SELECT
|
||||
@@ -347,9 +347,9 @@ allTables =
|
||||
GROUP BY table_schema, table_name, insertable
|
||||
ORDER BY table_schema, table_name |]
|
||||
|
||||
allColumns :: [Table] -> H.Query Schema [Column]
|
||||
allColumns :: [Table] -> H.Statement Schema [Column]
|
||||
allColumns tabs =
|
||||
H.statement sql (HE.value HE.text) (decodeColumns tabs) True
|
||||
H.Statement sql (HE.param HE.text) (decodeColumns tabs) True
|
||||
where
|
||||
sql = [q|
|
||||
SELECT DISTINCT
|
||||
@@ -534,9 +534,9 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
|
||||
parseEnum :: Maybe Text -> [Text]
|
||||
parseEnum str = fromMaybe [] $ split (==',') <$> str
|
||||
|
||||
allChildRelations :: [Table] -> [Column] -> H.Query () [Relation]
|
||||
allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
|
||||
allChildRelations tabs cols =
|
||||
H.statement sql HE.unit (decodeRelations tabs cols) True
|
||||
H.Statement sql HE.unit (decodeRelations tabs cols) True
|
||||
where
|
||||
sql = [q|
|
||||
SELECT ns1.nspname AS table_schema,
|
||||
@@ -575,9 +575,9 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
|
||||
cols = mapM (findCol rs rt) rcs
|
||||
colsF = mapM (findCol frs frt) frcs
|
||||
|
||||
allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
|
||||
allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey]
|
||||
allPrimaryKeys tabs =
|
||||
H.statement sql HE.unit (decodePks tabs) True
|
||||
H.Statement sql HE.unit (decodePks tabs) True
|
||||
where
|
||||
sql = [q|
|
||||
/*
|
||||
@@ -685,9 +685,9 @@ pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
|
||||
pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
|
||||
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
|
||||
|
||||
allSynonyms :: [Column] -> H.Query Schema [Synonym]
|
||||
allSynonyms :: [Column] -> H.Statement Schema [Synonym]
|
||||
allSynonyms cols =
|
||||
H.statement sql (HE.value HE.text) (decodeSynonyms cols) True
|
||||
H.Statement sql (HE.param HE.text) (decodeSynonyms cols) True
|
||||
-- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
|
||||
where sql = [q|
|
||||
with
|
||||
@@ -756,7 +756,7 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
|
||||
findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
|
||||
|
||||
getPgVersion :: H.Session PgVersion
|
||||
getPgVersion = H.query () $ H.statement sql HE.unit versionRow False
|
||||
getPgVersion = H.statement () $ H.Statement sql HE.unit versionRow False
|
||||
where
|
||||
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
||||
versionRow = HD.singleRow $ PgVersion <$> HD.value HD.int4 <*> HD.value HD.text
|
||||
versionRow = HD.singleRow $ PgVersion <$> HD.column HD.int4 <*> HD.column HD.text
|
||||
|
||||
@@ -118,7 +118,10 @@ instance JSON.ToJSON P.UsageError where
|
||||
"details" .= (toS $ fromMaybe "" e :: Text)]
|
||||
toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
|
||||
|
||||
instance JSON.ToJSON H.Error where
|
||||
instance JSON.ToJSON H.QueryError where
|
||||
toJSON (H.QueryError _ _ e) = JSON.toJSON e
|
||||
|
||||
instance JSON.ToJSON H.CommandError where
|
||||
toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
|
||||
'P':'T':_ ->
|
||||
JSON.object [
|
||||
@@ -154,7 +157,7 @@ instance JSON.ToJSON H.Error where
|
||||
|
||||
httpStatus :: Bool -> P.UsageError -> HT.Status
|
||||
httpStatus _ (P.ConnectionError _) = HT.status503
|
||||
httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =
|
||||
httpStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError (H.ServerError c m _ _)))) =
|
||||
case toS c of
|
||||
'0':'8':_ -> HT.status503 -- pg connection err
|
||||
'0':'9':_ -> HT.status500 -- triggered action exception
|
||||
@@ -184,5 +187,5 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =
|
||||
"42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege
|
||||
'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
|
||||
_ -> HT.status400
|
||||
httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
|
||||
httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503
|
||||
httpStatus _ (P.SessionError (H.QueryError _ _ (H.ResultError _))) = HT.status500
|
||||
httpStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503
|
||||
|
||||
@@ -26,7 +26,7 @@ module PostgREST.QueryBuilder (
|
||||
, pgFmtSetLocal
|
||||
) where
|
||||
|
||||
import qualified Hasql.Query as H
|
||||
import qualified Hasql.Statement as H
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Decoders as HD
|
||||
|
||||
@@ -58,10 +58,10 @@ import PostgREST.ApiRequest (PreferRepresentation (..))
|
||||
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
|
||||
|
||||
standardRow :: HD.Row ResultsWithCount
|
||||
standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value header <*> HD.value HD.bytea
|
||||
standardRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
|
||||
<*> HD.column header <*> HD.column HD.bytea
|
||||
where
|
||||
header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
|
||||
header = HD.array $ HD.dimension replicateM $ HD.element HD.bytea
|
||||
|
||||
noLocationF :: Text
|
||||
noLocationF = "array[]::text[]"
|
||||
@@ -76,10 +76,10 @@ decodeStandard =
|
||||
|
||||
decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
|
||||
decodeStandardMay =
|
||||
HD.maybeRow standardRow
|
||||
HD.rowMaybe standardRow
|
||||
|
||||
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
|
||||
H.Query () ResultsWithCount
|
||||
H.Statement () ResultsWithCount
|
||||
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
|
||||
unicodeStatement sql HE.unit decodeStandard False
|
||||
where
|
||||
@@ -102,9 +102,9 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
|
||||
|
||||
createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
|
||||
PreferRepresentation -> [Text] ->
|
||||
H.Query ByteString (Maybe ResultsWithCount)
|
||||
H.Statement ByteString (Maybe ResultsWithCount)
|
||||
createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
|
||||
unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True
|
||||
unicodeStatement sql (HE.param HE.unknown) decodeStandardMay True
|
||||
|
||||
where
|
||||
sql = case rep of
|
||||
@@ -139,9 +139,9 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
|
||||
type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
|
||||
callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
|
||||
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
|
||||
H.Query ByteString (Maybe ProcResults)
|
||||
H.Statement ByteString (Maybe ProcResults)
|
||||
callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =
|
||||
unicodeStatement sql (HE.value HE.unknown) decodeProc True
|
||||
unicodeStatement sql (HE.param HE.unknown) decodeProc True
|
||||
where
|
||||
sql =
|
||||
if returnsScalar then [qc|
|
||||
@@ -182,9 +182,9 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
|
||||
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.maybeRow procRow
|
||||
procRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value HD.bytea <*> HD.value HD.bytea
|
||||
decodeProc = HD.rowMaybe procRow
|
||||
procRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
|
||||
<*> HD.column HD.bytea <*> HD.column HD.bytea
|
||||
scalarBodyF
|
||||
| asBinary = asBinaryF _procName
|
||||
| otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
|
||||
@@ -381,8 +381,8 @@ 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.Query a b
|
||||
unicodeStatement = H.statement . T.encodeUtf8
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user