🍆

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
@@ -103,15 +103,6 @@ setAsSystemDefinedFor16 =
              AND  table_name = 'hdb_query_collection';
            |]
 
-getCatalogVersion
-  :: (MonadTx m)
-  => m T.Text
-getCatalogVersion = do
-  res <- liftTx $ Q.withQE defaultTxErrorHandler [Q.sql|
-                SELECT version FROM hdb_catalog.hdb_version
-                    |] () False
-  return $ runIdentity $ Q.getRow res
-
 from08To1 :: (MonadTx m) => m ()
 from08To1 = liftTx $ Q.catchE defaultTxErrorHandler $ do
   Q.unitQ "ALTER TABLE hdb_catalog.hdb_relationship ADD COLUMN comment TEXT NULL" () False
@@ -327,6 +318,24 @@ from16To17 =
              AND  table_name = 'hdb_allowlist';
            |]
 
+from17to18
+  :: ( MonadTx m
+     , HasHttpManager m
+     , HasSQLGenCtx m
+     , CacheRWM m
+     , UserInfoM m
+     , MonadIO m )
+  => m ()
+from17to18 = do
+  Q.Discard () <- liftTx $ Q.multiQE defaultTxErrorHandler
+    $(Q.sqlFromFile "src-rsr/migrate_from_17_to_18.sql")
+  migrateMetadata False
+    $$(Y.decodeFile "src-rsr/migrate_metadata_from_17_to_18.yaml")
+  return ()
+
+migrateToPostgres10 :: m ()
+migrateToPostgres10 = undefined
+
 migrateCatalog
   :: ( MonadTx m
      , CacheRWM m
@@ -335,76 +344,78 @@ migrateCatalog
      , HasHttpManager m
      , HasSQLGenCtx m
      )
-  => UTCTime -> m String
+  => UTCTime -> m Text
 migrateCatalog migrationTime = do
-  preVer <- getCatalogVersion
-  if | preVer == curCatalogVer ->
-         return $ "already at the latest version. current version: "
-                   <> show curCatalogVer
-     | preVer == "0.8" -> from08ToCurrent
-     | preVer == "1"   -> from1ToCurrent
-     | preVer == "2"   -> from2ToCurrent
-     | preVer == "3"   -> from3ToCurrent
-     | preVer == "4"   -> from4ToCurrent
-     | preVer == "5"   -> from5ToCurrent
-     | preVer == "6"   -> from6ToCurrent
-     | preVer == "7"   -> from7ToCurrent
-     | preVer == "8"   -> from8ToCurrent
-     | preVer == "9"   -> from9ToCurrent
-     | preVer == "10"  -> from10ToCurrent
-     | preVer == "11"  -> from11ToCurrent
-     | preVer == "12"  -> from12ToCurrent
-     | preVer == "13"  -> from13ToCurrent
-     | preVer == "14"  -> from14ToCurrent
-     | preVer == "15"  -> from15ToCurrent
-     | preVer == "16"  -> from16ToCurrent
-     | otherwise -> throw400 NotSupported $
-                    "unsupported version : " <> preVer
-  where
-    from16ToCurrent = from16To17 >> postMigrate
-
-    from15ToCurrent = from15To16 >> from16ToCurrent
-
-    from14ToCurrent = from14To15 >> from15ToCurrent
+  (previousSchemaVersion, previousPostgresVersion) <- getPreviousVersions
+  currentPostgresVersion <- liftTx Q.serverVersion
 
-    from13ToCurrent = from13To14 >> from14ToCurrent
+  schemaMessage <- migrateSchema previousSchemaVersion
+  postgresMessage <- migratePostgres previousPostgresVersion currentPostgresVersion
+  let migrateMessages = catMaybes [schemaMessage, postgresMessage]
 
-    from12ToCurrent = from12To13 >> from13ToCurrent
+  if null migrateMessages
+    then return $ "already at the latest schema version. current version: " <> show curCatalogVer
+    else do
+      finalizeMigration currentPostgresVersion
+      return $ "successfully migrated to " <> T.concat (T.intercalate " and " migrateMessages)
 
-    from11ToCurrent = from11To12 >> from12ToCurrent
-
-    from10ToCurrent = from10To11 >> from11ToCurrent
-
-    from9ToCurrent = from9To10 >> from10ToCurrent
-
-    from8ToCurrent = from8To9 >> from9ToCurrent
-
-    from7ToCurrent = from7To8 >> from8ToCurrent
-
-    from6ToCurrent = from6To7 >> from7ToCurrent
-
-    from5ToCurrent = from5To6 >> from6ToCurrent
-
-    from4ToCurrent = from4To5 >> from5ToCurrent
-
-    from3ToCurrent = from3To4 >> from4ToCurrent
-
-    from2ToCurrent = from2To3 >> from3ToCurrent
-
-    from1ToCurrent = from1To2 >> from2ToCurrent
-
-    from08ToCurrent = from08To1 >> from1ToCurrent
-
-    postMigrate = do
+  where
+    migrateSchema previousVersion
+      | previousVersion == curCatalogVer = return Nothing
+      | otherwise = case neededMigrations of
+          [] -> throw400 NotSupported $ "unsupported schema version: " <> previousVersion
+          _ -> do
+            traverse_ snd neededMigrations
+            return . Just $ "schema version " <> T.pack (show curCatalogVer)
+      where
+        neededMigrations = dropWhile ((/= previousVersion) . fst) migrations
+        migrations =
+          [ ("0.8", from08To1)
+          , ("1", from1To2)
+          , ("2", from2To3)
+          , ("3", from3To4)
+          , ("4", from4To5)
+          , ("5", from5To6)
+          , ("6", from6To7)
+          , ("7", from7To8)
+          , ("8", from8To9)
+          , ("9", from9To10)
+          , ("10", from10To11)
+          , ("11", from11To12)
+          , ("12", from12To13)
+          , ("13", from13To14)
+          , ("14", from14To15)
+          , ("15", from15To16)
+          , ("16", from16To17)
+          ]
+
+    migratePostgres previousVersion currentVersion
+      | previousVersion == currentVersion = return Nothing
+      | previousVersion > currentVersion = throw400 NotSupported
+          $ "database was previously used with newer Postgres version "
+          <> "(previous version: " <> T.pack (show previousVersion) ", "
+          <> "current version: " <> T.pack (show currentVersion) ")"
+      | otherwise = do
+          when (previousVersion < 100000 && currentVersion >= 100000)
+            migrateToPostgres10
+          return . Just $ "Postgres version " <> show currentPostgresVersion
+
+    getPreviousVersions =
+      fmap Q.getRow . liftTx $ Q.withQE defaultTxErrorHandler [Q.sql|
+          SELECT version, pg_version FROM hdb_catalog.hdb_version
+      |] () False
+
+    finalizeMigration currentPostgresVersion = do
        -- update the catalog version
