chore(deps): update hasql to 1.8.1.4

Author: wolfgangwalther

nix/overlays/haskell-packages.nix

@@ -49,15 +49,6 @@ let
       # Before upgrading fuzzyset to 0.3, check: https://github.com/PostgREST/postgrest/issues/3329
       # jailbreak, because hspec limit for tests
       fuzzyset = prev.fuzzyset_0_2_4;
-
-      # Downgrade hasql and related packages while we are still on GHC 9.4 for the static build.
-      hasql = lib.dontCheck (lib.doJailbreak prev.hasql_1_6_4_4);
-      hasql-dynamic-statements = lib.dontCheck prev.hasql-dynamic-statements_0_3_1_5;
-      hasql-implicits = lib.dontCheck prev.hasql-implicits_0_1_1_3;
-      hasql-notifications = lib.dontCheck prev.hasql-notifications_0_2_2_2;
-      hasql-pool = lib.dontCheck prev.hasql-pool_1_0_1;
-      hasql-transaction = lib.dontCheck prev.hasql-transaction_1_1_0_1;
-      postgresql-binary = lib.dontCheck (lib.doJailbreak prev.postgresql-binary_0_13_1_3);
     };
 in
 {

postgrest.cabal

@@ -107,10 +107,10 @@ 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.7 && < 1.9
                     , 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-notifications       >= 0.2.2.0 && < 0.3
+                    , hasql-pool                >= 1.1 && < 1.3
                     , hasql-transaction         >= 1.0.1 && < 1.2
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13

src/PostgREST/AppState.hs

@@ -215,21 +215,30 @@ initPool AppConfig{..} observer = do
 -- | Run an action with a database connection.
 usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
 usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} sess = do
-  observer PoolRequest
+    observer PoolRequest
 
-  res <- SQL.use statePool sess
+    res <- SQL.use statePool sess
 
-  observer PoolRequestFullfilled
+    observer PoolRequestFullfilled
 
-  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
-        killThread mainThreadId
-    err@(SQL.SessionUsageError (SQL.QueryError tpl _ (SQL.ResultError resultErr))) -> do
+    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
+          killThread mainThreadId
+      err@(SQL.SessionUsageError (SQL.QueryError tpl _ (SQL.ResultError resultErr))) -> handleResultError err tpl resultErr
+      -- Passing the empty template will not work for schema cache queries, see TODO further below.
+      err@(SQL.SessionUsageError (SQL.PipelineError (SQL.ResultError resultErr)))    -> handleResultError err mempty resultErr
+      SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _)) -> pure ()
+      SQL.SessionUsageError (SQL.PipelineError (SQL.ClientError _))  -> pure ()
+      )
+
+    return res
+  where
+    handleResultError err tpl resultErr = do
       case resultErr of
         SQL.UnexpectedResult{} -> do
           observer $ ExitDBFatalError ServerPgrstBug err
@@ -262,12 +271,6 @@ usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} ses
         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
-    )
-
-  return res
 
 -- | Flush the connection pool so that any future use of the pool will
 -- use connections freshly established after this call.

src/PostgREST/Error.hs

@@ -526,18 +526,22 @@ instance JSON.ToJSON SQL.UsageError where
 
 instance ErrorBody SQL.UsageError where
   code    (SQL.ConnectionUsageError _)                   = "PGRST000"
+  code    (SQL.SessionUsageError (SQL.PipelineError e))  = code e
   code    (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e
   code    SQL.AcquisitionTimeoutUsageError               = "PGRST003"
 
   message (SQL.ConnectionUsageError _) = "Database connection error. Retrying the connection."
+  message (SQL.SessionUsageError (SQL.PipelineError e))  = message e
   message (SQL.SessionUsageError (SQL.QueryError _ _ e)) = message e
   message SQL.AcquisitionTimeoutUsageError = "Timed out acquiring connection from connection pool."
 
   details (SQL.ConnectionUsageError e) = JSON.String . T.decodeUtf8 <$> e
+  details (SQL.SessionUsageError (SQL.PipelineError e))  = details e
   details (SQL.SessionUsageError (SQL.QueryError _ _ e)) = details e
   details SQL.AcquisitionTimeoutUsageError               = Nothing
 
   hint    (SQL.ConnectionUsageError _)                   = Nothing
+  hint    (SQL.SessionUsageError (SQL.PipelineError e))  = hint e
   hint    (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e
   hint    SQL.AcquisitionTimeoutUsageError               = Nothing
 
@@ -586,8 +590,13 @@ instance ErrorBody SQL.CommandError where
 pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
 pgErrorStatus _      (SQL.ConnectionUsageError _) = HTTP.status503
 pgErrorStatus _      SQL.AcquisitionTimeoutUsageError = HTTP.status504
+pgErrorStatus _      (SQL.SessionUsageError (SQL.PipelineError (SQL.ClientError _)))       = HTTP.status503
 pgErrorStatus _      (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _)))      = HTTP.status503
-pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) =
+pgErrorStatus authed (SQL.SessionUsageError (SQL.PipelineError (SQL.ResultError rError)))  = mapSQLtoHTTP authed rError
+pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = mapSQLtoHTTP authed rError
+
+mapSQLtoHTTP :: Bool -> SQL.ResultError -> HTTP.Status
+mapSQLtoHTTP authed rError =
   case rError of
     (SQL.ServerError c m d _ _) ->
       case BS.unpack c of

src/PostgREST/Metrics.hs

@@ -47,7 +47,7 @@ observationMetrics MetricsState{..} obs = case obs of
   (PoolAcqTimeoutObs _) -> do
     incCounter poolTimeouts
   (HasqlPoolObs (SQL.ConnectionObservation _ status)) -> case status of
-     SQL.ReadyForUseConnectionStatus  -> do
+     SQL.ReadyForUseConnectionStatus _ -> do
       incGauge poolAvailable
      SQL.InUseConnectionStatus        -> do
       decGauge poolAvailable

src/PostgREST/Observation.hs

@@ -139,13 +139,17 @@ observationMessage = \case
     "Connection " <> show uuid <> (
       case status of
         SQL.ConnectingConnectionStatus   -> " is being established"
-        SQL.ReadyForUseConnectionStatus  -> " is available"
+        SQL.ReadyForUseConnectionStatus reason -> " is available due to " <> case reason of
+          SQL.EstablishedConnectionReadyForUseReason      -> "connection establishment"
+          SQL.SessionFailedConnectionReadyForUseReason _  -> "session failure"
+          SQL.SessionSucceededConnectionReadyForUseReason -> "session success"
         SQL.InUseConnectionStatus        -> " is used"
         SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of
           SQL.AgingConnectionTerminationReason          -> "max lifetime"
           SQL.IdlenessConnectionTerminationReason       -> "max idletime"
           SQL.ReleaseConnectionTerminationReason        -> "release"
           SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message.
+          SQL.InitializationErrorTerminationReason _    -> "init failure"
     )
   PoolRequest ->
     "Trying to borrow a connection from pool"