src/MyWebLog.Data/PostgresData.fs

@@ -159,14 +159,28 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
         exit 1
     }
 
+    /// Migrate from v2 to v2.1
+    let migrateV2ToV2point1 () = backgroundTask {
+        Utils.logMigrationStep log "v2 to v2.1" "Adding empty redirect rule set to all weblogs"
+        do! Custom.nonQuery $"UPDATE {Table.WebLog} SET data['RedirectRules'] = '[]'::json" []
+
+        Utils.logMigrationStep log "v2 to v2.1" "Setting database to version 2.1"
+        do! setDbVersion "v2.1"
+    }
+
     /// Do required data migration between versions
     let migrate version = backgroundTask {
-        match version with
+        let mutable v = defaultArg version ""
-        | Some "v2" -> ()
+
-        | Some "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+        if v = "v2-rc2" then 
-        // Future versions will be inserted here
+            do! migrateV2Rc2ToV2 ()
-        | Some _
+            v <- "v2"
-        | None ->
+        
+        if v = "v2" then
+            do! migrateV2ToV2point1 ()
+            v <- "v2.1"
+        
+        if v <> "v2.1" then
             log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
             do! setDbVersion Utils.currentDbVersion
     }
@@ -190,8 +204,5 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
             do! ensureTables ()
             
             let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
-            match version with
+            do! migrate version
-            | Some v when v = Utils.currentDbVersion -> ()
-            | Some _
-            | None -> do! migrate version 
         }

src/MyWebLog.Data/RethinkDbData.fs

@@ -221,16 +221,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
         do! setDbVersion "v2"
     }
 
+    /// Migrate from v2 to v2.1
+    let migrateV2ToV2point1 () = backgroundTask {
+        Utils.logMigrationStep log "v2 to v2.1" "Adding empty redirect rule set to all weblogs"
+        do! rethink {
+            withTable Table.WebLog
+            update [ nameof WebLog.empty.RedirectRules, [] ]
+            write; withRetryOnce; ignoreResult conn
+        }
+        
+        Utils.logMigrationStep log "v2 to v2.1" "Setting database version to v2.1"
+        do! setDbVersion "v2.1"
+    }
+    
     /// Migrate data between versions
     let migrate version = backgroundTask {
-        match version with
+        let mutable v = defaultArg version ""
-        | Some v when v = "v2" -> ()
+        
-        | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+        if v = "v2-rc1" then
-        | Some v when v = "v2-rc1" ->
             do! migrateV2Rc1ToV2Rc2 ()
+            v <- "v2-rc2"
+
+        if v = "v2-rc2" then
             do! migrateV2Rc2ToV2 ()
-        | Some _
+            v <- "v2"
-        | None ->
+        
+        if v = "v2" then
+            do! migrateV2ToV2point1 ()
+            v <- "v2.1"
+        
+        if v <> "v2.1" then
             log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
             do! setDbVersion Utils.currentDbVersion
     }
@@ -1185,7 +1205,5 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                  limit 1
                  result; withRetryOnce conn
             }
-            match List.tryHead version with
+            do! migrate (List.tryHead version |> Option.map (fun x -> x.Id))
-            | Some v when v.Id = "v2-rc2" -> ()
-            | it -> do! migrate (it |> Option.map (fun x -> x.Id))
         }

src/MyWebLog.Data/SQLite/Helpers.fs

@@ -271,7 +271,7 @@ module Map =
         }
     
     /// Create a web log from the current row in the given data reader
-    let toWebLog rdr : WebLog =
+    let toWebLog ser rdr : WebLog =
         {   Id            = getString  "id"             rdr |> WebLogId
             Name          = getString  "name"           rdr
             Slug          = getString  "slug"           rdr
@@ -292,6 +292,7 @@ module Map =
                 Copyright         = tryString  "copyright"           rdr
                 CustomFeeds       = []
             }
+            RedirectRules = getString "redirect_rules" rdr |> Utils.deserialize ser
         }
     
     /// Create a web log user from the current row in the given data reader

src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs

@@ -37,6 +37,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
             cmd.Parameters.AddWithValue ("@timeZone",      webLog.TimeZone)
             cmd.Parameters.AddWithValue ("@autoHtmx",      webLog.AutoHtmx)
             cmd.Parameters.AddWithValue ("@uploads",       UploadDestination.toString webLog.Uploads)
+            cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
         ] |> ignore
         addWebLogRssParameters cmd webLog
     
@@ -129,10 +130,12 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
         cmd.CommandText <-
             "INSERT INTO web_log (
                 id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
-                uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
+                uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright,
+                redirect_rules
             ) VALUES (
                 @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
-                @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
+                @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright,
+                @redirectRules
             )"
         addWebLogParameters cmd webLog
         do! write cmd
@@ -145,7 +148,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
         cmd.CommandText <- "SELECT * FROM web_log"
         use! rdr = cmd.ExecuteReaderAsync ()
         let! webLogs =
