Always flush the loggers without explicitly relying on onException

### Description

This PR makes use of the fact that the `LoggerSet` is created in a `ManagedT` context to guarantee that we flush it when the `ManagedT` context terminates, which is guaranteed even when an exception is thrown since `allocate` is implemented using `bracket`.

This allows us to remove several manual calls to `flip onException flushLoggers`, and avoids having to manually perform that check everywhere.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8629
GitOrigin-RevId: 47657b910dc1bb7cfc0594f02e6cce9893ae3439

server/src-lib/Hasura/App.hs

@@ -22,7 +22,6 @@ module Hasura.App
     -- * logging
     mkLoggers,
     mkPGLogger,
-    flushLogger,
 
     -- * basic connection info
     BasicConnectionInfo (..),
@@ -66,7 +65,6 @@ import Control.Monad.Catch
     MonadCatch,
     MonadMask,
     MonadThrow,
-    onException,
   )
 import Control.Monad.Morph (hoist)
 import Control.Monad.Stateless
@@ -166,7 +164,6 @@ import Network.Wai (Application)
 import Network.Wai.Handler.Warp qualified as Warp
 import Options.Applicative
 import Refined (unrefine)
-import System.Log.FastLogger qualified as FL
 import System.Metrics qualified as EKG
 import System.Metrics.Gauge qualified as EKG.Gauge
 import Text.Mustache.Compile qualified as M
@@ -230,13 +227,6 @@ mkLoggers enabledLogs logLevel = do
       pgLogger = mkPGLogger logger
   pure $ Loggers loggerCtx logger pgLogger
 
--- | If an exception is thrown, and the process exits without the log buffer
--- being flushed, we will be missing some log lines (see:
--- https://github.com/hasura/graphql-engine/issues/4772). This function forces a
--- flush of the buffer.
-flushLogger :: MonadIO m => LoggerCtx impl -> m ()
-flushLogger = liftIO . FL.flushLogStr . _lcLoggerSet
-
 --------------------------------------------------------------------------------
 -- Basic connection info
 
@@ -380,7 +370,7 @@ data AppInit = AppInit
 -- processes and logging startup information. All of those are flagged with a
 -- comment marking them as a side-effect.
 initialiseAppEnv ::
-  (C.ForkableMonadIO m, MonadCatch m) =>
+  (C.ForkableMonadIO m) =>
   Env.Environment ->
   BasicConnectionInfo ->
   ServeOptions Hasura ->
@@ -390,7 +380,7 @@ initialiseAppEnv ::
   SamplingPolicy ->
   ManagedT m (AppInit, AppEnv)
 initialiseAppEnv env BasicConnectionInfo {..} serveOptions@ServeOptions {..} liveQueryHook serverMetrics prometheusMetrics traceSamplingPolicy = do
-  loggers@(Loggers loggerCtx logger pgLogger) <- mkLoggers soEnabledLogTypes soLogLevel
+  loggers@(Loggers _loggerCtx logger pgLogger) <- mkLoggers soEnabledLogTypes soLogLevel
 
   -- SIDE EFFECT: print a warning if no admin secret is set.
   when (null soAdminSecret) $
@@ -420,13 +410,12 @@ initialiseAppEnv env BasicConnectionInfo {..} serveOptions@ServeOptions {..} liv
   -- Migrate the catalog and fetch the metdata.
   metadataWithVersion <-
     lift $
-      flip onException (flushLogger loggerCtx) $
-        migrateCatalogAndFetchMetadata
-          logger
-          metadataDbPool
-          bciDefaultPostgres
-          soEnableMaintenanceMode
-          soExtensionsSchema
+      migrateCatalogAndFetchMetadata
+        logger
+        metadataDbPool
+        bciDefaultPostgres
+        soEnableMaintenanceMode
+        soExtensionsSchema
 
   -- Create the TLSAllowListRef and the HTTP Manager.
   let metadata = _mwrvMetadata metadataWithVersion
@@ -1033,13 +1022,12 @@ mkHGEServer setupHook appStateRef consoleType ekgStore = do
 
   HasuraApp app actionSubState stopWsServer <-
     lift $
-      flip onException (flushLogger loggerCtx) $
-        mkWaiApp
-          setupHook
-          appStateRef
-          consoleType
-          ekgStore
-          wsServerEnv
+      mkWaiApp
+        setupHook
+        appStateRef
+        consoleType
+        ekgStore
+        wsServerEnv
 
   -- Log Warning if deprecated environment variables are used
   sources <- scSources <$> liftIO (getSchemaCache appStateRef)

server/src-lib/Hasura/Logging.hs

@@ -288,19 +288,28 @@ getFormattedTime tzM = do
 
 -- format = Format.iso8601DateFormat (Just "%H:%M:%S")
 
+-- | Creates a new 'LoggerCtx'.
+--
+-- The underlying 'LoggerSet' is bound to the 'ManagedT' context: when it exits,
+-- the log will be flushed and cleared regardless of whether it was exited
+-- properly or not ('ManagedT' uses 'bracket' underneath). This guarantees that
+-- the logs will always be flushed, even in case of error, avoiding a repeat of
+-- https://github.com/hasura/graphql-engine/issues/4772.
 mkLoggerCtx ::
   (MonadIO io, MonadBaseControl IO io) =>
   LoggerSettings ->
   Set.HashSet (EngineLogType impl) ->
   ManagedT io (LoggerCtx impl)
 mkLoggerCtx (LoggerSettings cacheTime tzM logLevel) enabledLogs = do
-  loggerSet <-
-    allocate
-      (liftIO $ FL.newStdoutLoggerSet FL.defaultBufSize)
-      (liftIO . FL.rmLoggerSet)
-  timeGetter <- liftIO $ bool (return $ getFormattedTime tzM) cachedTimeGetter cacheTime
-  return $ LoggerCtx loggerSet logLevel timeGetter enabledLogs
+  loggerSet <- allocate acquire release
+  timeGetter <- liftIO $ bool (pure $ getFormattedTime tzM) cachedTimeGetter cacheTime
+  pure $ LoggerCtx loggerSet logLevel timeGetter enabledLogs
   where
+    acquire = liftIO do
+      FL.newStdoutLoggerSet FL.defaultBufSize
+    release loggerSet = liftIO do
+      FL.flushLogStr loggerSet
+      FL.rmLoggerSet loggerSet
     cachedTimeGetter =
       Auto.mkAutoUpdate
         Auto.defaultUpdateSettings