jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update hasql

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