small cleanups of pro's init

### Description (This PR is better reviewed commit by commit.) This PR is an aggregation of small incremental changes to Pro's init: - it deletes some dead code, - it starts reorganizing the code of that file by sections, similar to OSS' init, - it extracts and cleans up license key cache init (groups several blocks of code in one separate function) - makes some changes to a service class to reduce the dependency on `_acAppStateRef` This PR is a first step: our goal is to move the schema cache build _in_ the app monad, in order to achieve #8344. To do so, we will need to remove `_acAppStateRef` from Pro's `AppContext`. There are two different paths we can take from here, which is why i cut this PR here: - the first would be to change the different instances we implement on `AppM` to take as an argument the parts of the schema cache they depend on, rather than reading them from `_acAppStateRef`; as of this PR, `MetricsConfig` is the only such field; - the second would be to apply the same strategy we already used for the TLSAllowList, and use a `IORef` that can be updated after the schema cache is built; this change would have a smaller footprint, but introduces one new `IORef` per such field, which feels something we don't want to generalize PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8655 GitOrigin-RevId: 809697d460bdb5c83ef7d30a2e835f589bcd80a6
2024-09-17 13:37:26 +03:00 · 2023-04-06 17:35:43 +02:00 · 2023-04-06 17:35:43 +02:00 · 0476331136
commit 0476331136
parent ed9f120241
5 changed files with 48 additions and 49 deletions
--- a/server/src-lib/Hasura/App.hs
+++ b/server/src-lib/Hasura/App.hs
@ -767,7 +767,7 @@ instance MonadQueryTags AppM where
  createQueryTags _attributes _qtSourceConfig = return $ emptyQueryTagsComment

 instance MonadEventLogCleanup AppM where
-  runLogCleaner _ = pure $ throw400 NotSupported "Event log cleanup feature is enterprise edition only"
+  runLogCleaner _ _ = pure $ throw400 NotSupported "Event log cleanup feature is enterprise edition only"
  generateCleanupSchedules _ _ _ = pure $ Right ()
  updateTriggerCleanupSchedules _ _ _ _ = pure $ Right ()

--- a/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs
+++ b/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs
@ -20,7 +20,6 @@ module Hasura.RQL.DDL.EventTrigger
    getTriggerNames,
    getTriggersMap,
    getTableNameFromTrigger,
-    getTabInfoFromSchemaCache,
    cetqSource,
    cetqName,
    cetqTable,
@ -182,11 +181,15 @@ instance Backend b => FromJSON (InvokeEventTriggerQuery b) where
      <*> o .:? "source" .!= defaultSource
      <*> o .: "payload"

-- | This typeclass have the implementation logic for the event trigger log cleanup
+-- | This typeclass have the implementation logic for the event trigger log cleanup.
+--
+-- TODO: this doesn't belong here in the DDL folder, but should be part of
+-- Hasura.Eventing. It could even be made a Service, since the whole point of it
+-- is to implement features differently between OSS and Pro.
 class Monad m => MonadEventLogCleanup m where
  -- Deletes the logs of event triggers
  runLogCleaner ::
-    TriggerLogCleanupConfig -> m (Either QErr EncJSON)
+    SourceCache -> TriggerLogCleanupConfig -> m (Either QErr EncJSON)

  -- Generates the cleanup schedules for event triggers which have log cleaners installed
  generateCleanupSchedules ::
