fix update event trigger & dropping triggers on run_sql (fix #3803, #3784)

server/src-lib/Hasura/App.hs

@@ -241,7 +241,7 @@ runHGEServer ServeOptions{..} InitCtx{..} initTime = do
                      $ Warp.defaultSettings
 
   maxEvThrds <- liftIO $ getFromEnv defaultMaxEventThreads "HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE"
-  fetchI  <- fmap milliseconds $ liftIO $ 
+  fetchI  <- fmap milliseconds $ liftIO $
     getFromEnv defaultFetchIntervalMilliSec "HASURA_GRAPHQL_EVENTS_FETCH_INTERVAL"
   logEnvHeaders <- liftIO $ getFromEnv False "LOG_HEADERS_FROM_ENV"
 

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

@@ -12,8 +12,9 @@ module Hasura.RQL.DDL.EventTrigger
   , subTableP2
   , subTableP2Setup
   , mkAllTriggersQ
+  , delTriggerQ
   , getEventTriggerDef
-  , updateEventTriggerDef
+  , updateEventTriggerInCatalog
   ) where
 
 import           Data.Aeson
@@ -143,23 +144,14 @@ delEventTriggerFromCatalog trn = do
   delTriggerQ trn
   archiveEvents trn
 
-archiveEvents:: TriggerName -> Q.TxE QErr ()
+archiveEvents :: TriggerName -> Q.TxE QErr ()
 archiveEvents trn = do
   Q.unitQE defaultTxErrorHandler [Q.sql|
            UPDATE hdb_catalog.event_log
            SET archived = 't'
            WHERE trigger_name = $1
                 |] (Identity trn) False
 
-updateEventTriggerToCatalog
-  :: EventTriggerConf
-  -> Q.TxE QErr ()
-updateEventTriggerToCatalog etc = do
-  updateEventTriggerDef name etc
-  delTriggerQ name
-  where
-    EventTriggerConf name _ _ _ _ _ = etc
-
 fetchEvent :: EventId -> Q.TxE QErr (EventId, Bool)
 fetchEvent eid = do
   events <- Q.listQE defaultTxErrorHandler
@@ -252,7 +244,7 @@ subTableP2
   :: (MonadTx m)
   => QualifiedTable -> Bool -> EventTriggerConf -> m ()
 subTableP2 qt replace etc = liftTx if replace
-  then updateEventTriggerToCatalog etc
+  then updateEventTriggerInCatalog etc
   else addEventTriggerToCatalog qt etc
 
 runCreateEventTriggerQuery
@@ -353,13 +345,12 @@ getEventTriggerDef triggerName = do
            |] (Identity triggerName) False
   return (QualifiedObject sn tn, etc)
 
-updateEventTriggerDef
-  :: TriggerName -> EventTriggerConf -> Q.TxE QErr ()
-updateEventTriggerDef trigName trigConf =
+updateEventTriggerInCatalog :: EventTriggerConf -> Q.TxE QErr ()
+updateEventTriggerInCatalog trigConf =
   Q.unitQE defaultTxErrorHandler
     [Q.sql|
       UPDATE hdb_catalog.event_triggers
       SET
       configuration = $1
       WHERE name = $2
-    |] (Q.AltJ $ toJSON trigConf, trigName) True
+    |] (Q.AltJ $ toJSON trigConf, etcName trigConf) True

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

@@ -85,7 +85,7 @@ instance ToJSON RunSQL where
           Q.ReadWrite -> False
       ]
 
-runRunSQL :: (MonadTx m, CacheRWM m) => RunSQL -> m EncJSON
+runRunSQL :: (MonadTx m, CacheRWM m, HasSQLGenCtx m) => RunSQL -> m EncJSON
 runRunSQL RunSQL {..} = do
   metadataCheckNeeded <- onNothing rCheckMetadataConsistency $ isAltrDropReplace rSql
   bool (execRawSQL rSql) (withMetadataCheck rCascade $ execRawSQL rSql) metadataCheckNeeded

server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs

@@ -264,7 +264,8 @@ buildSchemaCacheRule = proc inputs -> do
         recreateViewIfNeeded = Inc.cache $
           arrM \(tableName, tableColumns, triggerName, triggerDefinition) -> do
             buildReason <- ask
-            when (buildReason == CatalogUpdate) $
+            when (buildReason == CatalogUpdate) $ do
+              liftTx $ delTriggerQ triggerName -- executes DROP IF EXISTS.. sql
               mkAllTriggersQ triggerName tableName (M.elems tableColumns) triggerDefinition
 
     addRemoteSchema
@@ -289,7 +290,7 @@ buildSchemaCacheRule = proc inputs -> do
 -- | @'withMetadataCheck' cascade action@ runs @action@ and checks if the schema changed as a
 -- result. If it did, it checks to ensure the changes do not violate any integrity constraints, and
 -- if not, incorporates them into the schema cache.
-withMetadataCheck :: (MonadTx m, CacheRWM m) => Bool -> m a -> m a
+withMetadataCheck :: (MonadTx m, CacheRWM m, HasSQLGenCtx m) => Bool -> m a -> m a
 withMetadataCheck cascade action = do
   -- Drop hdb_views so no interference is caused to the sql query
   liftTx $ Q.catchE defaultTxErrorHandler clearHdbViews
@@ -346,7 +347,17 @@ withMetadataCheck cascade action = do
   processSchemaChanges schemaDiff
 
   buildSchemaCache
-  currentInconsistentObjs <- scInconsistentObjs <$> askSchemaCache
+  postSc <- askSchemaCache
+
+  -- Recreate event triggers in hdb_views
+  forM_ (M.elems $ scTables postSc) $ \(TableInfo coreInfo _ eventTriggers) -> do
+          let table = _tciName coreInfo
+              columns = getCols $ _tciFieldInfoMap coreInfo
+          forM_ (M.toList eventTriggers) $ \(triggerName, eti) -> do
+            let opsDefinition = etiOpsDef eti
+            mkAllTriggersQ triggerName table columns opsDefinition
+
+  let currentInconsistentObjs = scInconsistentObjs postSc
   checkNewInconsistentMeta existingInconsistentObjs currentInconsistentObjs
 
   return res

server/src-lib/Hasura/RQL/DDL/Schema/Rename.hs

@@ -349,7 +349,7 @@ updateColInEventTriggerDef
   => TriggerName -> RenameCol -> m ()
 updateColInEventTriggerDef trigName rnCol = do
   (trigTab, trigDef) <- liftTx $ DS.getEventTriggerDef trigName
-  void $ liftTx $ DS.updateEventTriggerDef trigName $
+  void $ liftTx $ DS.updateEventTriggerInCatalog $
     rewriteEventTriggerConf trigTab trigDef
   where
     rewriteSubsCols trigTab = \case