multitenant: switch schema sync listener to polling mechanism

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8146
GitOrigin-RevId: 7fe82899ca8ef9eba526fe4b298b0ffbce32be82

server/src-lib/Hasura/Eventing/Common.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Hasura.Eventing.Common
@@ -8,25 +7,16 @@ module Hasura.Eventing.Common
     generateScheduleTimes,
     cleanupSchedulesToBeGenerated,
     deleteEventTriggerLogsInBatchesWith,
-
-    -- * Debounce logger
-    createStatsLogger,
-    closeStatsLogger,
-    logStats,
   )
 where
 
 import Control.Arrow.Extended
 import Control.Concurrent.STM.TVar
-import Control.Exception (catch)
-import Control.FoldDebounce qualified as FDebounce
 import Control.Monad.STM
-import Data.Aeson qualified as J
 import Data.List (unfoldr)
 import Data.Set qualified as Set
 import Data.Time
 import Hasura.Base.Error (QErr)
-import Hasura.Logging qualified as L
 import Hasura.Prelude
 import Hasura.RQL.Types.Action (LockedActionEventId)
 import Hasura.RQL.Types.Common
@@ -100,51 +90,3 @@ deleteEventTriggerLogsInBatchesWith getLatestCleanupConfig oldCleanupConfig dbLo
             deleteEventTriggerLogsInBatchesWith getLatestCleanupConfig cleanupConfig dbLogDeleteAction
           -- Finally collect all the statistics
           pure (DeletedEventLogStats (delEventLogsInBatch + deletedRemainingEventLogs) (delInvocationLogsInBatch + deletedRemainingInvocationLogs))
-
--- | A logger useful for accumulating stats, evaluated in forever running loops, over a
--- period of time and log them only once. Use @'logStats' to record statistics for logging.
-createStatsLogger ::
-  forall m stats.
-  ( MonadIO m,
-    L.ToEngineLog stats L.Hasura,
-    Monoid stats
-  ) =>
-  L.Logger L.Hasura ->
-  m (FDebounce.Trigger stats stats)
-createStatsLogger hasuraLogger =
-  liftIO $ FDebounce.new debounceArgs debounceOpts
-  where
-    logDelay :: Int
-    logDelay =
-      -- Accumulate stats occurred within 10 minutes and log once.
-      10 * 60 * 1000_000 -- 10 minutes
-    debounceArgs :: FDebounce.Args stats stats
-    debounceArgs =
-      FDebounce.Args
-        { FDebounce.cb = L.unLogger hasuraLogger, -- Log using the Hasura logger
-          FDebounce.fold = (<>),
-          FDebounce.init = mempty
-        }
-
-    debounceOpts :: FDebounce.Opts stats stats
-    debounceOpts = FDebounce.def {FDebounce.delay = logDelay}
-
--- Orphan instance. Required for @'closeStatsLogger'.
-instance L.ToEngineLog (FDebounce.OpException, L.EngineLogType L.Hasura) L.Hasura where
-  toEngineLog (opException, logType) =
-    let errorMessage :: Text
-        errorMessage = case opException of
-          FDebounce.AlreadyClosedException -> "already closed"
-          FDebounce.UnexpectedClosedException _someException -> "closed unexpectedly"
-     in (L.LevelWarn, logType, J.object ["message" J..= ("cannot close fetched events stats logger: " <> errorMessage)])
-
--- | Safely close the statistics logger. When occurred, exception is logged.
-closeStatsLogger :: (MonadIO m) => L.EngineLogType L.Hasura -> L.Logger L.Hasura -> FDebounce.Trigger stats stats -> m ()
-closeStatsLogger logType (L.Logger hasuraLogger) debounceLogger =
-  liftIO $ catch (FDebounce.close debounceLogger) $ \(e :: FDebounce.OpException) -> hasuraLogger (e, logType)
-
--- | This won't log the given stats immediately.
--- The stats are accumulated over the specific timeframe and logged only once.
--- See @'createStatsLogger' for more details.
-logStats :: (MonadIO m) => FDebounce.Trigger stats stats -> stats -> m ()
-logStats debounceTrigger = liftIO . FDebounce.send debounceTrigger

