bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

Add redirect rule to data stores (#39)

Browse Source
This commit is contained in:
Daniel J. Summers 2023-07-28 20:28:03 -04:00
parent ab9f2f577b
commit 42d3280f67
8 changed files with 139 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/MyWebLog.Data/PostgresData.fs
View File

@ -159,14 +159,28 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
exit 1 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 /// Do required data migration between versions
let migrate version = backgroundTask { 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}" log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion do! setDbVersion Utils.currentDbVersion
} }
@ -190,8 +204,5 @@ type PostgresData (log : ILogger<PostgresData>, ser : JsonSerializer) =
do! ensureTables () do! ensureTables ()
let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id") 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
} }

36
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -221,16 +221,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! setDbVersion "v2" 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 /// Migrate data between versions
let migrate version = backgroundTask { 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 () do! migrateV2Rc1ToV2Rc2 ()
v <- "v2-rc2"
if v = "v2-rc2" then
do! migrateV2Rc2ToV2 () 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}" log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion do! setDbVersion Utils.currentDbVersion
} }
@ -1185,7 +1205,5 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
limit 1 limit 1
result; withRetryOnce conn 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))
} }

27
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -271,19 +271,19 @@ module Map =
} }
/// Create a web log from the current row in the given data reader /// 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 { Id = getString "id" rdr |> WebLogId
Name = getString "name" rdr Name = getString "name" rdr
Slug = getString "slug" rdr Slug = getString "slug" rdr
Subtitle = tryString "subtitle" rdr Subtitle = tryString "subtitle" rdr
DefaultPage = getString "default_page" rdr DefaultPage = getString "default_page" rdr
PostsPerPage = getInt "posts_per_page" rdr PostsPerPage = getInt "posts_per_page" rdr
ThemeId = getString "theme_id" rdr |> ThemeId ThemeId = getString "theme_id" rdr |> ThemeId
UrlBase = getString "url_base" rdr UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.parse Uploads = getString "uploads" rdr |> UploadDestination.parse
Rss = { Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr FeedName = getString "feed_name" rdr
ItemsInFeed = tryInt "items_in_feed" rdr ItemsInFeed = tryInt "items_in_feed" rdr
@ -292,6 +292,7 @@ module Map =
Copyright = tryString "copyright" rdr Copyright = tryString "copyright" rdr
CustomFeeds = [] CustomFeeds = []
} }
RedirectRules = getString "redirect_rules" rdr |> Utils.deserialize ser
} }
/// Create a web log user from the current row in the given data reader /// Create a web log user from the current row in the given data reader

38
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@ -26,17 +26,18 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
/// Add parameters for web log INSERT or UPDATE statements /// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name) cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug) cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
] |> ignore ] |> ignore
addWebLogRssParameters cmd webLog addWebLogRssParameters cmd webLog
@ -129,10 +130,12 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
cmd.CommandText <- cmd.CommandText <-
"INSERT INTO web_log ( "INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, 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 ( ) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, @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 addWebLogParameters cmd webLog
do! write cmd do! write cmd
@ -145,7 +148,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
cmd.CommandText <- "SELECT * FROM web_log" cmd.CommandText <- "SELECT * FROM web_log"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! webLogs = let! webLogs =
toList Map.toWebLog rdr toList (Map.toWebLog ser) rdr
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog }) |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|> Task.WhenAll |> Task.WhenAll
return List.ofArray webLogs return List.ofArray webLogs
@ -184,7 +187,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr) let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
return Some webLog return Some webLog
else else
return None return None
@ -197,7 +200,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
addWebLogId cmd webLogId addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr) let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
return Some webLog return Some webLog
else else
return None return None
@ -223,7 +226,8 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
items_in_feed = @itemsInFeed, items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled, is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled, is_tag_enabled = @isTagEnabled,
copyright = @copyright copyright = @copyright,
redirect_rules = @redirectRules
WHERE id = @id" WHERE id = @id"
addWebLogParameters cmd webLog addWebLogParameters cmd webLog
do! write cmd do! write cmd

40
src/MyWebLog.Data/SQLiteData.fs
View File

@ -65,7 +65,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
items_in_feed INTEGER, items_in_feed INTEGER,
is_category_enabled INTEGER NOT NULL DEFAULT 0, is_category_enabled INTEGER NOT NULL DEFAULT 0,
is_tag_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)" CREATE INDEX web_log_theme_idx ON web_log (theme_id)"
if needsTable "web_log_feed" then if needsTable "web_log_feed" then
"CREATE TABLE web_log_feed ( "CREATE TABLE web_log_feed (
@ -535,15 +536,34 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
do! setDbVersion "v2" 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) /// Migrate data among versions (up only)
let migrate version = backgroundTask { 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}" log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
do! setDbVersion Utils.currentDbVersion do! setDbVersion Utils.currentDbVersion
} }
@ -580,9 +600,5 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT id FROM db_version" cmd.CommandText <- "SELECT id FROM db_version"
use! rdr = cmd.ExecuteReaderAsync () 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
} }

2
src/MyWebLog.Data/Utils.fs
View File

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

28
src/MyWebLog.Domain/DataTypes.fs
View File

@ -375,6 +375,9 @@ type WebLog =
/// Where uploads are placed /// Where uploads are placed
Uploads : UploadDestination Uploads : UploadDestination
/// Redirect rules for this weblog
RedirectRules : RedirectRule list
} }
/// Functions to support web logs /// Functions to support web logs
@ -382,18 +385,19 @@ module WebLog =
/// An empty web log /// An empty web log
let empty = let empty =
{ Id = WebLogId.empty { Id = WebLogId.empty
Name = "" Name = ""
Slug = "" Slug = ""
Subtitle = None Subtitle = None
DefaultPage = "" DefaultPage = ""
PostsPerPage = 10 PostsPerPage = 10
ThemeId = ThemeId "default" ThemeId = ThemeId "default"
UrlBase = "" UrlBase = ""
TimeZone = "" TimeZone = ""
Rss = RssOptions.empty Rss = RssOptions.empty
AutoHtmx = false AutoHtmx = false
Uploads = Database Uploads = Database
RedirectRules = []
} }
/// Get the host (including scheme) and extra path from the URL base /// Get the host (including scheme) and extra path from the URL base

11
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -422,6 +422,17 @@ module PostId =
let create () = PostId (newId ()) 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 /// An identifier for a custom feed
type CustomFeedId = CustomFeedId of string type CustomFeedId = CustomFeedId of string