chore: Update the hasql ecosystem deps to the upcoming releases

.gitignore

@@ -13,7 +13,6 @@ site
 *#*
 .#*
 *.swp
-result*
 dist-*
 postgrest.hp
 postgrest.prof

cabal.project

@@ -1,2 +1,29 @@
+with-compiler: ghc-9.4.8
+
 packages: postgrest.cabal
 tests: true
+
+source-repository-package
+  type: git
+  location: https://github.com/nikita-volkov/hasql
+  tag: 3b9cb47a20b7c3fa8b86a89e202fc10686211416
+
+source-repository-package
+  type: git
+  location: https://github.com/nikita-volkov/hasql-dynamic-statements
+  tag: fe059d76f381e4bc486dffce928cde767cc54f6a
+
+source-repository-package
+  type: git
+  location: https://github.com/nikita-volkov/hasql-transaction
+  tag: b355efa7c666f73c1e07a2dcdeba8073da14c0ab
+
+source-repository-package
+  type: git
+  location: https://github.com/nikita-volkov/hasql-pool
+  tag: ae8957ba43af7804a707fffa29bbf807dd217f41
+
+source-repository-package
+  type: git
+  location: https://github.com/nikita-volkov/hasql-notifications
+  tag: fdb39124518c57219d00be08e34f1f830a93adc3

postgrest.cabal

@@ -66,6 +66,14 @@ library
                       PostgREST.SchemaCache.Representations
                       PostgREST.SchemaCache.Table
                       PostgREST.Error
+                      PostgREST.Error.Algebra
+                      PostgREST.Error.ApiRequestError
+                      PostgREST.Error.Error
+                      PostgREST.Error.PgError
+                      PostgREST.Error.PgError.ServerError
+                      PostgREST.Error.PgError.ServerError.RaisePgrst
+                      PostgREST.Error.PgError.UsageError
+                      PostgREST.Error.SchemaCacheError
                       PostgREST.Listener
                       PostgREST.Logger
                       PostgREST.MainTx
@@ -98,7 +106,7 @@ library
   build-depends:      base                      >= 4.9 && < 4.20
                     , HTTP                      >= 4000.3.7 && < 4000.5
                     , Ranged-sets               >= 0.3 && < 0.5
-                    , aeson                     >= 2.0.3 && < 2.3
+                    , aeson                     >= 2.2.1 && < 2.3
                     , auto-update               >= 0.1.4 && < 0.3
                     , base64-bytestring         >= 1 && < 1.3
                     , bytestring                >= 0.10.8 && < 0.13
@@ -113,11 +121,11 @@ library
                     , either                    >= 4.4.1 && < 5.1
                     , extra                     >= 1.7.0 && < 2.0
                     , fuzzyset                  >= 0.2.4 && < 0.3
-                    , hasql                     >= 1.6.1.1 && < 1.7
+                    , hasql                     >= 1.9 && < 1.11
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
-                    , hasql-notifications       >= 0.2.2.2 && < 0.2.3
-                    , hasql-pool                >= 1.0.1 && < 1.1
-                    , hasql-transaction         >= 1.0.1 && < 1.2
+                    , hasql-notifications       >= 0.2.2.2 && < 0.3
+                    , hasql-pool                >= 1.4 && < 1.5
+                    , hasql-transaction         >= 1.2 && < 1.3
                     , heredoc                   >= 0.2 && < 0.3
                     , http-client               >= 0.7.19 && < 0.8
                     , http-types                >= 0.12.2 && < 0.13
@@ -262,15 +270,16 @@ test-suite spec
                       Feature.RpcPreRequestGucsSpec
                       SpecHelper
   build-depends:      base              >= 4.9 && < 4.20
-                    , aeson             >= 2.0.3 && < 2.3
+                    , aeson             >= 2.2.1 && < 2.3
                     , aeson-qq          >= 0.8.1 && < 0.9
                     , async             >= 2.1.1 && < 2.3
                     , base64-bytestring >= 1 && < 1.3
                     , bytestring        >= 0.10.8 && < 0.13
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
-                    , hasql-pool        >= 1.0.1 && < 1.1
-                    , hasql-transaction >= 1.0.1 && < 1.2
+                    , hasql             >= 1.9 && < 1.11
+                    , hasql-pool        >= 1.4 && < 1.5
+                    , hasql-transaction >= 1.2 && < 1.3
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.12
                     , hspec-expectations >= 0.8.4 && < 0.9