server/src-lib/Hasura/Eventing/EventTrigger.hs

@@ -247,11 +247,11 @@ type FetchedEventsStatsLogger = FDebounce.Trigger FetchedEventsStats FetchedEven
 -- | Logger to accumulate stats of fetched events over a period of time and log once using @'L.Logger L.Hasura'.
 -- See @'createStatsLogger' for more details.
 createFetchedEventsStatsLogger :: (MonadIO m) => L.Logger L.Hasura -> m FetchedEventsStatsLogger
-createFetchedEventsStatsLogger = createStatsLogger
+createFetchedEventsStatsLogger = L.createStatsLogger
 
 -- | Close the fetched events stats logger.
 closeFetchedEventsStatsLogger :: (MonadIO m) => L.Logger L.Hasura -> FetchedEventsStatsLogger -> m ()
-closeFetchedEventsStatsLogger = closeStatsLogger L.eventTriggerProcessLogType
+closeFetchedEventsStatsLogger = L.closeStatsLogger L.eventTriggerProcessLogType
 
 -- | Log statistics of fetched events. See @'logStats' for more details.
 logFetchedEventsStatistics ::
@@ -260,7 +260,7 @@ logFetchedEventsStatistics ::
   [BackendEventWithSource] ->
   m ()
 logFetchedEventsStatistics logger backendEvents =
-  logStats logger (FetchedEventsStats numEventsFetchedPerSource 1)
+  L.logStats logger (FetchedEventsStats numEventsFetchedPerSource 1)
   where
     numEventsFetchedPerSource =
       let sourceNames = flip map backendEvents $

server/src-lib/Hasura/Eventing/ScheduledTrigger.hs

@@ -1098,12 +1098,12 @@ getScheduledEventsInvocationsQuery eventTables (GetScheduledEventInvocations inv
 -- | Logger to accumulate stats of fetched scheduled events over a period of time and log once using @'L.Logger L.Hasura'.
 -- See @'createStatsLogger' for more details.
 createFetchedScheduledEventsStatsLogger :: (MonadIO m) => L.Logger L.Hasura -> m FetchedScheduledEventsStatsLogger
-createFetchedScheduledEventsStatsLogger = createStatsLogger
+createFetchedScheduledEventsStatsLogger = L.createStatsLogger
 
 -- | Close the fetched scheduled events stats logger.
 closeFetchedScheduledEventsStatsLogger ::
   (MonadIO m) => L.Logger L.Hasura -> FetchedScheduledEventsStatsLogger -> m ()
-closeFetchedScheduledEventsStatsLogger = closeStatsLogger L.scheduledTriggerProcessLogType
+closeFetchedScheduledEventsStatsLogger = L.closeStatsLogger L.scheduledTriggerProcessLogType
 
 -- | Log statistics of fetched scheduled events. See @'logStats' for more details.
 logFetchedScheduledEventsStats ::
@@ -1113,18 +1113,18 @@ logFetchedScheduledEventsStats ::
   OneOffScheduledEventsCount ->
   m ()
 logFetchedScheduledEventsStats logger cron oneOff =
-  logStats logger (FetchedScheduledEventsStats cron oneOff 1)
+  L.logStats logger (FetchedScheduledEventsStats cron oneOff 1)
 
 -- | Logger to accumulate stats of fetched cron triggers, for generating cron events, over a period of time and
 -- log once using @'L.Logger L.Hasura'.
 -- See @'createStatsLogger' for more details.
 createFetchedCronTriggerStatsLogger :: (MonadIO m) => L.Logger L.Hasura -> m FetchedCronTriggerStatsLogger
-createFetchedCronTriggerStatsLogger = createStatsLogger
+createFetchedCronTriggerStatsLogger = L.createStatsLogger
 
 -- | Close the fetched cron trigger stats logger.
 closeFetchedCronTriggersStatsLogger ::
   (MonadIO m) => L.Logger L.Hasura -> FetchedCronTriggerStatsLogger -> m ()
-closeFetchedCronTriggersStatsLogger = closeStatsLogger L.cronEventGeneratorProcessType
+closeFetchedCronTriggersStatsLogger = L.closeStatsLogger L.cronEventGeneratorProcessType
 
 -- | Log statistics of fetched cron triggers. See @'logStats' for more details.
 logFetchedCronTriggersStats ::
@@ -1133,4 +1133,4 @@ logFetchedCronTriggersStats ::
   [CronTriggerStats] ->
   m ()
 logFetchedCronTriggersStats logger cronTriggerStats =
-  logStats logger (FetchedCronTriggerStats cronTriggerStats 1)
+  L.logStats logger (FetchedCronTriggerStats cronTriggerStats 1)

server/src-lib/Hasura/Logging.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -32,10 +33,17 @@ module Hasura.Logging
     isEngineLogTypeEnabled,
     readLogTypes,
     getFormattedTime,
+
+    -- * Debounce logger
+    createStatsLogger,
+    closeStatsLogger,
+    logStats,
   )
 where
 
 import Control.AutoUpdate qualified as Auto
