[arch-commits] Commit in postgrest/repos (3 files)

Felix Yan felixonmars at archlinux.org
Thu Jan 31 15:34:20 UTC 2019


    Date: Thursday, January 31, 2019 @ 15:34:19
  Author: felixonmars
Revision: 428759

archrelease: copy trunk to community-staging-x86_64

Added:
  postgrest/repos/community-staging-x86_64/
  postgrest/repos/community-staging-x86_64/PKGBUILD
    (from rev 428758, postgrest/trunk/PKGBUILD)
  postgrest/repos/community-staging-x86_64/new-hasql.patch
    (from rev 428758, 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 428758, postgrest/trunk/PKGBUILD)
===================================================================
--- community-staging-x86_64/PKGBUILD	                        (rev 0)
+++ community-staging-x86_64/PKGBUILD	2019-01-31 15:34:19 UTC (rev 428759)
@@ -0,0 +1,74 @@
+# Maintainer: Felix Yan <felixonmars at archlinux.org>
+# Contributor: Arch Haskell Team <arch-haskell at haskell.org>
+
+pkgname=postgrest
+pkgver=5.1.0
+pkgrel=5
+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 428758, postgrest/trunk/new-hasql.patch)
===================================================================
--- community-staging-x86_64/new-hasql.patch	                        (rev 0)
+++ community-staging-x86_64/new-hasql.patch	2019-01-31 15:34:19 UTC (rev 428759)
@@ -0,0 +1,477 @@
+From e0cc4d157106fb8978b00456181347cdb96ae1c7 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  | 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



More information about the arch-commits mailing list