From ea95d74cb5572688531ba0fdeed3983fb70ab236 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Wed, 14 Oct 2020 16:24:21 +0200
Subject: [PATCH] fix(migration): don't consider changelog in requiresMigration

---
 src/Model/Migration.hs | 43 ++++++++++++++++++++++--------------------
 1 file changed, 23 insertions(+), 20 deletions(-)

diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index a1fe221e1..4c0b6ea0b 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -110,6 +110,9 @@ migrateAll = do
   $logDebugS "Migration" "Persistent automatic migration"
   mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAll'
 
+  $logDebugS "Migration" "Migrations marked as ‘always safe’"
+  mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAlwaysSafe
+
 requiresMigration :: forall m.
                      ( MonadLogger m
                      , MonadResource m
@@ -131,6 +134,8 @@ requiresMigration = mapReaderT (exceptT return return) $ do
     $logInfoS "Migration" $ intercalate "; " automatic
     throwError True
 
+  -- Does not consider `migrateAlwaysSafe`
+
   return False
 
 initialMigration :: Migration
@@ -172,19 +177,6 @@ migrateManual = do
     , ("user_ldap_primary_key",               "CREATE INDEX user_ldap_primary_key ON \"user\" (ldap_primary_key)"                        )
     , ("file_content_entry_chunk_hash",       "CREATE INDEX file_content_entry_chunk_hash ON \"file_content_entry\" (chunk_hash)"        )
     ]
-
-  recordedChangelogItems <- lift . lift $ selectList [ ChangelogItemFirstSeenItem <-. universeF ] []
-  let missingChangelogItems = Set.toList $ Set.fromList universeF `Set.difference` recordedChangelogItems'
-        where recordedChangelogItems' = Set.fromList [ changelogItemFirstSeenItem | Entity _ ChangelogItemFirstSeen{..} <- recordedChangelogItems ]
-  unless (null missingChangelogItems) $ do
-    now <- iso8601Show . localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
-    addMigration False $
-      let sql = [st|INSERT INTO changelog_item_first_seen (item, first_seen) VALUES #{vals}|]
-          vals = Text.intercalate ", " $ do
-            item <- missingChangelogItems
-            return [st|('#{toPathPiece item}', '#{now}')|]
-       in sql
-
   where
     addIndex :: Text -> Sql -> Migration
     addIndex ixName ixDef = do
@@ -194,6 +186,23 @@ migrateManual = do
         _other -> return True
       unless alreadyDefined $ addMigration False ixDef
 
+migrateAlwaysSafe :: Migration
+-- | Part of `migrateAll` but not checked in `requiresMigration`
+migrateAlwaysSafe = do
+  recordedChangelogItems <- lift . lift $ selectList [ ChangelogItemFirstSeenItem <-. universeF ] []
+  let missingChangelogItems = Set.toList $ Set.fromList universeF `Set.difference` recordedChangelogItems'
+        where recordedChangelogItems' = Set.fromList [ changelogItemFirstSeenItem | Entity _ ChangelogItemFirstSeen{..} <- recordedChangelogItems ]
+  unless (null missingChangelogItems) $ do
+    now <- iso8601Show . localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
+    addMigration False $ do
+      let sql = [st|INSERT INTO changelog_item_first_seen (item, first_seen) VALUES #{vals}|]
+          vals = Text.intercalate ", " $ do
+            item <- missingChangelogItems
+            let itemDay = case Map.lookup item changelogItemDays of
+                  Just d  -> iso8601Show d
+                  Nothing -> now
+            return [st|('#{toPathPiece item}', '#{itemDay}')|]
+       in sql
 
 {-
   Confusion about quotes, from the PostgreSQL Manual:
@@ -979,13 +988,7 @@ customMigrations = Map.fromListWith (>>)
           |]
     )
   , ( AppliedMigrationKey [migrationVersion|42.0.0|] [version|43.0.0|]
-    , unlessM (tableExists "changelog_item_first_seen") $ do
-        [executeQQ|
-          CREATE TABLE "changelog_item_first_seen" (PRIMARY KEY ("item"), "item" VARCHAR NOT NULL, "first_seen" DATE NOT NULL);
-        |]
-        insertMany_ [ ChangelogItemFirstSeen{..}
-                    | (changelogItemFirstSeenItem, changelogItemFirstSeenFirstSeen) <- Map.toList changelogItemDays
-                    ]
+    , return () -- Unused; used to create and fill `ChangelogItemFirstSeen`
     )
   ]