chore(deps): update hasql to 1.9.3.1

Michael and I arrived at mostly the same things independently. Took some
of his, some of mine.

Co-authored-by: Michal Kleczek <michal@kleczek.org>

src/PostgREST/AppState.hs

@@ -55,8 +55,8 @@ import Data.Time.Clock    (UTCTime, getCurrentTime)
 
 import PostgREST.Auth.JwtCache           (JwtCacheState, update)
 import PostgREST.Config                  (AppConfig (..),
-                                          addFallbackAppName,
-                                          readAppConfig)
+                                          readAppConfig,
+                                          toConnectionSettings)
 import PostgREST.Config.Database         (queryDbSettings,
                                           queryPgVersion,
                                           queryRoleSettings)
@@ -143,34 +143,47 @@ destroy :: AppState -> IO ()
 destroy = destroyPool
 
 initPool :: AppConfig -> ObservationHandler -> IO SQL.Pool
-initPool AppConfig{..} observer = do
+initPool cfg@AppConfig{..} observer = do
   SQL.acquire $ SQL.settings
     [ SQL.size configDbPoolSize
     , SQL.acquisitionTimeout $ fromIntegral configDbPoolAcquisitionTimeout
     , SQL.agingTimeout $ fromIntegral configDbPoolMaxLifetime
     , SQL.idlenessTimeout $ fromIntegral configDbPoolMaxIdletime
-    , SQL.staticConnectionSettings (toUtf8 $ addFallbackAppName prettyVersion configDbUri)
+    , SQL.staticConnectionSettings $ toConnectionSettings identity cfg
     , SQL.observationHandler $ observer . HasqlPoolObs
     ]
 
 -- | 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
-    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
+      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
+      err@(SQL.SessionUsageError (SQL.PipelineError (SQL.ResultError resultErr))) ->
+        -- Passing the empty template will not work for schema cache queries, see TODO further below.
+        handleResultError err mempty resultErr
+      err@(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) ->
+        -- An error on the client-side, usually indicates problems with connection
+        observer $ QueryErrorCodeHighObs err
+      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
@@ -203,12 +216,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 with 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.
@@ -308,7 +315,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
@@ -336,8 +343,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
           markSchemaCachePending appState
@@ -393,7 +399,7 @@ readInDbConfig startingUp appState@AppState{stateObserver=observer} = do
   pgVer <- getPgVersion appState
   dbSettings <-
     if configDbConfig conf then do
-      qDbSettings <- usePool appState (queryDbSettings (quoteQi <$> configDbPreConfig conf) (configDbPreparedStatements conf))
+      qDbSettings <- usePool appState (queryDbSettings (quoteQi <$> configDbPreConfig conf))
       case qDbSettings of
         Left e -> do
           observer $ ConfigReadErrorObs e
@@ -403,7 +409,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