Date: Thursday, January 24, 2019 @ 23:18:43 Author: felixonmars Revision: 427650
archrelease: copy trunk to community-staging-x86_64 Added: postgrest/repos/community-staging-x86_64/ postgrest/repos/community-staging-x86_64/PKGBUILD (from rev 427649, postgrest/trunk/PKGBUILD) postgrest/repos/community-staging-x86_64/new-hasql.patch (from rev 427649, postgrest/trunk/new-hasql.patch) -----------------+ PKGBUILD | 74 ++++++++ new-hasql.patch | 477 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 551 insertions(+) Copied: postgrest/repos/community-staging-x86_64/PKGBUILD (from rev 427649, postgrest/trunk/PKGBUILD) =================================================================== --- community-staging-x86_64/PKGBUILD (rev 0) +++ community-staging-x86_64/PKGBUILD 2019-01-24 23:18:43 UTC (rev 427650) @@ -0,0 +1,74 @@ +# Maintainer: Felix Yan <felixonm...@archlinux.org> +# Contributor: Arch Haskell Team <arch-hask...@haskell.org> + +pkgname=postgrest +pkgver=5.1.0 +pkgrel=3 +pkgdesc="REST API for any Postgres database" +url="https://github.com/begriffs/postgrest" +license=("MIT") +arch=('x86_64') +depends=('ghc-libs' 'haskell-auto-update' 'haskell-hasql' 'haskell-hasql-pool' 'haskell-protolude' + 'haskell-warp' 'haskell-base64-bytestring' 'haskell-retry' 'haskell-aeson' + 'haskell-ansi-wl-pprint' 'haskell-case-insensitive' 'haskell-cassava' + 'haskell-configurator-ng' 'haskell-contravariant' 'haskell-contravariant-extras' + 'haskell-either' 'haskell-gitrev' 'haskell-hasql-transaction' 'haskell-heredoc' + 'haskell-http' 'haskell-http-types' 'haskell-insert-ordered-containers' + 'haskell-interpolatedstring-perl6' 'haskell-jose' 'haskell-lens' 'haskell-lens-aeson' + 'haskell-network-uri' 'haskell-optparse-applicative' 'haskell-ranged-sets' + 'haskell-regex-tdfa' 'haskell-scientific' 'haskell-swagger2' 'haskell-unordered-containers' + 'haskell-vector' 'haskell-wai' 'haskell-wai-cors' 'haskell-wai-extra' + 'haskell-wai-middleware-static' 'haskell-cookie') +makedepends=('ghc' 'haskell-aeson-qq' 'haskell-async' 'haskell-hspec' 'haskell-hspec-wai' + 'haskell-hspec-wai-json' 'haskell-hjsonschema') +checkdepends=('pifpaf' 'postgresql' 'procps-ng') +source=("$pkgname-$pkgver.tar.bz2::https://github.com/begriffs/postgrest/archive/v$pkgver.tar.gz" + new-hasql.patch) +sha512sums=('d4e7ef6dab26e93fe7edb9714cdf245e85ed58556f03d2d14b8e40e0456bf62247d3fe97cdd59db59f76b2a31e7086a2e6f0fc6a4780251bd091f16e8ee28fc2' + '53bbac6d2ef850ca66809f971b67d5ffd9b8d210d7561978a088c287e434beef1ba09bae65dc14048caf9b8c8d8eb9c329e618092c62c09dae836a9857ede470') + +prepare() { + cd $pkgname-$pkgver + patch -p1 -i ../new-hasql.patch + + sed -i -e 's/==/>=/' -e 's/< *4.10/<5/' $pkgname.cabal +} + +build() { + cd "${srcdir}/${pkgname}-${pkgver}" + + runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \ + --prefix=/usr --docdir="/usr/share/doc/${pkgname}" --enable-tests \ + --dynlibdir=/usr/lib --libsubdir=\$compiler/site-local/\$pkgid \ + -f-CI + runhaskell Setup build + runhaskell Setup register --gen-script + runhaskell Setup unregister --gen-script + sed -i -r -e "s|ghc-pkg.*update[^ ]* |&'--force' |" register.sh + sed -i -r -e "s|ghc-pkg.*unregister[^ ]* |&'--force' |" unregister.sh +} + +check() { + cd $pkgname-$pkgver + + eval $(pifpaf run postgresql --host 127.0.0.1 --port 5432) + createdb postgrest_test + + # TODO: it shouldn't take this long to finish + # POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://$USER@localhost" postgrest_test) runhaskell Setup test + + # Disabled: uses stack + # test/io-tests.sh + + pifpaf_stop +} + +package() { + cd "${srcdir}/${pkgname}-${pkgver}" + + install -D -m744 register.sh "${pkgdir}/usr/share/haskell/register/${pkgname}.sh" + install -D -m744 unregister.sh "${pkgdir}/usr/share/haskell/unregister/${pkgname}.sh" + runhaskell Setup copy --destdir="${pkgdir}" + install -D -m644 "LICENSE" "${pkgdir}/usr/share/licenses/${pkgname}/LICENSE" + rm -f "${pkgdir}/usr/share/doc/${pkgname}/LICENSE" +} Copied: postgrest/repos/community-staging-x86_64/new-hasql.patch (from rev 427649, postgrest/trunk/new-hasql.patch) =================================================================== --- community-staging-x86_64/new-hasql.patch (rev 0) +++ community-staging-x86_64/new-hasql.patch 2019-01-24 23:18:43 UTC (rev 427650) @@ -0,0 +1,477 @@ +From e0cc4d157106fb8978b00456181347cdb96ae1c7 Mon Sep 17 00:00:00 2001 +From: Ben Gamari <b...@smart-cactus.org> +Date: Thu, 28 Jun 2018 01:02:09 -0400 +Subject: [PATCH] Update hasql + +Move to hasql 1.3. +--- + postgrest.cabal | 6 +- + src/PostgREST/App.hs | 16 ++--- + src/PostgREST/DbStructure.hs | 126 +++++++++++++++++----------------- + src/PostgREST/Error.hs | 11 +-- + src/PostgREST/QueryBuilder.hs | 30 ++++---- + 5 files changed, 96 insertions(+), 93 deletions(-) + +diff --git a/postgrest.cabal b/postgrest.cabal +index 25231474..acfe7af9 100644 +--- a/postgrest.cabal ++++ b/postgrest.cabal +@@ -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 +diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs +index 022d95ac..ff12b6dd 100644 +--- a/src/PostgREST/App.hs ++++ b/src/PostgREST/App.hs +@@ -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 +diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs +index 99e792ec..82a48210 100644 +--- a/src/PostgREST/DbStructure.hs ++++ b/src/PostgREST/DbStructure.hs +@@ -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 +diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs +index 0972b281..f54a8e63 100644 +--- a/src/PostgREST/Error.hs ++++ b/src/PostgREST/Error.hs +@@ -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 +diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs +index e29ce630..95bc2516 100644 +--- a/src/PostgREST/QueryBuilder.hs ++++ b/src/PostgREST/QueryBuilder.hs +@@ -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