From 2f8ec5a54bc05fc8d0e4e4b6d7988ecbac42d411 Mon Sep 17 00:00:00 2001
From: "Daniel J. Summers" <daniel@bitbadger.solutions>
Date: Sun, 21 Aug 2022 15:50:34 -0400
Subject: [PATCH] Punt RethinkDB migration

- Backup/restore works; otherwise, it would have required near full replacement of several document types. Backup/restore is well-tested and less error-prone.
---
 src/MyWebLog.Data/RethinkDbData.fs  | 44 +++++++++++++++++++++--------
 src/MyWebLog.Data/SQLiteData.fs     |  8 ++----
 src/MyWebLog.Data/Utils.fs          |  6 ++++
 src/MyWebLog.Domain/SupportTypes.fs |  5 ++++
 4 files changed, 46 insertions(+), 17 deletions(-)

diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs
index beefab9..c5d7d91 100644
--- a/src/MyWebLog.Data/RethinkDbData.fs
+++ b/src/MyWebLog.Data/RethinkDbData.fs
@@ -84,10 +84,6 @@ module private RethinkHelpers =
     
     /// Cast a strongly-typed list to an object list
     let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj)
-    
-    /// A simple type for the database version table
-    [<CLIMutable; NoComparison; NoEquality>]
-    type DbVersion = { Id : string }
 
 
 open System
@@ -204,11 +200,32 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
         }
         do! rethink {
             withTable Table.DbVersion
-            insert { Id = version }
+            insert {| Id = version |}
             write; withRetryOnce; ignoreResult conn
         }
     }
     
+    /// Migrate from v2-rc1 to v2-rc2
+    let migrateV2Rc1ToV2Rc2 () = backgroundTask {
+        let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
+        logStep "**IMPORTANT**"
+        logStep "See release notes about required backup/restoration for RethinkDB."
+        logStep "If there is an error immediately below this message, this is why."
+        logStep "Setting database version to v2-rc2"
+        do! setDbVersion "v2-rc2"
+    }
+    
+    /// Migrate data between versions
+    let migrate version = backgroundTask {
+        match version with
+        | Some v when v = "v2-rc2" -> ()
+        | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
+        | Some _
+        | None ->
+            log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
+            do! setDbVersion Utils.currentDbVersion
+    }
+    
     /// The connection for this instance
     member _.Conn = conn
     
@@ -1138,6 +1155,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     log.LogInformation $"Creating table {tbl}..."
                     do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
 
+            if not (List.contains Table.DbVersion tables) then
+                // Version table added in v2-rc2; this will flag that migration to be run
+                do! rethink {
+                    withTable Table.DbVersion
+                    insert {| Id = "v2-rc1" |}
+                    write; withRetryOnce; ignoreResult conn
+                }
+            
             do! ensureIndexes Table.Category   [ nameof Category.empty.WebLogId ]
             do! ensureIndexes Table.Comment    [ nameof Comment.empty.PostId ]
             do! ensureIndexes Table.Page       [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
@@ -1147,15 +1172,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
             do! ensureIndexes Table.WebLog     [ nameof WebLog.empty.UrlBase ]
             do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
             
-            let! version = rethink<DbVersion list> {
+            let! version = rethink<{| Id : string |} list> {
                  withTable Table.DbVersion
+                 limit 1
                  result; withRetryOnce conn
             }
             match List.tryHead version with
             | Some v when v.Id = "v2-rc2" -> ()
-            // Future migrations will be checked here
-            | Some _
-            | None ->
-                log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
-                do! setDbVersion Utils.currentDbVersion
+            | it -> do! migrate (it |> Option.map (fun x -> x.Id))
         }
diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs
index 7b732c6..3b33874 100644
--- a/src/MyWebLog.Data/SQLiteData.fs
+++ b/src/MyWebLog.Data/SQLiteData.fs
@@ -228,13 +228,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
         do! write cmd
     }
     
-    /// Log a migration step
-    let logMigrationStep migration message =
-        log.LogInformation $"Migrating %s{migration}: %s{message}"
-    
     /// Implement the changes between v2-rc1 and v2-rc2
     let migrateV2Rc1ToV2Rc2 () = backgroundTask {
-        let logStep = logMigrationStep "v2-rc1 to v2-rc2"
+        let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
         // Move meta items, podcast settings, and episode details to JSON-encoded text fields
         use cmd = conn.CreateCommand ()
         logStep "Adding new columns"
@@ -529,7 +525,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
              DROP TABLE web_log_feed_podcast"
         do! write cmd
         
-        logStep "Setting database version"
+        logStep "Setting database version to v2-rc2"
         do! setDbVersion "v2-rc2"
     }
     
diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs
index fcc3584..59ad5dc 100644
--- a/src/MyWebLog.Data/Utils.fs
+++ b/src/MyWebLog.Data/Utils.fs
@@ -50,3 +50,9 @@ let serialize<'T> ser (item : 'T) =
 /// Deserialize a JSON string 
 let deserialize<'T> (ser : JsonSerializer) value =
     JsonConvert.DeserializeObject<'T> (value, Json.settings ser)
+
+open Microsoft.Extensions.Logging
+
+/// Log a migration step
+let logMigrationStep<'T> (log : ILogger<'T>) migration message =
+    log.LogInformation $"Migrating %s{migration}: %s{message}"
diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs
index 49bb09c..4753583 100644
--- a/src/MyWebLog.Domain/SupportTypes.fs
+++ b/src/MyWebLog.Domain/SupportTypes.fs
@@ -22,6 +22,7 @@ module Noda =
     /// The Unix epoch
     let epoch = Instant.FromUnixTimeSeconds 0L
     
+        
     /// Truncate an instant to remove fractional seconds
     let toSecondsPrecision (value : Instant) =
         Instant.FromUnixTimeSeconds (value.ToUnixTimeSeconds ())
@@ -29,6 +30,10 @@ module Noda =
     /// The current Instant, with fractional seconds truncated
     let now () =
         toSecondsPrecision (clock.GetCurrentInstant ())
+    
+    /// Convert a date/time to an Instant with whole seconds
+    let fromDateTime (dt : DateTime) =
+        toSecondsPrecision (Instant.FromDateTimeUtc (DateTime (dt.Ticks, DateTimeKind.Utc)))
 
 
 /// A user's access level