diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 58967d5..66ee047 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -159,14 +159,28 @@ type PostgresData (log : ILogger, 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 - | Some "v2" -> () - | Some "v2-rc2" -> do! migrateV2Rc2ToV2 () - // Future versions will be inserted here - | Some _ - | None -> + let mutable v = defaultArg version "" + + if v = "v2-rc2" then + 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 } @@ -190,8 +204,5 @@ type PostgresData (log : ILogger, ser : JsonSerializer) = do! ensureTables () let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id") - match version with - | Some v when v = Utils.currentDbVersion -> () - | Some _ - | None -> do! migrate version + do! migrate version } diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 9cf340e..7c318a9 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -220,17 +220,37 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger () - | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 () - | Some v when v = "v2-rc1" -> + let mutable v = defaultArg version "" + + if v = "v2-rc1" then do! migrateV2Rc1ToV2Rc2 () + v <- "v2-rc2" + + if v = "v2-rc2" then do! migrateV2Rc2ToV2 () - | Some _ - | None -> + 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 } @@ -1185,7 +1205,5 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger () - | it -> do! migrate (it |> Option.map (fun x -> x.Id)) + do! migrate (List.tryHead version |> Option.map (fun x -> x.Id)) } diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 150085f..5224674 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -271,19 +271,19 @@ module Map = } /// Create a web log from the current row in the given data reader - let toWebLog rdr : WebLog = - { Id = getString "id" rdr |> WebLogId - Name = getString "name" rdr - Slug = getString "slug" rdr - Subtitle = tryString "subtitle" rdr - DefaultPage = getString "default_page" rdr - PostsPerPage = getInt "posts_per_page" rdr - ThemeId = getString "theme_id" rdr |> ThemeId - UrlBase = getString "url_base" rdr - TimeZone = getString "time_zone" rdr - AutoHtmx = getBoolean "auto_htmx" rdr - Uploads = getString "uploads" rdr |> UploadDestination.parse - Rss = { + let toWebLog ser rdr : WebLog = + { Id = getString "id" rdr |> WebLogId + Name = getString "name" rdr + Slug = getString "slug" rdr + Subtitle = tryString "subtitle" rdr + DefaultPage = getString "default_page" rdr + PostsPerPage = getInt "posts_per_page" rdr + ThemeId = getString "theme_id" rdr |> ThemeId + UrlBase = getString "url_base" rdr + TimeZone = getString "time_zone" rdr + AutoHtmx = getBoolean "auto_htmx" rdr + Uploads = getString "uploads" rdr |> UploadDestination.parse + Rss = { IsFeedEnabled = getBoolean "is_feed_enabled" rdr FeedName = getString "feed_name" rdr ItemsInFeed = tryInt "items_in_feed" 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 diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index aa34719..1bcfbb1 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -26,17 +26,18 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) = /// Add parameters for web log INSERT or UPDATE statements let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) - cmd.Parameters.AddWithValue ("@name", webLog.Name) - cmd.Parameters.AddWithValue ("@slug", webLog.Slug) - cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) - cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) - cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) - cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) - cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) - cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) - cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) - cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) + [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) + cmd.Parameters.AddWithValue ("@name", webLog.Name) + cmd.Parameters.AddWithValue ("@slug", webLog.Slug) + cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) + cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) + cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) + cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) + cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) + 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 diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 6133eb1..89caa0c 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -65,7 +65,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger, 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, 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 "" + + if v = "v2-rc1" then + do! migrateV2Rc1ToV2Rc2 () + v <- "v2-rc2" - match version with - | Some v when v = "v2" -> () - | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 () - | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 () - | Some _ - | None -> + if v = "v2-rc2" then + 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, 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 - match version with - | Some v when v = "v2-rc2" -> () - | Some _ - | None -> do! migrate version + do! migrate (if rdr.Read () then Some (Map.getString "id" rdr) else None) } diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index 9f08592..c241a65 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/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 { diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 87b9a1c..c547389 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/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 @@ -382,18 +385,19 @@ module WebLog = /// An empty web log let empty = - { Id = WebLogId.empty - Name = "" - Slug = "" - Subtitle = None - DefaultPage = "" - PostsPerPage = 10 - ThemeId = ThemeId "default" - UrlBase = "" - TimeZone = "" - Rss = RssOptions.empty - AutoHtmx = false - Uploads = Database + { Id = WebLogId.empty + Name = "" + Slug = "" + Subtitle = None + DefaultPage = "" + PostsPerPage = 10 + ThemeId = ThemeId "default" + UrlBase = "" + TimeZone = "" + Rss = RssOptions.empty + AutoHtmx = false + Uploads = Database + RedirectRules = [] } /// Get the host (including scheme) and extra path from the URL base diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 4753583..4a525c7 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/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