Version 2.1 #41
@ -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
|
||||
}
|
||||
|
@ -220,17 +220,37 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
Utils.logMigrationStep log "v2-rc2 to v2" "Setting database version; no migration required"
|
||||
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))
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 ""
|
||||
|
||||
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<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)
|
||||
}
|
||||
|
@ -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 {
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user