clear events related to schema cache updates (close #2542)

server/src-exec/Main.hs

@@ -38,7 +38,6 @@ import           Hasura.Server.Logging
 import           Hasura.Server.Query        (peelRun)
 import           Hasura.Server.SchemaUpdate
 import           Hasura.Server.Telemetry
-import           Hasura.Server.Utils
 import           Hasura.Server.Version      (currentVersion)
 
 import qualified Database.PG.Query          as Q
@@ -119,7 +118,7 @@ main =  do
   (HGEOptionsG rci hgeCmd) <- parseArgs
   -- global http manager
   httpManager <- HTTP.newManager HTTP.tlsManagerSettings
-  instanceId  <- mkInstanceId
+  instanceId  <- generateInstanceId
   case hgeCmd of
     HCServe so@(ServeOptions port host cp isoL mAdminSecret mAuthHook
                 mJwtSecret mUnAuthRole corsCfg enableConsole consoleAssetsDir
@@ -147,7 +146,7 @@ main =  do
       pool <- Q.initPGPool ci cp pgLogger
 
       -- safe init catalog
-      initRes <- initialise pool sqlGenCtx logger httpManager
+      dbId <- initialise pool sqlGenCtx logger httpManager
 
       (app, cacheRef, cacheInitTime) <-
         mkWaiApp isoL loggerCtx sqlGenCtx enableAL pool ci httpManager am
@@ -183,7 +182,7 @@ main =  do
       -- start a background thread for telemetry
       when enableTelemetry $ do
         unLogger logger $ mkGenericStrLog LevelInfo "telemetry" telemetryNotice
-        void $ C.forkIO $ runTelemetry logger httpManager scRef initRes
+        void $ C.forkIO $ runTelemetry logger httpManager scRef dbId instanceId
 
       finishTime <- Clock.getCurrentTime
       let apiInitTime = realToFrac $ Clock.diffUTCTime finishTime initTime
@@ -253,20 +252,15 @@ main =  do
                 migrateCatalog currentTime
       either printErrJExit (logger . mkGenericStrLog LevelInfo "db_migrate") migRes
 
-      -- generate and retrieve uuids
-      getUniqIds pool
+      -- retrieve database id
+      eDbId <- runTx pool getDbId
+      either printErrJExit return eDbId
 
     prepareEvents pool (Logger logger) = do
       logger $ mkGenericStrLog LevelInfo "event_triggers" "preparing data"
       res <- runTx pool unlockAllEvents
       either printErrJExit return res
 
-    getUniqIds pool = do
-      eDbId <- runTx pool getDbId
-      dbId <- either printErrJExit return eDbId
-      fp <- liftIO generateFingerprint
-      return (dbId, fp)
-
     getFromEnv :: (Read a) => a -> String -> IO a
     getFromEnv defaults env = do
       mEnv <- lookupEnv env

server/src-exec/Migrate.hs

@@ -19,7 +19,7 @@ import qualified Data.Yaml.TH                as Y
 import qualified Database.PG.Query           as Q
 
 curCatalogVer :: T.Text
-curCatalogVer = "17"
+curCatalogVer = "18"
 
 migrateMetadata
   :: ( MonadTx m
@@ -327,6 +327,13 @@ from16To17 =
              AND  table_name = 'hdb_allowlist';
            |]
 
+from17To18 :: MonadTx m => m ()
+from17To18 = do
+  -- Migrate database
+  Q.Discard () <- liftTx $ Q.multiQE defaultTxErrorHandler
+    $(Q.sqlFromFile "src-rsr/migrate_from_17_to_18.sql")
+  return ()
+
 migrateCatalog
   :: ( MonadTx m
      , CacheRWM m
@@ -358,10 +365,13 @@ migrateCatalog migrationTime = do
      | preVer == "14"  -> from14ToCurrent
      | preVer == "15"  -> from15ToCurrent
      | preVer == "16"  -> from16ToCurrent
+     | preVer == "17"  -> from17ToCurrent
      | otherwise -> throw400 NotSupported $
                     "unsupported version : " <> preVer
   where
-    from16ToCurrent = from16To17 >> postMigrate
+    from17ToCurrent = from17To18 >> postMigrate
+
+    from16ToCurrent = from16To17 >> from17ToCurrent
 
     from15ToCurrent = from15To16 >> from16ToCurrent
 

server/src-lib/Hasura/Server/Init.hs

@@ -14,27 +14,25 @@ import qualified Data.ByteString.Lazy.Char8       as BLC
 import qualified Data.HashSet                     as Set
 import qualified Data.String                      as DataString
 import qualified Data.Text                        as T
-import qualified Data.UUID                        as UUID
-import qualified Data.UUID.V4                     as UUID
 import qualified Hasura.GraphQL.Execute.LiveQuery as LQ
 import qualified Hasura.Logging                   as L
 import qualified Text.PrettyPrint.ANSI.Leijen     as PP
 
 import           Hasura.Prelude
-import           Hasura.RQL.Types                 ( RoleName (..)
-                                                  , SchemaCache (..)
-                                                  , mkNonEmptyText )
+import           Hasura.RQL.Types                 (RoleName (..),
+                                                   SchemaCache (..),
+                                                   mkNonEmptyText)
 import           Hasura.Server.Auth
 import           Hasura.Server.Cors
 import           Hasura.Server.Logging
 import           Hasura.Server.Utils
 
 newtype InstanceId
   = InstanceId { getInstanceId :: Text }
-  deriving (Show, Eq, J.ToJSON, J.FromJSON)
+  deriving (Show, Eq, J.ToJSON, J.FromJSON, Q.FromCol, Q.ToPrepArg)
 
-mkInstanceId :: IO InstanceId
-mkInstanceId = InstanceId . UUID.toText <$> UUID.nextRandom
+generateInstanceId :: IO InstanceId
+generateInstanceId = InstanceId <$> generateFingerprint
 
 data StartupTimeInfo
   = StartupTimeInfo
@@ -169,7 +167,7 @@ instance FromEnv AdminSecret where
 
 instance FromEnv RoleName where
   fromEnv string = case mkNonEmptyText (T.pack string) of
-    Nothing -> Left "empty string not allowed"
+    Nothing     -> Left "empty string not allowed"
     Just neText -> Right $ RoleName neText
 
 instance FromEnv Bool where

server/src-lib/Hasura/Server/Query.hs

@@ -128,27 +128,21 @@ instance HasSQLGenCtx Run where
 
 fetchLastUpdate :: Q.TxE QErr (Maybe (InstanceId, UTCTime))
 fetchLastUpdate = do
-  l <- Q.listQE defaultTxErrorHandler
+  Q.withQE defaultTxErrorHandler
     [Q.sql|
        SELECT instance_id::text, occurred_at
        FROM hdb_catalog.hdb_schema_update_event
        ORDER BY occurred_at DESC LIMIT 1
           |] () True
-  case l of
-    []           -> return Nothing
-    [(instId, occurredAt)] ->
-      return $ Just (InstanceId instId, occurredAt)
-    -- never happens
-    _            -> throw500 "more than one row returned by query"
 
 recordSchemaUpdate :: InstanceId -> Q.TxE QErr ()
 recordSchemaUpdate instanceId =
   liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
-             INSERT INTO
-                  hdb_catalog.hdb_schema_update_event
-                  (instance_id, occurred_at)
-             VALUES ($1::uuid, DEFAULT)
-            |] (Identity $ getInstanceId instanceId) True
+             INSERT INTO hdb_catalog.hdb_schema_update_event
+               (instance_id, occurred_at) VALUES ($1::uuid, DEFAULT)
+             ON CONFLICT ((occurred_at IS NOT NULL))
+             DO UPDATE SET instance_id = $1::uuid, occurred_at = DEFAULT
+            |] (Identity instanceId) True
 
 peelRun
   :: SchemaCache

server/src-lib/Hasura/Server/Telemetry.hs

@@ -19,6 +19,7 @@ import           Hasura.HTTP
 import           Hasura.Logging
 import           Hasura.Prelude
 import           Hasura.RQL.Types
+import           Hasura.Server.Init
 import           Hasura.Server.Version
 
 import qualified CI
@@ -68,7 +69,7 @@ $(A.deriveJSON (A.aesonDrop 3 A.snakeCase) ''Metrics)
 data HasuraTelemetry
   = HasuraTelemetry
   { _htDbUid       :: !Text
-  , _htInstanceUid :: !Text
+  , _htInstanceUid :: !InstanceId
   , _htVersion     :: !Text
   , _htCi          :: !(Maybe CI.CI)
   , _htMetrics     :: !Metrics
@@ -85,7 +86,7 @@ $(A.deriveJSON (A.aesonDrop 3 A.snakeCase) ''TelemetryPayload)
 telemetryUrl :: Text
 telemetryUrl = "https://telemetry.hasura.io/v1/http"
 
-mkPayload :: Text -> Text -> Text -> Metrics -> IO TelemetryPayload
+mkPayload :: Text -> InstanceId -> Text -> Metrics -> IO TelemetryPayload
 mkPayload dbId instanceId version metrics = do
   ci <- CI.getCI
   return $ TelemetryPayload topic $
@@ -96,9 +97,10 @@ runTelemetry
   :: Logger
   -> HTTP.Manager
   -> IORef (SchemaCache, SchemaCacheVer)
-  -> (Text, Text)
+  -> Text
+  -> InstanceId
   -> IO ()
-runTelemetry (Logger logger) manager cacheRef (dbId, instanceId) = do
+runTelemetry (Logger logger) manager cacheRef dbId instanceId = do
   let options = wreqOptions manager []
   forever $ do
     schemaCache <- fmap fst $ readIORef cacheRef

server/src-rsr/initialise.sql

@@ -410,11 +410,13 @@ CREATE TABLE hdb_catalog.remote_schemas (
 );
 
 CREATE TABLE hdb_catalog.hdb_schema_update_event (
-  id BIGSERIAL PRIMARY KEY,
   instance_id uuid NOT NULL,
   occurred_at timestamptz NOT NULL DEFAULT NOW()
 );
 
+CREATE UNIQUE INDEX hdb_schema_update_event_one_row
+  ON hdb_catalog.hdb_schema_update_event ((occurred_at IS NOT NULL));
+
 CREATE FUNCTION hdb_catalog.hdb_schema_update_event_notifier() RETURNS trigger AS
 $function$
   DECLARE
@@ -433,8 +435,9 @@ $function$
 $function$
 LANGUAGE plpgsql;
 
-CREATE TRIGGER hdb_schema_update_event_notifier AFTER INSERT ON hdb_catalog.hdb_schema_update_event
-  FOR EACH ROW EXECUTE PROCEDURE hdb_catalog.hdb_schema_update_event_notifier();
+CREATE TRIGGER hdb_schema_update_event_notifier_insert AFTER INSERT OR UPDATE ON
+  hdb_catalog.hdb_schema_update_event FOR EACH ROW EXECUTE PROCEDURE
+  hdb_catalog.hdb_schema_update_event_notifier();
 
 CREATE VIEW hdb_catalog.hdb_table_info_agg AS (
 select

server/src-rsr/migrate_from_17_to_18.sql

@@ -0,0 +1,15 @@
+-- Make hdb_catalog.hdb_schema_update_event as single row table
+-- Delete insert trigger and setup update trigger
+
+DELETE FROM hdb_catalog.hdb_schema_update_event;
+
+CREATE UNIQUE INDEX hdb_schema_update_event_one_row
+  ON hdb_catalog.hdb_schema_update_event ((occurred_at IS NOT NULL));
+
+ALTER TABLE hdb_catalog.hdb_schema_update_event DROP COLUMN id;
+
+DROP TRIGGER hdb_schema_update_event_notifier ON hdb_catalog.hdb_schema_update_event;
+
+CREATE TRIGGER hdb_schema_update_event_notifier_insert AFTER INSERT OR UPDATE ON
+  hdb_catalog.hdb_schema_update_event FOR EACH ROW EXECUTE PROCEDURE
+  hdb_catalog.hdb_schema_update_event_notifier();

server/stack.yaml.lock

@@ -0,0 +1,103 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    cabal-file:
+      size: 2829
+      sha256: 0ef7cf19d08caa11c690a732f14e4b7159c46cdda1d9e66dceb6d4bedd9fd9c1
+    name: pg-client
+    version: 0.1.0
+    git: https://github.com/hasura/pg-client-hs.git
+    pantry-tree:
+      size: 1051
+      sha256: fbab919039158f3714c3f0ac3d605d3fb9c85061517b4b9fc67147403b0b9975
+    commit: 16f27a134f12c4f24fee19d57f0ca179bdb4135b
+  original:
+    git: https://github.com/hasura/pg-client-hs.git
+    commit: 16f27a134f12c4f24fee19d57f0ca179bdb4135b
+- completed:
+    cabal-file:
+      size: 3295
+      sha256: 5c53f2e67996f9e3f85002f95a929a04b85a44e00ffbf1b7a8c034c5098aa630
+    name: graphql-parser
+    version: 0.1.0.0
+    git: https://github.com/hasura/graphql-parser-hs.git
+    pantry-tree:
+      size: 1771
+      sha256: 6e506a5dbf965325c515efc523e63bbc15640c994a5dbe21448d328c7ba619a1
+    commit: 1ccdbb4c4d743b679f3141992df39feaee971640
+  original:
+    git: https://github.com/hasura/graphql-parser-hs.git
+    commit: 1ccdbb4c4d743b679f3141992df39feaee971640
+- completed:
+    cabal-file:
+      size: 1253
+      sha256: d0356b65cbe17a2fecf9334aa133de238161ef9c22af015d67ab622e08eb8ed1
+    name: ci-info
+    version: 0.1.0.0
+    git: https://github.com/hasura/ci-info-hs.git
+    pantry-tree:
+      size: 512
+      sha256: 78d311887af8c825aa21563635fbe31503febcc490e0e5d81919835d83ef9046
+    commit: ad6df731584dc89b72a6e131687d37ef01714fe8
+  original:
+    git: https://github.com/hasura/ci-info-hs.git
+    commit: ad6df731584dc89b72a6e131687d37ef01714fe8
+- completed:
+    hackage: ginger-0.8.4.0@sha256:21c3051af3c90af39c40a50400c9a1a0fcccb544528e37cde30bdd30048437d8,3151
+    pantry-tree:
+      size: 1375
+      sha256: f8a7cb091ea4d8011bd530f83a22941a009d97ee7ccd4c93d0528aa72f3636ea
+  original:
+    hackage: ginger-0.8.4.0
+- completed:
+    hackage: select-0.4.0.1@sha256:d409315752a069693bdd4169fa9a8ea7777d814da77cd8604f367cf0741de295,2492
+    pantry-tree:
+      size: 1256
+      sha256: b6ae36ccba2a7cdd1ad130575931364002682e532d7043da62771e58294ddb7a
+  original:
+    hackage: select-0.4.0.1
+- completed:
+    hackage: primitive-extras-0.7.1@sha256:23905c57089418b1a2d324cfee3e81bbd5a344a0fa56a827867b2dce275fdb5e,2945
+    pantry-tree:
+      size: 1181
+      sha256: f788dae21ca4f0d0377d97a5ba7fd008d4b0af8991a745f94c29f2caa11dc6bd
+  original:
+    hackage: primitive-extras-0.7.1
+- completed:
+    hackage: stm-hamt-1.2.0.2@sha256:18126db7bf2d9c967a6020c677b3005dd957a4c39d69aeaea3c29c90de8f6124,3972
+    pantry-tree:
+      size: 1009
+      sha256: ef426797655d6b4b9238b1200c4129d44e91f996f26b92a035b1333b8b8a6f62
+  original:
+    hackage: stm-hamt-1.2.0.2
+- completed:
+    hackage: stm-containers-1.1.0.4@sha256:f83a683357b6e3b1dda3e70d2077a37224ed534df1f74c4e11f3f6daa7945c5b,3248
+    pantry-tree:
+      size: 761
+      sha256: 059c5a2d657d392aca0a887648f57380d6321734dc8879c056a44d4414308ac6
+  original:
+    hackage: stm-containers-1.1.0.4
+- completed:
+    hackage: reroute-0.5.0.0@sha256:3360747cdc700c9808a38bff48b75926efa443d4af282396082329a218a8d9d3,2446
+    pantry-tree:
+      size: 660
+      sha256: 52afcff0a5dba2fb746be4fa8cfa56cf774272872b61130537fe0e7ad463c0cd
+  original:
+    hackage: reroute-0.5.0.0
+- completed:
+    hackage: Spock-core-0.13.0.0@sha256:06e007f23c47bdda52d2927da54160d73f1b6f51a977f3ca9087275698db8f0a,3400
+    pantry-tree:
+      size: 1113
+      sha256: 86140298020f68bb09d07b26a6a6f1666fc3a02715d7986b09150727247a1a84
+  original:
+    hackage: Spock-core-0.13.0.0
+snapshots:
+- completed:
+    size: 498167
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/20.yaml
+    sha256: cda928d57b257a5f17bcad796843c9daa674fef47d600dbea3aa7b0e49d64a11
+  original: lts-13.20