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
}
/// 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<PostgresData>, 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
}

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"
}
/// 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
| Some v when v = "v2" -> ()
| 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<R
limit 1
result; withRetryOnce conn
}
match List.tryHead version with
| Some v when v.Id = "v2-rc2" -> ()
| it -> do! migrate (it |> Option.map (fun x -> x.Id))
do! migrate (List.tryHead version |> Option.map (fun x -> x.Id))
}

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

@ -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

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

@ -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

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,
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
| 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-rc1" then
do! migrateV2Rc1ToV2Rc2 ()
v <- "v2-rc2"
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<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
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)
}

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

@ -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 {

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

@ -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

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

@ -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