server: Apply migrations when catalog version < 43

Co-authored-by: Rakesh Emmadi <12475069+rakeshkky@users.noreply.github.com>
GitOrigin-RevId: 4fa1a04f4924002faac1eca2e5092dfa8767fdb9

server/graphql-engine.cabal

@@ -369,6 +369,7 @@ library
                      , Hasura.Server.CheckUpdates
                      , Hasura.Server.SchemaUpdate
                      , Hasura.Server.Migrate.Version
+                     , Hasura.Server.Migrate.Internal
                      , Hasura.Server.Auth.JWT.Internal
                      , Hasura.Server.Auth.JWT.Logging
                      , Hasura.RQL.Instances

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

@@ -4,8 +4,10 @@ where
 
 import qualified Data.HashMap.Strict                 as Map
 import qualified Database.PG.Query                   as Q
+import qualified Language.Haskell.TH.Lib             as TH
+import qualified Language.Haskell.TH.Syntax          as TH
 
-import           Control.Lens                        hiding (from, index, op, (.=))
+import           Control.Lens                        hiding (from, index, op, to, (.=))
 import           Control.Monad.Trans.Control         (MonadBaseControl)
 
 import           Hasura.Backends.Postgres.Connection
@@ -18,6 +20,7 @@ import           Hasura.RQL.Types.Function
 import           Hasura.RQL.Types.Source
 import           Hasura.RQL.Types.Table
 import           Hasura.SQL.Backend
+import           Hasura.Server.Migrate.Internal
 
 resolveSourceConfig
   :: (MonadIO m, MonadResolveSource m)
@@ -45,15 +48,19 @@ initSource = do
   sourceVersionTableExist <- doesTableExist "hdb_catalog" "hdb_source_catalog_version"
      -- Fresh database
   if | not hdbCatalogExist -> liftTx do
-         Q.unitQE defaultTxErrorHandler "CREATE SCHEMA hdb_catalog" () False
-         enablePgcryptoExtension
-         initPgSourceCatalog
+        Q.unitQE defaultTxErrorHandler "CREATE SCHEMA hdb_catalog" () False
+        enablePgcryptoExtension
+        initPgSourceCatalog
      -- Only 'hdb_catalog' schema defined
      | not sourceVersionTableExist && not eventLogTableExist ->
-         liftTx initPgSourceCatalog
+        liftTx initPgSourceCatalog
      -- Source is initialised by pre multisource support servers
-     | not sourceVersionTableExist && eventLogTableExist ->
-         liftTx createVersionTable
+     | not sourceVersionTableExist && eventLogTableExist -> do
+       -- Update the Source Catalog to v43 to include the new migration
+       -- changes. Skipping this step will result in errors.
+        currCatalogVersion <- getCatalogVersion
+        migrateTo43 currCatalogVersion
+        liftTx createVersionTable
      | otherwise -> migrateSourceCatalog
   where
     initPgSourceCatalog = do
@@ -79,6 +86,30 @@ initSource = do
         "1" -> pure ()
         _   -> throw500 $ "unexpected source catalog version: " <> version
 
+    migrateTo43 prevVersion = do
+      let neededMigrations = dropWhile ((/= prevVersion) . fst) upMigrationsUntil43
+      traverse_ snd neededMigrations
+
+-- Upgrade the hdb_catalog schema to v43
+upMigrationsUntil43 :: MonadTx m => [(Text, m ())]
+upMigrationsUntil43 =
+    $(let migrationFromFile from to =
+            let path = "src-rsr/migrations/" <> from <> "_to_" <> to <> ".sql"
+             in [| runTx $(Q.sqlFromFile path) |]
+
+          migrationsFromFile = map $ \(to :: Integer) ->
+            let from = to - 1
+            in [| ( $(TH.lift $ tshow from)
+                  , $(migrationFromFile (show from) (show to))
+                  ) |]
+      in TH.listE
+        -- version 0.8 is the only non-integral catalog version
+        $  [| ("0.8", $(migrationFromFile "08" "1")) |]
+        :  migrationsFromFile [2..3]
+        ++ [| ("3", from3To4) |]
+        :  migrationsFromFile [5..43]
+     )
+
 currentSourceCatalogVersion :: Text
 currentSourceCatalogVersion = "1"
 

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

@@ -44,11 +44,11 @@ import           Hasura.RQL.DDL.Schema.LegacyCatalog
 import           Hasura.RQL.Types
 import           Hasura.Server.Init                  (DowngradeOptions (..), databaseUrlEnv)
 import           Hasura.Server.Logging               (StartupLog (..))
+import           Hasura.Server.Migrate.Internal
 import           Hasura.Server.Migrate.Version       (latestCatalogVersion,
                                                       latestCatalogVersionString)
 import           Hasura.Server.Types                 (MaintenanceMode (..))
 
-
 data MigrationResult
   = MRNothingToDo
   | MRInitialized
@@ -217,12 +217,6 @@ downgradeCatalog defaultSourceConfig opts time = do
             | x == upper = Right [y]
             | otherwise = (y:) <$> dropOlderDowngrades xs
 