src/PostgREST/AppState.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-imports -Wno-name-shadowing -Wno-incomplete-patterns -Wno-unused-matches -Wno-missing-methods -Wno-unused-record-wildcards -Wno-redundant-constraints -Wno-deprecations #-}
 {-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -32,19 +33,21 @@ module PostgREST.AppState
 
 import qualified Data.ByteString.Char8      as BS
 import           Data.Either.Combinators    (whenLeft)
-import qualified Data.Text                  as T (unpack)
+import qualified Data.Text                  as T
 import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Pool.Config          as SQL
+import qualified Hasql.Connection.Settings  as SQL
 import qualified Hasql.Session              as SQL
+import qualified Hasql.Errors               as SQL
 import qualified Hasql.Transaction.Sessions as SQL
 import qualified Network.HTTP.Types.Status  as HTTP
 import qualified Network.Socket             as NS
 import qualified PostgREST.Auth.JwtCache    as JwtCache
 import qualified PostgREST.Error            as Error
 import qualified PostgREST.Logger           as Logger
 import qualified PostgREST.Metrics          as Metrics
+import qualified PostgREST.Version          as Version
 import           PostgREST.Observation
-import           PostgREST.Version          (prettyVersion)
 import           System.TimeIt              (timeItT)
 
 import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
@@ -59,7 +62,6 @@ import Data.Time.Clock    (UTCTime, getCurrentTime)
 
 import PostgREST.Auth.JwtCache           (JwtCacheState, update)
 import PostgREST.Config                  (AppConfig (..),
-                                          addFallbackAppName,
                                           readAppConfig)
 import PostgREST.Config.Database         (queryDbSettings,
                                           queryPgVersion,
@@ -125,7 +127,7 @@ init conf@AppConfig{configLogLevel, configDbPoolSize} = do
   metricsState <- Metrics.init configDbPoolSize
   let observer = liftA2 (>>) (Logger.observationLogger loggerState configLogLevel) (Metrics.observationMetrics metricsState)
 
-  observer $ AppStartObs prettyVersion
+  observer $ AppStartObs Version.prettyVersion
 
   pool <- initPool conf observer
   (sock, adminSock) <- initSockets conf
@@ -207,7 +209,13 @@ initPool AppConfig{..} observer = do
     , SQL.acquisitionTimeout $ fromIntegral configDbPoolAcquisitionTimeout
     , SQL.agingTimeout $ fromIntegral configDbPoolMaxLifetime
     , SQL.idlenessTimeout $ fromIntegral configDbPoolMaxIdletime
-    , SQL.staticConnectionSettings (toUtf8 $ addFallbackAppName prettyVersion configDbUri)
+    , SQL.staticConnectionSettings $ mconcat $
+        [ SQL.connectionString configDbUri
+        , SQL.noPreparedStatements (not configDbPreparedStatements)
+        , SQL.other
+            "fallback_application_name"
+            ("PostgREST " <> Version.prettyVersionText)
+        ]
     , SQL.observationHandler $ observer . HasqlPoolObs
     ]
 
@@ -223,47 +231,50 @@ usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} ses
   whenLeft res (\case
     SQL.AcquisitionTimeoutUsageError ->
       observer $ PoolAcqTimeoutObs SQL.AcquisitionTimeoutUsageError
-    err@(SQL.ConnectionUsageError e) ->
-      let failureMessage = BS.unpack $ fromMaybe mempty e in
-      when (("FATAL:  password authentication failed" `isInfixOf` failureMessage) || ("no password supplied" `isInfixOf` failureMessage)) $ do
-        observer $ ExitDBFatalError ServerAuthError err
+    err@(SQL.ConnectionUsageError (SQL.AuthenticationConnectionError msg)) -> do
+      observer $ ExitDBFatalError ServerAuthError err
+      killThread mainThreadId
+    err@(SQL.ConnectionUsageError _) -> pure ()
+    err@(SQL.SessionUsageError (SQL.StatementSessionError _ _ tpl _ _ statementErr)) -> case statementErr of
+      SQL.UnexpectedResultStatementError{} -> do
+        observer $ ExitDBFatalError ServerPgrstBug err
         killThread mainThreadId
-    err@(SQL.SessionUsageError (SQL.QueryError tpl _ (SQL.ResultError resultErr))) -> do
-      case resultErr of
-        SQL.UnexpectedResult{} -> do
-          observer $ ExitDBFatalError ServerPgrstBug err
-          killThread mainThreadId
-        SQL.RowError{} -> do
-          observer $ ExitDBFatalError ServerPgrstBug err
-          killThread mainThreadId
-        SQL.UnexpectedAmountOfRows{} -> do
+      SQL.RowStatementError{} -> do
+        observer $ ExitDBFatalError ServerPgrstBug err
+        killThread mainThreadId
+      SQL.UnexpectedRowCountStatementError{} -> do
+        observer $ ExitDBFatalError ServerPgrstBug err
+        killThread mainThreadId
+      SQL.UnexpectedColumnTypeStatementError{} -> do
+        observer $ ExitDBFatalError ServerPgrstBug err
+        killThread mainThreadId
+      -- Check for a syntax error (42601 is the pg code) only for queries that don't have `WITH pgrst_source` as prefix.
+      -- This would mean the error is on our schema cache queries, so we treat it as fatal.
+      -- TODO have a better way to mark this as a schema cache query
+      SQL.ServerStatementError (SQL.ServerError "42601" _ _ _ _) ->
+        unless ("WITH pgrst_source" `T.isPrefixOf` tpl) $ do
           observer $ ExitDBFatalError ServerPgrstBug err
           killThread mainThreadId
-        -- Check for a syntax error (42601 is the pg code) only for queries that don't have `WITH pgrst_source` as prefix.
-        -- This would mean the error is on our schema cache queries, so we treat it as fatal.
-        -- TODO have a better way to mark this as a schema cache query
-        SQL.ServerError "42601" _ _ _ _ ->
-          unless ("WITH pgrst_source" `BS.isPrefixOf` tpl) $ do
-            observer $ ExitDBFatalError ServerPgrstBug err
-            killThread mainThreadId
-        -- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
-        -- This would mean that a connection pooler in transaction mode is being used
-        -- while prepared statements are enabled in the PostgREST configuration,
-        -- both of which are incompatible with each other.
-        SQL.ServerError "42P05" _ _ _ _ -> do
-          observer $ ExitDBFatalError ServerError42P05 err
-          killThread mainThreadId
-        -- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
-        -- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
-        SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _ -> do
-          observer $ ExitDBFatalError ServerError08P01 err
-          killThread mainThreadId
-        SQL.ServerError{} ->
-          when (Error.status (Error.PgError False err) >= HTTP.status500) $
-            observer $ QueryErrorCodeHighObs err
-    err@(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) ->
-      -- An error on the client-side, usually indicates problems wth connection
-        observer $ QueryErrorCodeHighObs err
+      -- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
+      -- This would mean that a connection pooler in transaction mode is being used
+      -- while prepared statements are enabled in the PostgREST configuration,
+      -- both of which are incompatible with each other.
+      SQL.ServerStatementError (SQL.ServerError "42P05" _ _ _ _) -> do
+        observer $ ExitDBFatalError ServerError42P05 err
+        killThread mainThreadId
+      -- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
+      -- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
+      SQL.ServerStatementError (SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _) -> do
+        observer $ ExitDBFatalError ServerError08P01 err
+        killThread mainThreadId
+      SQL.ServerStatementError _ ->
+        when (Error.status (Error.PgError False err) >= HTTP.status500) $
+          observer $ QueryErrorCodeHighObs err
+    err@(SQL.SessionUsageError (SQL.ConnectionSessionError _)) ->
+      observer $ QueryErrorCodeHighObs err
+    err@(SQL.SessionUsageError (SQL.DriverSessionError _)) ->
+      -- An error on the client-side, possibly indicates problems wth connection
+      observer $ QueryErrorCodeHighObs err
     )
 
   return res
