server: remove the extraneous drop function while creating an event trigger

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3956
GitOrigin-RevId: 6d97ffce00fe17ca7f15a8e74acbc1b3d974f7b4

server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs

@@ -9,6 +9,7 @@ module Hasura.Backends.Postgres.DDL.EventTrigger
     dropTriggerAndArchiveEvents,
     createTableEventTrigger,
     dropTriggerQ,
+    dropDanglingSQLTrigger,
     mkAllTriggersQ,
     getMaintenanceModeVersion,
     fetchUndeliveredEvents,
@@ -189,12 +190,24 @@ createTableEventTrigger ::
   Maybe (PrimaryKey ('Postgres pgKind) (ColumnInfo ('Postgres pgKind))) ->
   m (Either QErr ())
 createTableEventTrigger serverConfigCtx sourceConfig table columns triggerName opsDefinition _ = runPgSourceWriteTx sourceConfig $ do
-  -- Clean all existing triggers
-  liftTx $ dropTriggerQ triggerName -- executes DROP IF EXISTS.. sql
   -- Create the given triggers
   flip runReaderT serverConfigCtx $
     mkAllTriggersQ triggerName table columns opsDefinition
 
+dropDanglingSQLTrigger ::
+  ( MonadIO m,
+    MonadError QErr m
+  ) =>
+  SourceConfig ('Postgres pgKind) ->
+  TriggerName ->
+  HashSet Ops ->
+  m ()
+dropDanglingSQLTrigger sourceConfig triggerName ops =
+  liftEitherM $
+    liftIO $
+      runPgSourceWriteTx sourceConfig $
+        traverse_ (dropTriggerOp triggerName) ops
+
 updateColumnInEventTrigger ::
   QualifiedTable ->
   PGCol ->
@@ -464,21 +477,21 @@ setRetryTx e time = \case
 
 dropTriggerQ :: TriggerName -> Q.TxE QErr ()
 dropTriggerQ trn =
-  mapM_
+  mapM_ (dropTriggerOp trn) [INSERT, UPDATE, DELETE]
-    ( \op ->
+
+dropTriggerOp :: TriggerName -> Ops -> Q.TxE QErr ()
+dropTriggerOp triggerName triggerOp =
   Q.unitQE
     defaultTxErrorHandler
-          (Q.fromText $ getDropFuncSql op)
+    (Q.fromText $ getDropFuncSql triggerOp)
     ()
     False
-    )
-    [INSERT, UPDATE, DELETE]
   where
     getDropFuncSql :: Ops -> Text
     getDropFuncSql op =
       "DROP FUNCTION IF EXISTS"
         <> " hdb_catalog."
-        <> pgIdenTrigger op trn
+        <> pgIdenTrigger op triggerName
         <> "()"
         <> " CASCADE"
 

server/src-lib/Hasura/RQL/DDL/EventTrigger.hs

@@ -35,6 +35,7 @@ import Data.ByteString.Lazy qualified as LBS
 import Data.Environment qualified as Env
 import Data.HashMap.Strict qualified as HM
 import Data.HashMap.Strict.InsOrd qualified as OMap
+import Data.HashSet qualified as Set
 import Data.Text qualified as T
 import Data.Text.Extended
 import Hasura.Base.Error
@@ -146,7 +147,7 @@ resolveEventTriggerQuery ::
   forall b m.
   (Backend b, UserInfoM m, QErrM m, CacheRM m) =>
   CreateEventTriggerQuery b ->
-  m (TableCoreInfo b, Bool, EventTriggerConf b)
+  m (Bool, EventTriggerConf b)
 resolveEventTriggerQuery (CreateEventTriggerQuery source name qt insert update delete enableManual retryConf webhook webhookFromEnv mheaders replace reqTransform respTransform) = do
   ti <- askTableCoreInfo source qt
   -- can only replace for same table
@@ -159,20 +160,31 @@ resolveEventTriggerQuery (CreateEventTriggerQuery source name qt insert update d
   assertCols ti delete
 
   let rconf = fromMaybe defaultRetryConf retryConf
-  return (ti, replace, EventTriggerConf name (TriggerOpsDef insert update delete enableManual) webhook webhookFromEnv rconf mheaders reqTransform respTransform)
+  return (replace, EventTriggerConf name (TriggerOpsDef insert update delete enableManual) webhook webhookFromEnv rconf mheaders reqTransform respTransform)
   where
     assertCols :: TableCoreInfo b -> Maybe (SubscribeOpSpec b) -> m ()
     assertCols ti opSpec = onJust opSpec \sos -> case sosColumns sos of
       SubCStar -> return ()
       SubCArray columns -> forM_ columns (assertColumnExists @b (_tciFieldInfoMap ti) "")
 
+droppedTriggerOps :: TriggerOpsDef b -> TriggerOpsDef b -> HashSet Ops
+droppedTriggerOps oldEventTriggerOps newEventTriggerOps =
+  Set.fromList $
+    catMaybes $
+      [ (bool Nothing (Just INSERT) (isDroppedOp (tdInsert oldEventTriggerOps) (tdInsert newEventTriggerOps))),
+        (bool Nothing (Just UPDATE) (isDroppedOp (tdUpdate oldEventTriggerOps) (tdUpdate newEventTriggerOps))),
+        (bool Nothing (Just DELETE) (isDroppedOp (tdDelete oldEventTriggerOps) (tdDelete newEventTriggerOps)))
+      ]
+  where
+    isDroppedOp old new = isJust old && isNothing new
+
 createEventTriggerQueryMetadata ::
   forall b m.
-  (BackendMetadata b, QErrM m, UserInfoM m, CacheRWM m, MetadataM m) =>
+  (BackendMetadata b, QErrM m, UserInfoM m, CacheRWM m, MetadataM m, BackendEventTrigger b, MonadIO m) =>
   CreateEventTriggerQuery b ->
-  m (TableCoreInfo b, EventTriggerConf b)
+  m ()
 createEventTriggerQueryMetadata q = do
-  (tableCoreInfo, replace, triggerConf) <- resolveEventTriggerQuery q
+  (replace, triggerConf) <- resolveEventTriggerQuery q
   let table = _cetqTable q
       source = _cetqSource q
       triggerName = etcName triggerConf
@@ -181,21 +193,26 @@ createEventTriggerQueryMetadata q = do
           AB.mkAnyBackend $
             SMOTableObj @b table $
               MTOTrigger triggerName
+  sourceInfo <- askSourceInfo @b source
+  when replace $ do
+    existingEventTriggerOps <- etiOpsDef <$> askEventTriggerInfo @b source triggerName
+    let droppedOps = droppedTriggerOps existingEventTriggerOps (etcDefinition triggerConf)
+    dropDanglingSQLTrigger @b (_siConfiguration sourceInfo) triggerName droppedOps
+
   buildSchemaCacheFor metadataObj $
     MetadataModifier $
       tableMetadataSetter @b source table . tmEventTriggers
         %~ if replace
           then ix triggerName .~ triggerConf
           else OMap.insert triggerName triggerConf
-  pure (tableCoreInfo, triggerConf)
 
 runCreateEventTriggerQuery ::
   forall b m.
-  (BackendMetadata b, QErrM m, UserInfoM m, CacheRWM m, MetadataM m) =>
+  (BackendMetadata b, BackendEventTrigger b, QErrM m, UserInfoM m, CacheRWM m, MetadataM m, MonadIO m) =>
   CreateEventTriggerQuery b ->
   m EncJSON
 runCreateEventTriggerQuery q = do
-  void $ createEventTriggerQueryMetadata @b q
+  createEventTriggerQueryMetadata @b q
   pure successMsg
 
 runDeleteEventTriggerQuery ::

server/src-lib/Hasura/RQL/DDL/Metadata.hs

@@ -30,6 +30,7 @@ import Data.Has (Has, getter)
 import Data.HashMap.Strict qualified as Map
 import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
 import Data.HashSet qualified as HS
+import Data.HashSet qualified as Set
 import Data.List qualified as L
 import Data.TByteString qualified as TBS
 import Data.Text qualified as T
@@ -58,6 +59,7 @@ import Hasura.RQL.DDL.Webhook.Transform
 import Hasura.RQL.DDL.Webhook.Transform.Class (mkReqTransformCtx)
 import Hasura.RQL.Types
 import Hasura.RQL.Types.Endpoint
+import Hasura.RQL.Types.EventTrigger qualified as ET
 import Hasura.RQL.Types.Eventing.Backend (BackendEventTrigger (..))
 import Hasura.SQL.AnyBackend qualified as AB
 import Network.HTTP.Client.Transformable qualified as HTTP
@@ -279,7 +281,8 @@ runReplaceMetadataV2 ReplaceMetadataV2 {..} = do
             dispatch oldBackendSourceMetadata \oldSourceMetadata -> do
               let oldTriggersMap = getTriggersMap oldSourceMetadata
                   newTriggersMap = getTriggersMap newSourceMetadata
-                  droppedTriggers = OMap.keys $ oldTriggersMap `OMap.difference` newTriggersMap
+                  droppedEventTriggers = OMap.keys $ oldTriggersMap `OMap.difference` newTriggersMap
+                  retainedNewTriggers = newTriggersMap `OMap.intersection` oldTriggersMap
                   catcher e@QErr {qeCode}
                     | qeCode == Unexpected = pure () -- NOTE: This information should be returned by the inconsistent_metadata response, so doesn't need additional logging.
                     | otherwise = throwError e -- rethrow other errors
@@ -292,7 +295,20 @@ runReplaceMetadataV2 ReplaceMetadataV2 {..} = do
               return $
                 flip catchError catcher do
                   sourceConfig <- askSourceConfig @b source
-                  for_ droppedTriggers $ dropTriggerAndArchiveEvents @b sourceConfig
+                  for_ droppedEventTriggers $ dropTriggerAndArchiveEvents @b sourceConfig
+                  for_ (OMap.toList retainedNewTriggers) $ \(retainedNewTriggerName, retainedNewTriggerConf) ->
+                    case OMap.lookup retainedNewTriggerName oldTriggersMap of
+                      Nothing -> pure ()
+                      Just oldTriggerConf -> do
+                        let newTriggerOps = etcDefinition retainedNewTriggerConf
+                            oldTriggerOps = etcDefinition oldTriggerConf
+                            isDroppedOp old new = isJust old && isNothing new
+                            droppedOps =
+                              [ (bool Nothing (Just INSERT) (isDroppedOp (tdInsert oldTriggerOps) (tdInsert newTriggerOps))),
+                                (bool Nothing (Just UPDATE) (isDroppedOp (tdUpdate oldTriggerOps) (tdUpdate newTriggerOps))),
+                                (bool Nothing (Just ET.DELETE) (isDroppedOp (tdDelete oldTriggerOps) (tdDelete newTriggerOps)))
+                              ]
+                        dropDanglingSQLTrigger @b sourceConfig retainedNewTriggerName (Set.fromList $ catMaybes droppedOps)
       where
         getTriggersMap = OMap.unions . map _tmEventTriggers . OMap.elems . _smTables
 

server/src-lib/Hasura/RQL/Types/EventTrigger.hs

@@ -63,7 +63,9 @@ newtype TriggerName = TriggerName {unTriggerName :: NonEmptyText}
 triggerNameToTxt :: TriggerName -> Text
 triggerNameToTxt = unNonEmptyText . unTriggerName
 
-data Ops = INSERT | UPDATE | DELETE | MANUAL deriving (Show)
+data Ops = INSERT | UPDATE | DELETE | MANUAL deriving (Show, Eq, Generic)
+
+instance Hashable Ops
 
 data SubscribeColumns (b :: BackendType) = SubCStar | SubCArray [Column b]
   deriving (Generic)

server/src-lib/Hasura/RQL/Types/Eventing/Backend.hs

@@ -150,6 +150,21 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     TriggerName ->
     m ()
 
+  -- | @dropDanglingSQLTriggger@ is used to delete the extraneous SQL triggers created
+  --   by an event trigger. The extraneous SQL triggers can be created when
+  --   an event trigger's definition is replaced to a new definition. For example,
+  --   an event trigger `authors_all` had an INSERT and UPDATE trigger defined
+  --   earlier and after it has UPDATE and DELETE triggers. So, in this case, we need
+  --   to drop the trigger created by us earlier for the INSERT trigger.
+  dropDanglingSQLTrigger ::
+    ( MonadIO m,
+      MonadError QErr m
+    ) =>
+    SourceConfig b ->
+    TriggerName ->
+    HashSet Ops ->
+    m ()
+
   redeliverEvent ::
     (MonadIO m, MonadError QErr m) =>
     SourceConfig b ->
@@ -192,6 +207,7 @@ instance BackendEventTrigger ('Postgres 'Vanilla) where
   recordError = PG.recordError
   recordError' = PG.recordError'
   dropTriggerAndArchiveEvents = PG.dropTriggerAndArchiveEvents
+  dropDanglingSQLTrigger = PG.dropDanglingSQLTrigger
   redeliverEvent = PG.redeliverEvent
   unlockEventsInSource = PG.unlockEventsInSource
   createTableEventTrigger = PG.createTableEventTrigger
@@ -205,6 +221,7 @@ instance BackendEventTrigger ('Postgres 'Citus) where
   recordError _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for Citus sources"
   recordError' _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for Citus sources"
   dropTriggerAndArchiveEvents _ _ = throw400 NotSupported "Event triggers are not supported for Citus sources"
+  dropDanglingSQLTrigger _ _ _ = throw400 NotSupported "Event triggers are not supported for Citus sources"
   redeliverEvent _ _ = throw400 NotSupported "Event triggers are not supported for Citus sources"
   unlockEventsInSource _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for Citus sources"
   createTableEventTrigger _ _ _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for Citus sources"
@@ -218,6 +235,7 @@ instance BackendEventTrigger 'MSSQL where
   recordError _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
   recordError' _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
   dropTriggerAndArchiveEvents _ _ = throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
+  dropDanglingSQLTrigger _ _ _ = throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
   redeliverEvent _ _ = throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
   unlockEventsInSource _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MS-SQL sources"
   createTableEventTrigger = MSSQL.createTableEventTrigger
@@ -231,6 +249,7 @@ instance BackendEventTrigger 'BigQuery where
   recordError _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for BigQuery sources"
   recordError' _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for BigQuery sources"
   dropTriggerAndArchiveEvents _ _ = throw400 NotSupported "Event triggers are not supported for BigQuery sources"
+  dropDanglingSQLTrigger _ _ _ = throw400 NotSupported "Event triggers are not supported for BigQuery sources"
   redeliverEvent _ _ = throw400 NotSupported "Event triggers are not supported for BigQuery sources"
   unlockEventsInSource _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for BigQuery sources"
   createTableEventTrigger _ _ _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for BigQuery sources"
@@ -244,6 +263,7 @@ instance BackendEventTrigger 'MySQL where
   recordError _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MySQL sources"
   recordError' _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MySQL sources"
   dropTriggerAndArchiveEvents _ _ = throw400 NotSupported "Event triggers are not supported for MySQL sources"
+  dropDanglingSQLTrigger _ _ _ = throw400 NotSupported "Event triggers are not supported for MySQL sources"
   redeliverEvent _ _ = throw400 NotSupported "Event triggers are not supported for MySQL sources"
   unlockEventsInSource _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MySQL sources"
   createTableEventTrigger _ _ _ _ _ _ _ = runExceptT $ throw400 NotSupported "Event triggers are not supported for MySQL sources"
@@ -271,6 +291,8 @@ instance BackendEventTrigger 'DataWrapper where
     runExceptT $ throw400 NotSupported "Event triggers are not supported for GraphQL Data Wrappers."
   dropTriggerAndArchiveEvents _ _ =
     throw400 NotSupported "Event triggers are not supported for GraphQL Data Wrappers."
+  dropDanglingSQLTrigger _ _ _ =
+    throw400 NotSupported "Event triggers are not supported for GraphQL Data Wrappers"
   redeliverEvent _ _ =
     throw400 NotSupported "Event triggers are not supported for GraphQL Data Wrappers."
   unlockEventsInSource _ _ =

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -433,7 +433,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
   RMAddComputedField q -> runAddComputedField q
   RMDropComputedField q -> runDropComputedField q
   RMCreateEventTrigger q ->
-    dispatchMetadata
+    dispatchMetadataAndEventTrigger
       ( validateTransforms
           (unUnvalidate1 . cetqRequestTransform . _Just)
           (runCreateEventTriggerQuery . _unUnvalidate1)