-       updateVersion
+       updateVersions
        -- try building the schema cache
        buildSchemaCacheStrict
        return $ "successfully migrated to " ++ show curCatalogVer
 
-    updateVersion =
+    updateVersions currentPostgresVersion =
       liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
-                UPDATE "hdb_catalog"."hdb_version"
-                   SET "version" = $1,
-                       "upgraded_on" = $2
-                    |] (curCatalogVer, migrationTime) False
+        UPDATE "hdb_catalog"."hdb_version"
+           SET "version" = $1,
+               "pg_version" = $2,
+               "upgraded_on" = $3
+      |] (curCatalogVer, currentPostgresVersion, migrationTime) False

server/src-lib/Hasura/Prelude.hs

@@ -16,7 +16,7 @@ import           Control.Monad.State.Strict as M
 import           Data.Bool                  as M (bool)
 import           Data.Either                as M (lefts, partitionEithers,
                                                   rights)
-import           Data.Foldable              as M (foldrM, toList)
+import           Data.Foldable              as M (foldrM, toList, traverse_)
 import           Data.Functor               as M (($>), (<&>))
 import           Data.Hashable              as M (Hashable)
 import           Data.List                  as M (find, foldl', group,

server/src-rsr/migrate_from_17_to_18.sql

@@ -0,0 +1,26 @@
+ALTER TABLE hdb_catalog.hdb_version
+  ADD COLUMN pg_version text NULL
+  ADD COLUMN pg_upgraded_on timestamptz NULL;
+
+CREATE VIEW hdb_catalog.hdb_columns_ordinary_default_values AS
+  SELECT table_schema::text, table_name::text, column_name::text, column_default::text
+    FROM information_schema.columns
+    WHERE column_default IS NOT NULL;
+
+-- Same as hdb_columns_ordinary_default_values on versions of Postgres <10, but
+-- includes identity columns on Postgres >=10.
+CREATE VIEW hdb_catalog.hdb_columns_default_values AS
+  SELECT * FROM hdb_catalog.hdb_columns_ordinary_default_values;
+
+CREATE OR REPLACE FUNCTION
+  hdb_catalog.inject_table_defaults(view_schema text, view_name text, tab_schema text, tab_name text) RETURNS void
+LANGUAGE plpgsql AS $$
+  DECLARE
+    r RECORD;
+  BEGIN
+    FOR r IN SELECT column_name, column_default
+               FROM hdb_catalog.hdb_columns_default_values
+              WHERE table_schema = tab_schema AND table_name = tab_name
+      EXECUTE format('ALTER VIEW %I.%I ALTER COLUMN %I SET DEFAULT %s;', view_schema, view_name, r.column_name, r.column_default);
+    END LOOP;
+  END $$;

server/src-rsr/migrate_to_pg10.sql

@@ -0,0 +1,28 @@
+-- Postgres 10 identity columns (i.e. those created with GENERATED BY DEFAULT AS IDENTITY) don’t have
+-- ordinary default values (as reported by information_schema.columns.column_default), but we still
+-- need them for the purposes of hdb_catalog.inject_table_defaults.
+--
+-- Internally, generated columns are backed by ordinary sequences. This view exposes them using the
+-- same interface as information_schema.
+CREATE VIEW hdb_catalog.hdb_columns_identity_default_values AS
+  SELECT table_schema.nspname::text AS table_schema
+       , table_class.relname::text AS table_name
+       , identity_column.attname::text AS column_name
+       , format('nextval(%L::regclass)', sequence.seqrelid::regclass)::text AS column_default
+    FROM pg_sequence sequence
+    JOIN pg_depend depend
+          ON depend.classid = 'pg_class'::regclass
+         AND depend.refclassid = 'pg_class'::regclass
+         AND depend.objid = sequence.seqrelid
+         AND depend.deptype = 'i'
+    JOIN pg_attribute identity_column
+          ON identity_column.attrelid = depend.refobjid
+         AND identity_column.attnum = depend.refobjsubid
+    JOIN pg_class table_class ON table_class.oid = identity_column.attrelid
+    JOIN pg_namespace table_schema ON table_schema.oid = table_class.relnamespace;
+
+CREATE OR REPLACE VIEW hdb_catalog.hdb_columns_default_values
+     AS SELECT * FROM hdb_catalog.hdb_columns_ordinary_default_values
+  UNION SELECT * FROM hdb_catalog.hdb_columns_identity_default_values;
+
+-- TODO: Refresh any views that depend on tables with identity columns.