--- | The old 0.8 catalog version is non-integral, so we store it in the database as a
--- string.
-getCatalogVersion :: MonadTx m => m Text
-getCatalogVersion = liftTx $ runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler
-  [Q.sql| SELECT version FROM hdb_catalog.hdb_version |] () False
-
 setCatalogVersion :: MonadTx m => Text -> UTCTime -> m ()
 setCatalogVersion ver time = liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
     INSERT INTO hdb_catalog.hdb_version (version, upgraded_on) VALUES ($1, $2)
@@ -271,32 +265,6 @@ migrations maybeDefaultSourceConfig dryRun maintenanceMode =
           liftIO . TIO.putStrLn . Q.getQueryText
       | otherwise = runTx
 
-    from3To4 = liftTx $ Q.catchE defaultTxErrorHandler $ do
-      Q.unitQ [Q.sql|
-        ALTER TABLE hdb_catalog.event_triggers
-        ADD COLUMN configuration JSON |] () False
-      eventTriggers <- map uncurryEventTrigger <$> Q.listQ [Q.sql|
-        SELECT e.name, e.definition::json, e.webhook, e.num_retries, e.retry_interval, e.headers::json
-        FROM hdb_catalog.event_triggers e |] () False
-      forM_ eventTriggers updateEventTrigger3To4
-      Q.unitQ [Q.sql|
-        ALTER TABLE hdb_catalog.event_triggers
-        DROP COLUMN definition,
-        DROP COLUMN query,
-        DROP COLUMN webhook,
-        DROP COLUMN num_retries,
-        DROP COLUMN retry_interval,
-        DROP COLUMN headers |] () False
-      where
-        uncurryEventTrigger (trn, Q.AltJ tDef, w, nr, rint, Q.AltJ headers) =
-          EventTriggerConf trn tDef (Just w) Nothing (RetryConf nr rint Nothing) headers
-        updateEventTrigger3To4 etc@(EventTriggerConf name _ _ _ _ _) = Q.unitQ [Q.sql|
-                                             UPDATE hdb_catalog.event_triggers
-                                             SET
-                                             configuration = $1
-                                             WHERE name = $2
-                                             |] (Q.AltJ $ A.toJSON etc, name) True
-
     from42To43 = do
       when (maintenanceMode == MaintenanceModeEnabled) $
         throw500 "cannot migrate to catalog version 43 in maintenance mode"
@@ -335,7 +303,3 @@ migrations maybeDefaultSourceConfig dryRun maintenanceMode =
           _ -> throw400 NotSupported "Cannot downgrade since there are more than one source"
         liftTx $ runHasSystemDefinedT (SystemDefined False) $ saveMetadataToHdbTables metadataV2
         recreateSystemMetadata
-
-
-runTx :: (MonadTx m) => Q.Query -> m ()
-runTx = liftTx . Q.multiQE defaultTxErrorHandler

server/src-lib/Hasura/Server/Migrate/Internal.hs

@@ -0,0 +1,48 @@
+module Hasura.Server.Migrate.Internal
+  ( runTx
+  , getCatalogVersion
+  , from3To4
+  )
+where
+import           Hasura.Backends.Postgres.Connection
+import           Hasura.Prelude
+import           Hasura.RQL.Types.EventTrigger
+
+import qualified Data.Aeson                          as A
+import qualified Database.PG.Query                   as Q
+
+runTx :: (MonadTx m) => Q.Query -> m ()
+runTx = liftTx . Q.multiQE defaultTxErrorHandler
+
+-- | The old 0.8 catalog version is non-integral, so we store it in the database as a
+-- string.
+getCatalogVersion :: MonadTx m => m Text
+getCatalogVersion = liftTx $ runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler
+  [Q.sql| SELECT version FROM hdb_catalog.hdb_version |] () False
+
+from3To4 :: MonadTx m => m ()
+from3To4 = liftTx $ Q.catchE defaultTxErrorHandler $ do
+    Q.unitQ [Q.sql|
+      ALTER TABLE hdb_catalog.event_triggers
+      ADD COLUMN configuration JSON |] () False
+    eventTriggers <- map uncurryEventTrigger <$> Q.listQ [Q.sql|
+      SELECT e.name, e.definition::json, e.webhook, e.num_retries, e.retry_interval, e.headers::json
+      FROM hdb_catalog.event_triggers e |] () False
+    forM_ eventTriggers updateEventTrigger3To4
+    Q.unitQ [Q.sql|
+      ALTER TABLE hdb_catalog.event_triggers
+      DROP COLUMN definition,
+      DROP COLUMN query,
+      DROP COLUMN webhook,
+      DROP COLUMN num_retries,
+      DROP COLUMN retry_interval,
+      DROP COLUMN headers |] () False
+    where
+      uncurryEventTrigger (trn, Q.AltJ tDef, w, nr, rint, Q.AltJ headers) =
+        EventTriggerConf trn tDef (Just w) Nothing (RetryConf nr rint Nothing) headers
+      updateEventTrigger3To4 etc@(EventTriggerConf name _ _ _ _ _) = Q.unitQ [Q.sql|
+                                            UPDATE hdb_catalog.event_triggers
+                                            SET
+                                            configuration = $1
+                                            WHERE name = $2
+                                            |] (Q.AltJ $ A.toJSON etc, name) True