@@ -328,7 +339,7 @@ isConnEstablished appState = do
   if configDbChannelEnabled then -- if the listener is enabled, we can be sure the connection is up
     readIORef $ stateIsListenerOn appState
   else -- otherwise the only way to check the connection is to make a query
-    isRight <$> usePool appState (SQL.sql "SELECT 1")
+    isRight <$> usePool appState (SQL.script "SELECT 1")
 
 putIsListenerOn :: AppState -> Bool -> IO ()
 putIsListenerOn = atomicWriteIORef . stateIsListenerOn
@@ -374,7 +385,7 @@ retryingSchemaCacheLoad appState@AppState{stateObserver=observer, stateMainThrea
     qPgVersion :: IO (Maybe PgVersion)
     qPgVersion = do
       AppConfig{..} <- getConfig appState
-      pgVersion <- usePool appState (queryPgVersion False) -- No need to prepare the query here, as the connection might not be established
+      pgVersion <- usePool appState queryPgVersion
       case pgVersion of
         Left e -> do
           observer $ QueryPgVersionError e
@@ -400,8 +411,7 @@ retryingSchemaCacheLoad appState@AppState{stateObserver=observer, stateMainThrea
     qSchemaCache = do
       conf@AppConfig{..} <- getConfig appState
       (resultTime, result) <-
-        let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
-        timeItT $ usePool appState (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
+        timeItT $ usePool appState (SQL.transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
       case result of
         Left e -> do
           putSCacheStatus appState SCPending
@@ -441,7 +451,7 @@ readInDbConfig startingUp appState@AppState{stateObserver=observer} = do
   pgVer <- getPgVersion appState
   dbSettings <-
     if configDbConfig conf then do
-      qDbSettings <- usePool appState (queryDbSettings (dumpQi <$> configDbPreConfig conf) (configDbPreparedStatements conf))
+      qDbSettings <- usePool appState (queryDbSettings (dumpQi <$> configDbPreConfig conf))
       case qDbSettings of
         Left e -> do
           observer $ ConfigReadErrorObs e
@@ -451,7 +461,7 @@ readInDbConfig startingUp appState@AppState{stateObserver=observer} = do
       pure mempty
   (roleSettings, roleIsolationLvl) <-
     if configDbConfig conf then do
-      rSettings <- usePool appState (queryRoleSettings pgVer (configDbPreparedStatements conf))
+      rSettings <- usePool appState (queryRoleSettings pgVer)
       case rSettings of
         Left e -> do
           observer $ QueryRoleSettingsErrorObs e

src/PostgREST/CLI.hs

@@ -62,9 +62,8 @@ dumpSchema :: AppState -> IO LBS.ByteString
 dumpSchema appState = do
   conf@AppConfig{..} <- AppState.getConfig appState
   result <-
-    let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
     AppState.usePool appState
-      (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
+      (SQL.transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
   case result of
     Left e -> do
       let observer = AppState.getObserver appState

src/PostgREST/Config/Database.hs

@@ -70,11 +70,11 @@ dbSettingsNames =
   ,"server_timing_enabled"
   ]
 
-queryPgVersion :: Bool -> Session PgVersion
-queryPgVersion prepared = statement mempty $ pgVersionStatement prepared
+queryPgVersion :: Session PgVersion
+queryPgVersion = statement mempty pgVersionStatement
 
-pgVersionStatement :: Bool -> SQL.Statement () PgVersion
-pgVersionStatement = SQL.Statement sql HE.noParams versionRow
+pgVersionStatement :: SQL.Statement () PgVersion
+pgVersionStatement = SQL.preparable sql HE.noParams versionRow
   where
     sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version'), version()"
     versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text <*> column HD.text
@@ -90,12 +90,11 @@ pgVersionStatement = SQL.Statement sql HE.noParams versionRow
 --
 -- The example above will result in <prefix>jwt_aud = 'val'
 -- A setting on the database only will have no effect: ALTER DATABASE postgres SET <prefix>jwt_aud = 'xx'
-queryDbSettings :: Maybe Text -> Bool -> Session [(Text, Text)]
-queryDbSettings preConfFunc prepared =
-  let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
-  transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared
+queryDbSettings :: Maybe Text -> Session [(Text, Text)]
+queryDbSettings preConfFunc  =
+  SQL.transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.preparable sql (arrayParam HE.text) decodeSettings
   where
-    sql = encodeUtf8 [trimming|
+    sql = [trimming|
       WITH
       role_setting AS (
         SELECT setdatabase as database,
@@ -131,12 +130,11 @@ queryDbSettings preConfFunc prepared =
       |]::Text
     decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
 
-queryRoleSettings :: PgVersion -> Bool -> Session (RoleSettings, RoleIsolationLvl)
-queryRoleSettings pgVer prepared =
-  let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
-  transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
+queryRoleSettings :: PgVersion -> Session (RoleSettings, RoleIsolationLvl)
+queryRoleSettings pgVer =
+  SQL.transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.preparable sql HE.noParams (processRows <$> rows)
   where
-    sql = encodeUtf8 [trimming|
+    sql = [trimming|
       with
       role_setting as (
         select r.rolname, unnest(r.rolconfig) as setting
@@ -181,7 +179,7 @@ queryRoleSettings pgVer prepared =
       )
 
     rows :: HD.Result [(Text, Maybe Text, [(Text, Text)])]
-    rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
+    rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> recordArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
 
 column :: HD.Value a -> HD.Row a
 column = HD.column . HD.nonNullable
@@ -192,8 +190,8 @@ nullableColumn = HD.column . HD.nullable
 compositeField :: HD.Value a -> HD.Composite a
 compositeField = HD.field . HD.nonNullable
 
-compositeArrayColumn :: HD.Composite a -> HD.Row [a]
-compositeArrayColumn = arrayColumn . HD.composite
+recordArrayColumn :: HD.Composite a -> HD.Row [a]
+recordArrayColumn = arrayColumn . HD.record
 
 arrayColumn :: HD.Value a -> HD.Row [a]
 arrayColumn = column . HD.listArray . HD.nonNullable