+import Control.Exception (catch)
+import Control.FoldDebounce qualified as FDebounce
 import Control.Monad.Trans.Control
 import Control.Monad.Trans.Managed (ManagedT (..), allocate)
 import Data.Aeson qualified as J
@@ -332,3 +340,51 @@ cronEventGeneratorProcessType = ELTInternal ILTCronEventGeneratorProcess
 
 sourceCatalogMigrationLogType :: EngineLogType Hasura
 sourceCatalogMigrationLogType = ELTInternal ILTSourceCatalogMigration
+
+-- | A logger useful for accumulating stats, evaluated in forever running loops, over a
+-- period of time and log them only once. Use @'logStats' to record statistics for logging.
+createStatsLogger ::
+  forall m stats impl.
+  ( MonadIO m,
+    ToEngineLog stats impl,
+    Monoid stats
+  ) =>
+  Logger impl ->
+  m (FDebounce.Trigger stats stats)
+createStatsLogger hasuraLogger =
+  liftIO $ FDebounce.new debounceArgs debounceOpts
+  where
+    logDelay :: Int
+    logDelay =
+      -- Accumulate stats occurred within 10 minutes and log once.
+      10 * 60 * 1000_000 -- 10 minutes
+    debounceArgs :: FDebounce.Args stats stats
+    debounceArgs =
+      FDebounce.Args
+        { FDebounce.cb = unLogger hasuraLogger, -- Log using the Hasura logger
+          FDebounce.fold = (<>),
+          FDebounce.init = mempty
+        }
+
+    debounceOpts :: FDebounce.Opts stats stats
+    debounceOpts = FDebounce.def {FDebounce.delay = logDelay}
+
+-- Orphan instance. Required for @'closeStatsLogger'.
+instance (EnabledLogTypes impl) => ToEngineLog (FDebounce.OpException, EngineLogType impl) impl where
+  toEngineLog (opException, logType) =
+    let errorMessage :: Text
+        errorMessage = case opException of
+          FDebounce.AlreadyClosedException -> "already closed"
+          FDebounce.UnexpectedClosedException _someException -> "closed unexpectedly"
+     in (LevelWarn, logType, J.object ["message" J..= ("cannot close fetched events stats logger: " <> errorMessage)])
+
+-- | Safely close the statistics logger. When occurred, exception is logged.
+closeStatsLogger :: (MonadIO m, EnabledLogTypes impl) => EngineLogType impl -> Logger impl -> FDebounce.Trigger stats stats -> m ()
+closeStatsLogger logType (Logger hasuraLogger) debounceLogger =
+  liftIO $ catch (FDebounce.close debounceLogger) $ \(e :: FDebounce.OpException) -> hasuraLogger (e, logType)
+
+-- | This won't log the given stats immediately.
+-- The stats are accumulated over the specific timeframe and logged only once.
+-- See @'createStatsLogger' for more details.
+logStats :: (MonadIO m) => FDebounce.Trigger stats stats -> stats -> m ()
+logStats debounceTrigger = liftIO . FDebounce.send debounceTrigger