@ -220,27 +223,27 @@ class Monad m => MonadEventLogCleanup m where
    m (Either QErr ())

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (ReaderT r m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (ExceptT e m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (MetadataT m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (TraceT m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (StateT w m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

@ -419,20 +422,20 @@ askTabInfoFromTrigger ::
  m (TableInfo b)
 askTabInfoFromTrigger sourceName triggerName = do
  schemaCache <- askSchemaCache
-  tableInfoMaybe <- getTabInfoFromSchemaCache schemaCache sourceName triggerName
-  tableInfoMaybe `onNothing` throw400 NotExists errMsg
+  getTabInfoFromSchemaCache schemaCache sourceName triggerName
+    `onNothing` throw400 NotExists errMsg
  where
    errMsg = "event trigger " <> triggerName <<> " does not exist"

 getTabInfoFromSchemaCache ::
-  (Backend b, QErrM m) =>
+  Backend b =>
  SchemaCache ->
  SourceName ->
  TriggerName ->
-  m (Maybe (TableInfo b))
+  Maybe (TableInfo b)
 getTabInfoFromSchemaCache schemaCache sourceName triggerName = do
-  let tabInfos = HM.elems $ fromMaybe mempty $ unsafeTableCache sourceName $ scSources schemaCache
-  pure $ find (isJust . HM.lookup triggerName . _tiEventTriggerInfoMap) tabInfos
+  tableCache <- unsafeTableCache sourceName $ scSources schemaCache
+  find (isJust . HM.lookup triggerName . _tiEventTriggerInfoMap) (HM.elems tableCache)

 askEventTriggerInfo ::
  forall b m.
@ -615,23 +618,23 @@ getTriggerNames ::
 getTriggerNames = Set.fromList . OMap.keys . getTriggersMap

 getTableNameFromTrigger ::
-  forall b m.
-  (Backend b, QErrM m) =>
+  forall b.
+  Backend b =>
  SchemaCache ->
  SourceName ->
  TriggerName ->
-  m (Maybe (TableName b))
+  Maybe (TableName b)
 getTableNameFromTrigger schemaCache sourceName triggerName = do
-  tableInfoMaybe <- getTabInfoFromSchemaCache @b schemaCache sourceName triggerName
-  case tableInfoMaybe of
-    Nothing -> pure Nothing
-    Just tableInfo -> pure $ Just $ (_tciName . _tiCoreInfo) $ tableInfo
+  tableInfo <- getTabInfoFromSchemaCache @b schemaCache sourceName triggerName
+  pure $ _tciName $ _tiCoreInfo tableInfo

 runCleanupEventTriggerLog ::
-  (MonadEventLogCleanup m, MonadError QErr m) =>
+  (MonadEventLogCleanup m, MonadError QErr m, CacheRWM m) =>
  TriggerLogCleanupConfig ->
  m EncJSON
-runCleanupEventTriggerLog conf = runLogCleaner conf >>= (flip onLeft) throwError
+runCleanupEventTriggerLog conf = do
+  sourceCache <- scSources <$> askSchemaCache
+  runLogCleaner sourceCache conf `onLeftM` throwError

 -- | Updates the cleanup switch in metadata given the source, table and trigger name
 -- The Bool value represents the status of the cleaner, whether to start or pause it
@ -691,16 +694,15 @@ toggleEventTriggerCleanupAction conf cleanupSwitch = do
            `onNothing` throw400 NotExists ("source with name " <> sourceNameToText sourceName <> " does not exists")

        AB.dispatchAnyBackend @BackendEventTrigger backendSourceInfo \(SourceInfo {} :: SourceInfo b) -> do
-          forM_ triggerNames $ \triggerName -> do
+          for_ triggerNames $ \triggerName -> do
            eventTriggerInfo <- askEventTriggerInfo @b sourceName triggerName
-            tableNameMaybe <- getTableNameFromTrigger @b schemaCache sourceName triggerName
-            case tableNameMaybe of
-              Nothing -> throw400 NotExists $ "event trigger " <> triggerName <<> " does not exist"
-              Just tableName -> do
-                cleanupConfig <-
-                  (etiCleanupConfig eventTriggerInfo)
-                    `onNothing` throw400 NotExists ("cleanup config does not exist for " <> triggerNameToTxt triggerName)
-                updateCleanupStatusInMetadata @b cleanupConfig cleanupSwitch sourceName tableName triggerName
+            tableName <-
+              getTableNameFromTrigger @b schemaCache sourceName triggerName
+                `onNothing` throw400 NotExists ("event trigger " <> triggerName <<> " does not exist")
+            cleanupConfig <-
+              etiCleanupConfig eventTriggerInfo
+                `onNothing` throw400 NotExists ("cleanup config does not exist for " <> triggerNameToTxt triggerName)
+            updateCleanupStatusInMetadata @b cleanupConfig cleanupSwitch sourceName tableName triggerName
  pure successMsg
  where
    traverseTableHelper ::
--- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs
+++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs
@ -488,18 +488,16 @@ runReplaceMetadataV2' ReplaceMetadataV2 {..} = do
                      warn $ MetadataWarning WCSourceCleanupFailed sourceObjID message
                      logger $ MetadataLog HL.LevelWarn message J.Null
                    Just sourceConfig -> do
-                      for_ droppedEventTriggers $
-                        \triggerName -> do
-                          -- TODO: The `tableName` parameter could be computed while building
-                          -- the triggers map and avoid the cache lookup.
-                          tableNameMaybe <- getTableNameFromTrigger @b oldSchemaCache source triggerName
-                          case tableNameMaybe of
-                            Nothing -> do
-                              let message = sqlTriggerError triggerName
-                              warn $ MetadataWarning WCSourceCleanupFailed sourceObjID message
-                              logger $ MetadataLog HL.LevelWarn message J.Null
-                            Just tableName ->
-                              dropTriggerAndArchiveEvents @b sourceConfig triggerName tableName
+                      for_ droppedEventTriggers \triggerName -> do
+                        -- TODO: The `tableName` parameter could be computed while building
+                        -- the triggers map and avoid the cache lookup.
+                        case getTableNameFromTrigger @b oldSchemaCache source triggerName of
+                          Nothing -> do
+                            let message = sqlTriggerError triggerName
+                            warn $ MetadataWarning WCSourceCleanupFailed sourceObjID message
+                            logger $ MetadataLog HL.LevelWarn message J.Null
+                          Just tableName ->
+                            dropTriggerAndArchiveEvents @b sourceConfig triggerName tableName
                      for_ (OMap.toList retainedNewTriggers) $ \(retainedNewTriggerName, retainedNewTriggerConf) ->
                        case OMap.lookup retainedNewTriggerName oldTriggersMap of
                          Nothing -> do
@ -515,8 +513,7 @@ runReplaceMetadataV2' ReplaceMetadataV2 {..} = do
                                    (bool Nothing (Just UPDATE) (isDroppedOp (tdUpdate oldTriggerOps) (tdUpdate newTriggerOps))),
                                    (bool Nothing (Just ET.DELETE) (isDroppedOp (tdDelete oldTriggerOps) (tdDelete newTriggerOps)))
                                  ]
-                            tableNameMaybe <- getTableNameFromTrigger @b oldSchemaCache source retainedNewTriggerName
-                            case tableNameMaybe of
+                            case getTableNameFromTrigger @b oldSchemaCache source retainedNewTriggerName of
                              Nothing -> do
                                let message = sqlTriggerError retainedNewTriggerName
                                warn $ MetadataWarning WCSourceCleanupFailed sourceObjID message
--- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs
+++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs
@ -199,7 +199,7 @@ instance MonadReader r m => MonadReader r (CacheRWT m) where
  local f (CacheRWT m) = CacheRWT $ mapReaderT (local f) m

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (CacheRWT m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache

--- a/server/test-postgres/Test/Hasura/Server/MigrateSuite.hs
+++ b/server/test-postgres/Test/Hasura/Server/MigrateSuite.hs
@ -70,7 +70,7 @@ instance (MonadBase IO m) => CacheRM (CacheRefT m) where
  askSchemaCache = CacheRefT (fmap lastBuiltSchemaCache . readMVar . snd)

 instance (MonadEventLogCleanup m) => MonadEventLogCleanup (CacheRefT m) where
-  runLogCleaner conf = lift $ runLogCleaner conf
+  runLogCleaner sourceCache conf = lift $ runLogCleaner sourceCache conf
  generateCleanupSchedules sourceInfo triggerName cleanupConfig = lift $ generateCleanupSchedules sourceInfo triggerName cleanupConfig
  updateTriggerCleanupSchedules logger oldSources newSources schemaCache = lift $ updateTriggerCleanupSchedules logger oldSources newSources schemaCache