[arch-commits] Commit in postgrest/repos (3 files)
Felix Yan
felixonmars at archlinux.org
Sun Aug 26 17:59:17 UTC 2018
Date: Sunday, August 26, 2018 @ 17:59:16
Author: felixonmars
Revision: 374460
archrelease: copy trunk to community-staging-x86_64
Added:
postgrest/repos/community-staging-x86_64/
postgrest/repos/community-staging-x86_64/PKGBUILD
(from rev 374459, postgrest/trunk/PKGBUILD)
postgrest/repos/community-staging-x86_64/new-hasql.patch
(from rev 374459, postgrest/trunk/new-hasql.patch)
-----------------+
PKGBUILD | 78 ++++++++
new-hasql.patch | 477 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 555 insertions(+)
Copied: postgrest/repos/community-staging-x86_64/PKGBUILD (from rev 374459, postgrest/trunk/PKGBUILD)
===================================================================
--- community-staging-x86_64/PKGBUILD (rev 0)
+++ community-staging-x86_64/PKGBUILD 2018-08-26 17:59:16 UTC (rev 374460)
@@ -0,0 +1,78 @@
+# $Id$
+# Maintainer: Felix Yan <felixonmars at archlinux.org>
+# Contributor: Arch Haskell Team <arch-haskell at haskell.org>
+
+pkgname=postgrest
+pkgver=0.5.0.0
+pkgrel=2
+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=('ba8974cc83de3a7fcf1ede454eed726d6dfe7d677e4b34bbf6a03f11cc648d6812c2f101684175bb1f4d0f0b384795a737791ce807c257eae67158e2fc74b0a0'
+ '54257b24e646175c3687d3d0b224092441e0a8093d04327fb900da6c463625bfc952aabe46bcbbee8d0b4b96d4c07b4b148efa5ac4dcd9dd60bf7d3da5a49fcd')
+
+prepare() {
+ cd $pkgname-$pkgver
+ patch -p1 -i ../new-hasql.patch
+
+ sed -i 's/==/>=/' $pkgname.cabal
+
+ sed -i '/import\s*Safe/d' src/PostgREST/App.hs
+ sed -i '/safe/d' $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 374459, postgrest/trunk/new-hasql.patch)
===================================================================
--- community-staging-x86_64/new-hasql.patch (rev 0)
+++ community-staging-x86_64/new-hasql.patch 2018-08-26 17:59:16 UTC (rev 374460)
@@ -0,0 +1,477 @@
+From f02992e562fafc807092d09a8034f2117c9db00d Mon Sep 17 00:00:00 2001
+From: Ben Gamari <ben at 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 | 131 +++++++++++++++++-----------------
+ src/PostgREST/Error.hs | 11 +--
+ src/PostgREST/QueryBuilder.hs | 30 ++++----
+ 5 files changed, 99 insertions(+), 95 deletions(-)
+
+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 dbff35b6..bc519987 100644
+--- a/src/PostgREST/DbStructure.hs
++++ b/src/PostgREST/DbStructure.hs
+@@ -15,7 +15,8 @@ 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 qualified Hasql.Session as H
+
+ import Control.Applicative
+ import qualified Data.HashMap.Strict as M
+@@ -38,12 +39,12 @@ import Contravariant.Extras (contrazip2)
+
+ getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
+ getDbStructure schema pgVer = do
+- tabs <- H.query () allTables
+- cols <- H.query schema $ allColumns tabs
+- syns <- H.query () $ 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 () $ 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
+@@ -60,70 +61,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)
+@@ -159,11 +160,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')"
+
+@@ -186,9 +187,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
+@@ -199,9 +200,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
+@@ -328,9 +329,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
+@@ -351,9 +352,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
+@@ -538,9 +539,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,
+@@ -579,9 +580,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|
+ /*
+@@ -689,9 +690,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 () [Synonym]
++allSynonyms :: [Column] -> H.Statement () [Synonym]
+ allSynonyms cols =
+- H.statement sql HE.unit (decodeSynonyms cols) True
++ H.Statement sql HE.unit (decodeSynonyms cols) True
+ where
+ -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
+ sql = [q|
+@@ -772,15 +773,15 @@ 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
+
+ fillSessionWithSettings :: [(Text, Text)] -> H.Session ()
+ fillSessionWithSettings settings =
+ -- Send all of the config settings to the set_config function, using pgsql's `unnest` to transform arrays of values
+- H.query settings $ H.statement "SELECT set_config(k, v, false) FROM unnest($1, $2) AS f1(k, v)" encoder HD.unit False
++ H.statement settings $ H.Statement "SELECT set_config(k, v, false) FROM unnest($1, $2) AS f1(k, v)" encoder HD.unit False
+
+ where
+ -- Take a list of (key, value) pairs and encode each as an array to later bind to the query
+@@ -788,5 +789,5 @@ fillSessionWithSettings settings =
+ encoder = contramap L.unzip $ contrazip2 (vector HE.text) (vector HE.text)
+ where
+ vector value =
+- HE.value $ HE.array $ HE.arrayDimension foldl' $ HE.arrayValue value
++ HE.param $ HE.array $ HE.dimension foldl' $ HE.element value
+
+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 8045573b..29c0fe57 100644
+--- a/src/PostgREST/QueryBuilder.hs
++++ b/src/PostgREST/QueryBuilder.hs
+@@ -26,7 +26,7 @@ module PostgREST.QueryBuilder (
+ , pgFmtEnvVar
+ ) 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
More information about the arch-commits
mailing list