-            toList Map.toWebLog rdr
+            toList (Map.toWebLog ser) rdr
             |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
             |> Task.WhenAll
         return List.ofArray webLogs
@@ -184,7 +187,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
         cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
         use! rdr = cmd.ExecuteReaderAsync ()
         if rdr.Read () then
-            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
+            let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
             return Some webLog
         else
             return None
@@ -197,7 +200,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
         addWebLogId cmd webLogId
         use! rdr = cmd.ExecuteReaderAsync ()
         if rdr.Read () then
-            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
+            let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
             return Some webLog
         else
             return None
@@ -223,7 +226,8 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
                     items_in_feed       = @itemsInFeed,
                     is_category_enabled = @isCategoryEnabled,
                     is_tag_enabled      = @isTagEnabled,
-                    copyright           = @copyright
+                    copyright           = @copyright,
+                    redirect_rules      = @redirectRules
               WHERE id = @id"
         addWebLogParameters cmd webLog
         do! write cmd

src/MyWebLog.Data/SQLiteData.fs

@@ -65,7 +65,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
                     items_in_feed        INTEGER,
                     is_category_enabled  INTEGER NOT NULL DEFAULT 0,
                     is_tag_enabled       INTEGER NOT NULL DEFAULT 0,
-                    copyright            TEXT);
+                    copyright            TEXT,
+                    redirect_rules       TEXT NOT NULL DEFAULT '[]');
                 CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
             if needsTable "web_log_feed" then
                 "CREATE TABLE web_log_feed (
@@ -535,15 +536,34 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
         do! setDbVersion "v2"
     }
 
+    /// Migrate from v2 to v2.1
+    let migrateV2ToV2point1 () = backgroundTask {
+        Utils.logMigrationStep log "v2 to v2.1" "Adding redirect rules to web_log table"
+        use cmd = conn.CreateCommand ()
+        cmd.CommandText <- "ALTER TABLE web_log ADD COLUMN redirect_rules TEXT NOT NULL DEFAULT '[]'"
+        do! write cmd
+
+        Utils.logMigrationStep log "v2 to v2.1" "Setting database version to v2.1"
+        do! setDbVersion "v2.1"
+    }
+
     /// Migrate data among versions (up only)
     let migrate version = backgroundTask {
+        let mutable v = defaultArg version ""
 
-        match version with
+        if v = "v2-rc1" then
-        | Some v when v = "v2" -> ()
+            do! migrateV2Rc1ToV2Rc2 ()
-        | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+            v <- "v2-rc2"
-        | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
+        
-        | Some _
+        if v = "v2-rc2" then
-        | None ->
+            do! migrateV2Rc2ToV2 ()
+            v <- "v2"
+        
+        if v = "v2" then
+            do! migrateV2ToV2point1 ()
+            v <- "v2.1"
+        
+        if v <> "v2.1" then
             log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
             do! setDbVersion Utils.currentDbVersion
     }
@@ -580,9 +600,5 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
             use cmd = conn.CreateCommand ()
             cmd.CommandText <- "SELECT id FROM db_version"
             use! rdr = cmd.ExecuteReaderAsync ()
-            let version = if rdr.Read () then Some (Map.getString "id" rdr) else None
+            do! migrate (if rdr.Read () then Some (Map.getString "id" rdr) else None)
-            match version with
-            | Some v when v = "v2-rc2" -> ()
-            | Some _
-            | None -> do! migrate version
         }

src/MyWebLog.Data/Utils.fs

@@ -6,7 +6,7 @@ open MyWebLog
 open MyWebLog.ViewModels
 
 /// The current database version
-let currentDbVersion = "v2"
+let currentDbVersion = "v2.1"
 
 /// Create a category hierarchy from the given list of categories
 let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {

src/MyWebLog.Domain/DataTypes.fs

@@ -375,6 +375,9 @@ type WebLog =
         
         /// Where uploads are placed
         Uploads : UploadDestination
+
+        /// Redirect rules for this weblog
+        RedirectRules : RedirectRule list
     }
 
 /// Functions to support web logs
@@ -394,6 +397,7 @@ module WebLog =
             Rss           = RssOptions.empty
             AutoHtmx      = false
             Uploads       = Database
+            RedirectRules = []
         }
     
     /// Get the host (including scheme) and extra path from the URL base

src/MyWebLog.Domain/SupportTypes.fs

@@ -422,6 +422,17 @@ module PostId =
     let create () = PostId (newId ())
 
 
+/// A redirection for a previously valid URL
+type RedirectRule =
+    {   /// The From string or pattern
+        From : string
+        /// The To string or pattern
+        To : string
+        /// Whether to use regular expressions on this rule
+        IsRegex : bool
+    }
+
+
 /// An identifier for a custom feed
 type CustomFeedId = CustomFeedId of string