Move OpenGraph property generation to models (#52)

- Add auto-OpenGraph field to web log
- Only generate properties for posts/pages without them if this flag is set
- Set flag to yes on v3 database migration
- Add JSON converter for OpenGraph type
- Add tests for models
This commit is contained in:
2025-07-10 23:03:16 -04:00
parent 210dd41cee
commit 3ad6b5a521
17 changed files with 799 additions and 293 deletions
+9
View File
@@ -65,6 +65,14 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value
/// <summary>Converter for the <see cref="OpenGraphType" /> type</summary>
type OpenGraphTypeConverter() =
inherit JsonConverter<OpenGraphType>()
override _.WriteJson(writer: JsonWriter, value: OpenGraphType, _: JsonSerializer) =
writer.WriteValue(string value)
override _.ReadJson(reader: JsonReader, _: Type, _: OpenGraphType, _: bool, _: JsonSerializer) =
(string >> OpenGraphType.Parse) reader.Value
/// <summary>Converter for the <see cref="Permalink" /> type</summary>
type PermalinkConverter() =
inherit JsonConverter<Permalink>()
@@ -159,6 +167,7 @@ module Json =
CustomFeedSourceConverter()
ExplicitRatingConverter()
MarkupTextConverter()
OpenGraphTypeConverter()
PermalinkConverter()
PageIdConverter()
PodcastMediumConverter()
+41 -29
View File
@@ -10,17 +10,17 @@ open Npgsql.FSharp
/// Data implementation for PostgreSQL
type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
/// Create any needed tables
let ensureTables () = backgroundTask {
// Set up the PostgreSQL document store
Configuration.useSerializer (Utils.createDocumentSerializer ser)
let! tables =
Custom.list
"SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables)
let sql = seq {
// Theme tables
if needsTable Table.Theme then
@@ -33,25 +33,25 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))"
// Web log table
if needsTable Table.WebLog then
Query.Definition.ensureTable Table.WebLog
Query.Definition.ensureKey Table.WebLog PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLog Optimized
// Category table
if needsTable Table.Category then
Query.Definition.ensureTable Table.Category
Query.Definition.ensureKey Table.Category PostgreSQL
Query.Definition.ensureDocumentIndex Table.Category Optimized
// Web log user table
if needsTable Table.WebLogUser then
Query.Definition.ensureTable Table.WebLogUser
Query.Definition.ensureKey Table.WebLogUser PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
// Page tables
if needsTable Table.Page then
Query.Definition.ensureTable Table.Page
@@ -65,7 +65,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))"
// Post tables
if needsTable Table.Post then
Query.Definition.ensureTable Table.Post
@@ -90,13 +90,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
Query.Definition.ensureTable Table.PostComment
Query.Definition.ensureKey Table.PostComment PostgreSQL
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL
// Tag map table
if needsTable Table.TagMap then
Query.Definition.ensureTable Table.TagMap
Query.Definition.ensureKey Table.TagMap PostgreSQL
Query.Definition.ensureDocumentIndex Table.TagMap Optimized
// Uploaded file table
if needsTable Table.Upload then
$"CREATE TABLE {Table.Upload} (
@@ -107,13 +107,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
data BYTEA NOT NULL)"
$"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)"
$"CREATE INDEX idx_upload_path ON {Table.Upload} (web_log_id, path)"
// Database version table
if needsTable Table.DbVersion then
$"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
}
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync
@@ -128,13 +128,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|> Async.RunSynchronously
|> ignore
}
/// Set a specific database version
let setDbVersion version = backgroundTask {
do! Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
return version
}
/// Migrate from v2-rc2 to v2 (manual migration required)
let migrateV2Rc2ToV2 () = backgroundTask {
let! webLogs =
@@ -152,11 +152,11 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
let tables =
[ Table.Category; Table.Page; Table.Post; Table.PostComment; Table.TagMap; Table.Theme; Table.WebLog
Table.WebLogUser ]
Utils.Migration.logStep log migration "Adding unique indexes on ID fields"
do! Custom.nonQuery
(tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") []
Utils.Migration.logStep log migration "Removing constraints"
let fkToDrop =
[ "page_revision", "page_revision_page_id_fkey"
@@ -176,17 +176,17 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|> List.map (fun (tbl, fk) -> $"ALTER TABLE {tbl} DROP CONSTRAINT {fk}")
|> String.concat "; ")
[]
Utils.Migration.logStep log migration "Dropping old indexes"
let toDrop =
[ "idx_category"; "page_author_idx"; "page_permalink_idx"; "page_web_log_idx"; "post_author_idx"
"post_category_idx"; "post_permalink_idx"; "post_status_idx"; "post_tag_idx"; "post_web_log_idx"
"post_comment_post_idx"; "idx_tag_map"; "idx_web_log"; "idx_web_log_user" ]
do! Custom.nonQuery (toDrop |> List.map (sprintf "DROP INDEX %s") |> String.concat "; ") []
Utils.Migration.logStep log migration "Dropping old ID columns"
do! Custom.nonQuery (tables |> List.map (sprintf "ALTER TABLE %s DROP COLUMN id") |> String.concat "; ") []
Utils.Migration.logStep log migration "Adding new indexes"
let newIdx =
[ yield! tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL)
@@ -209,7 +209,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
$"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL ]
do! Custom.nonQuery (newIdx |> String.concat "; ") []
Utils.Migration.logStep log migration "Setting database to version 2.1.1"
return! setDbVersion "v2.1.1"
}
@@ -224,33 +224,45 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
return! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
return! setDbVersion "v3"
}
/// Do required data migration between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
if v = "v2-rc2" then
if v = "v2-rc2" then
let! webLogs =
Custom.list
$"SELECT url_base, slug FROM {Table.WebLog}" []
(fun row -> row.string "url_base", row.string "slug")
Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs
if v = "v2" then
let! ver = migrateV2ToV2point1point1 ()
v <- ver
if v = "v2.1.1" then
let! ver = migrateV2point1point1ToV2point2 ()
v <- ver
if v = "v2.2" then
let! ver = migrateV2point2ToV3 ()
v <- ver
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
let! _ = setDbVersion Utils.Migration.currentDbVersion
()
}
interface IData with
member _.Category = PostgresCategoryData log
member _.Page = PostgresPageData log
member _.Post = PostgresPostData log
@@ -260,13 +272,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
member _.Upload = PostgresUploadData log
member _.WebLog = PostgresWebLogData log
member _.WebLogUser = PostgresWebLogUserData log
member _.Serializer = ser
member _.StartUp () = backgroundTask {
log.LogTrace "PostgresData.StartUp"
do! ensureTables ()
let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
do! migrate version
}
+146 -123
View File
@@ -6,38 +6,38 @@ open RethinkDb.Driver
/// Functions to assist with retrieving data
module private RethinkHelpers =
/// Table names
[<RequireQualifiedAccess>]
module Table =
/// The category table
let Category = "Category"
/// The comment table
let Comment = "Comment"
/// The database version table
let DbVersion = "DbVersion"
/// The page table
let Page = "Page"
/// The post table
let Post = "Post"
/// The tag map table
let TagMap = "TagMap"
/// The theme table
let Theme = "Theme"
/// The theme asset table
let ThemeAsset = "ThemeAsset"
/// The uploaded file table
let Upload = "Upload"
/// The web log table
let WebLog = "WebLog"
@@ -47,24 +47,24 @@ module private RethinkHelpers =
/// A list of all tables
let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Index names for indexes not on a data item's name
[<RequireQualifiedAccess>]
module Index =
/// An index by web log ID and e-mail address
let LogOn = "LogOn"
/// An index by web log ID and uploaded file path
let WebLogAndPath = "WebLogAndPath"
/// An index by web log ID and mapped tag
let WebLogAndTag = "WebLogAndTag"
/// An index by web log ID and tag URL value
let WebLogAndUrl = "WebLogAndUrl"
/// Shorthand for the ReQL starting point
let r = RethinkDB.R
@@ -73,14 +73,14 @@ module private RethinkHelpers =
fun conn -> backgroundTask {
match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None
}
/// Get the first item from a list, or None if the list is empty
let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) =
fun conn -> backgroundTask {
let! results = f conn
return results |> List.tryHead
}
/// Cast a strongly-typed list to an object list
let objList<'T> (objects: 'T list) = objects |> List.map (fun it -> it :> obj)
@@ -93,16 +93,16 @@ open RethinkHelpers
/// RethinkDB implementation of data functions for myWebLog
type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<RethinkDbData>) =
/// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId =
let keyPrefix = $"^{themeId}/"
fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes
let withoutTemplateText (row: Ast.ReqlExpr) : obj =
{| Templates = row[nameof Theme.Empty.Templates].Merge(r.HashMap(nameof ThemeTemplate.Empty.Text, "")) |}
/// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask {
let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
@@ -180,13 +180,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
do! rethink { withTable table; indexWait; result; withRetryDefault; ignoreResult conn }
}
/// The batch size for restoration methods
let restoreBatchSize = 100
/// A value to use when files need to be retrieved without their data
let emptyFile = r.Binary(Array.Empty<byte>())
/// Delete assets for the given theme ID
let deleteAssetsByTheme themeId = rethink {
withTable Table.ThemeAsset
@@ -194,7 +194,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
delete
write; withRetryDefault; ignoreResult conn
}
/// Set a specific database version
let setDbVersion (version: string) = backgroundTask {
do! rethink {
@@ -208,7 +208,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
/// Migrate from v2-rc1 to v2-rc2
let migrateV2Rc1ToV2Rc2 () = backgroundTask {
let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2"
@@ -233,11 +233,11 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
update [ nameof WebLog.Empty.RedirectRules, [] :> obj ]
write; withRetryOnce; ignoreResult conn
}
Utils.Migration.logStep log "v2 to v2.1" "Setting database version to v2.1"
do! setDbVersion "v2.1"
}
/// Migrate from v2.1 to v2.1.1
let migrateV2point1ToV2point1point1 () = backgroundTask {
Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
@@ -256,10 +256,22 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
do! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! rethink {
withTable Table.WebLog
update [ nameof WebLog.Empty.AutoOpenGraph, true :> obj ]
write; withRetryOnce; ignoreResult conn
}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
if v = "v2-rc1" then
do! migrateV2Rc1ToV2Rc2 ()
v <- "v2-rc2"
@@ -267,38 +279,42 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
if v = "v2-rc2" then
do! migrateV2Rc2ToV2 ()
v <- "v2"
if v = "v2" then
do! migrateV2ToV2point1 ()
v <- "v2.1"
if v = "v2.1" then
do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1"
if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 ()
v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion
}
/// The connection for this instance
member _.Conn = conn
interface IData with
member _.Category = {
new ICategoryData with
member _.Add cat = rethink {
withTable Table.Category
insert cat
write; withRetryDefault; ignoreResult conn
}
member _.CountAll webLogId = rethink<int> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
@@ -313,7 +329,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
count
result; withRetryDefault conn
}
member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> {
withTable Table.Category
@@ -353,7 +369,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> Option.defaultValue 0 })
|> Array.ofSeq
}
member _.FindById catId webLogId =
rethink<Category> {
withTable Table.Category
@@ -361,13 +377,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category
getAll [ webLogId ] (nameof Category.Empty.WebLogId)
result; withRetryDefault conn
}
member this.Delete catId webLogId = backgroundTask {
match! this.FindById catId webLogId with
| Some cat ->
@@ -394,7 +410,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
{| CategoryIds =
row[nameof Post.Empty.CategoryIds].CoerceTo("array")
.SetDifference(r.Array(catId)) |} :> obj)
write; withRetryDefault; ignoreResult conn
write; withRetryDefault; ignoreResult conn
}
// Delete the category itself
do! rethink {
@@ -406,7 +422,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
}
member _.Restore cats = backgroundTask {
for batch in cats |> List.chunkBySize restoreBatchSize do
do! rethink {
@@ -415,7 +431,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member _.Update cat = rethink {
withTable Table.Category
get cat.Id
@@ -427,10 +443,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.Page = {
new IPageData with
member _.Add page = rethink {
withTable Table.Page
insert page
@@ -447,7 +463,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase() :> obj)
result; withRetryDefault conn
}
member _.CountAll webLogId = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
@@ -473,7 +489,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
return result.Deleted > 0UL
}
member _.FindById pageId webLogId =
rethink<Page list> {
withTable Table.Page
@@ -495,7 +511,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result =
(rethink<Page list> {
@@ -509,7 +525,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst) conn
return result |> Option.map _.Permalink
}
member _.FindFullById pageId webLogId =
rethink<Page> {
withTable Table.Page
@@ -517,13 +533,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId)
@@ -546,7 +562,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit 25
result; withRetryDefault conn
}
member _.Restore pages = backgroundTask {
for batch in pages |> List.chunkBySize restoreBatchSize do
do! rethink {
@@ -555,7 +571,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member _.Update page = rethink {
withTable Table.Page
get page.Id
@@ -572,7 +588,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
]
write; withRetryDefault; ignoreResult conn
}
member this.UpdatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! this.FindById pageId webLogId with
| Some _ ->
@@ -586,16 +602,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
| None -> return false
}
}
member _.Post = {
new IPostData with
member _.Add post = rethink {
withTable Table.Post
insert post
write; withRetryDefault; ignoreResult conn
}
member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
@@ -614,7 +630,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
return result.Deleted > 0UL
}
member _.FindById postId webLogId =
rethink<Post list> {
withTable Table.Post
@@ -625,7 +641,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member _.FindByPermalink permalink webLogId =
rethink<Post list> {
withTable Table.Post
@@ -636,7 +652,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member _.FindFullById postId webLogId =
rethink<Post> {
withTable Table.Post
@@ -658,13 +674,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst) conn
return result |> Option.map _.Permalink
}
member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll (objList categoryIds) (nameof Post.Empty.CategoryIds)
@@ -678,7 +694,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1)
result; withRetryDefault conn
}
member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId)
@@ -703,7 +719,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1)
result; withRetryDefault conn
}
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post
getAll [ tag ] (nameof Post.Empty.Tags)
@@ -716,7 +732,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1)
result; withRetryDefault conn
}
member _.FindSurroundingPosts webLogId publishedOn = backgroundTask {
let! older =
rethink<Post list> {
@@ -744,7 +760,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst <| conn
return older, newer
}
member _.Restore pages = backgroundTask {
for batch in pages |> List.chunkBySize restoreBatchSize do
do! rethink {
@@ -753,7 +769,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member this.Update post = backgroundTask {
match! this.FindById post.Id post.WebLogId with
| Some _ ->
@@ -779,10 +795,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
| None -> return false
}
}
member _.TagMap = {
new ITagMapData with
member _.Delete tagMapId webLogId = backgroundTask {
let! result = rethink<Model.Result> {
withTable Table.TagMap
@@ -793,7 +809,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
return result.Deleted > 0UL
}
member _.FindById tagMapId webLogId =
rethink<TagMap> {
withTable Table.TagMap
@@ -801,7 +817,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> {
withTable Table.TagMap
@@ -810,7 +826,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
@@ -818,13 +834,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
orderBy (nameof TagMap.Empty.Tag)
result; withRetryDefault conn
}
member _.FindMappingForTags tags webLogId = rethink<TagMap list> {
withTable Table.TagMap
getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag
result; withRetryDefault conn
}
member _.Restore tagMaps = backgroundTask {
for batch in tagMaps |> List.chunkBySize restoreBatchSize do
do! rethink {
@@ -833,7 +849,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member _.Save tagMap = rethink {
withTable Table.TagMap
get tagMap.Id
@@ -841,10 +857,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.Theme = {
new IThemeData with
member _.All () = rethink<Theme list> {
withTable Table.Theme
filter (fun row -> row[nameof Theme.Empty.Id].Ne "admin" :> obj)
@@ -852,7 +868,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
orderBy (nameof Theme.Empty.Id)
result; withRetryDefault conn
}
member _.Exists themeId = backgroundTask {
let! count = rethink<int> {
withTable Table.Theme
@@ -862,13 +878,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
return count > 0
}
member _.FindById themeId = rethink<Theme> {
withTable Table.Theme
get themeId
resultOption; withRetryOptionDefault conn
}
member _.FindByIdWithoutText themeId =
rethink<Theme list> {
withTable Table.Theme
@@ -877,7 +893,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member this.Delete themeId = backgroundTask {
match! this.FindByIdWithoutText themeId with
| Some _ ->
@@ -891,7 +907,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return true
| None -> return false
}
member _.Save theme = rethink {
withTable Table.Theme
get theme.Id
@@ -899,37 +915,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.ThemeAsset = {
new IThemeAssetData with
member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
result; withRetryDefault conn
}
member _.DeleteByTheme themeId = deleteAssetsByTheme themeId
member _.FindById assetId = rethink<ThemeAsset> {
withTable Table.ThemeAsset
get assetId
resultOption; withRetryOptionDefault conn
}
member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId)
merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
result; withRetryDefault conn
}
member _.FindByThemeWithData themeId = rethink<ThemeAsset> {
withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId)
resultCursor; withRetryCursorDefault; toList conn
}
member _.Save asset = rethink {
withTable Table.ThemeAsset
get asset.Id
@@ -937,16 +953,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.Upload = {
new IUploadData with
member _.Add upload = rethink {
withTable Table.Upload
insert upload
write; withRetryDefault; ignoreResult conn
}
member _.Delete uploadId webLogId = backgroundTask {
let! upload =
rethink<Upload> {
@@ -966,7 +982,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return Ok (string up.Path)
| None -> return Result.Error $"Upload ID {uploadId} not found"
}
member _.FindByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
@@ -974,7 +990,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
@@ -982,14 +998,14 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
merge (r.HashMap(nameof Upload.Empty.Data, emptyFile))
resultCursor; withRetryCursorDefault; toList conn
}
member _.FindByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndPath ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.Restore uploads = backgroundTask {
// Files can be large; we'll do 5 at a time
for batch in uploads |> List.chunkBySize 5 do
@@ -1000,21 +1016,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
}
}
member _.WebLog = {
new IWebLogData with
member _.Add webLog = rethink {
withTable Table.WebLog
insert webLog
write; withRetryOnce; ignoreResult conn
}
member _.All () = rethink<WebLog list> {
withTable Table.WebLog
result; withRetryDefault conn
}
member _.Delete webLogId = backgroundTask {
// Comments should be deleted by post IDs
let! thePostIds = rethink<{| Id: string |} list> {
@@ -1061,7 +1077,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member _.FindByHost url =
rethink<WebLog list> {
withTable Table.WebLog
@@ -1076,21 +1092,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
get webLogId
resultOption; withRetryOptionDefault conn
}
member _.UpdateRedirectRules webLog = rethink {
withTable Table.WebLog
get webLog.Id
update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ]
write; withRetryDefault; ignoreResult conn
}
member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog
get webLog.Id
update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn
}
member _.UpdateSettings webLog = rethink {
withTable Table.WebLog
get webLog.Id
@@ -1108,16 +1124,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.WebLogUser = {
new IWebLogUserData with
member _.Add user = rethink {
withTable Table.WebLogUser
insert user
write; withRetryDefault; ignoreResult conn
}
member _.FindById userId webLogId =
rethink<WebLogUser> {
withTable Table.WebLogUser
@@ -1125,7 +1141,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId _.WebLogId <| conn
member this.Delete userId webLogId = backgroundTask {
match! this.FindById userId webLogId with
| Some _ ->
@@ -1155,7 +1171,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return Ok true
| None -> return Result.Error "User does not exist"
}
member _.FindByEmail email webLogId =
rethink<WebLogUser list> {
withTable Table.WebLogUser
@@ -1164,14 +1180,14 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault
}
|> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase())
result; withRetryDefault conn
}
member _.FindNames webLogId userIds = backgroundTask {
let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser
@@ -1181,7 +1197,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
}
member _.Restore users = backgroundTask {
for batch in users |> List.chunkBySize restoreBatchSize do
do! rethink {
@@ -1190,7 +1206,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn
}
}
member this.SetLastSeen userId webLogId = backgroundTask {
match! this.FindById userId webLogId with
| Some _ ->
@@ -1202,7 +1218,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
}
| None -> ()
}
member _.Update user = rethink {
withTable Table.WebLogUser
get user.Id
@@ -1218,30 +1234,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn
}
}
member _.Serializer =
Net.Converter.Serializer
member _.StartUp () = backgroundTask {
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
if not (dbs |> List.contains config.Database) then
log.LogInformation $"Creating database {config.Database}..."
do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn }
let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
for tbl in Table.all do
if not (tables |> List.contains tbl) then
log.LogInformation $"Creating table {tbl}..."
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
if not (List.contains Table.DbVersion tables) then
// Version table added in v2-rc2; this will flag that migration to be run
if List.isEmpty tables then
// New install; set version to current version
do! rethink {
withTable Table.DbVersion
insert {| Id = Utils.Migration.currentDbVersion |}
write; withRetryOnce; ignoreResult conn
}
elif not (List.contains Table.DbVersion tables) then
// Other tables, but not version, added in v2-rc2; this will flag that migration to be run
do! rethink {
withTable Table.DbVersion
insert {| Id = "v2-rc1" |}
write; withRetryOnce; ignoreResult conn
}
do! ensureIndexes Table.Category [ nameof Category.Empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ]
do! ensureIndexes Table.Page [ nameof Page.Empty.WebLogId; nameof Page.Empty.AuthorId ]
@@ -1250,7 +1273,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ nameof WebLog.Empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ]
let! version = rethink<{| Id: string |} list> {
withTable Table.DbVersion
limit 1
+49 -37
View File
@@ -12,24 +12,24 @@ open NodaTime
/// SQLite myWebLog data implementation
type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSerializer) =
/// Create tables (and their associated indexes) if they do not exist
let ensureTables () = backgroundTask {
Configuration.useSerializer (Utils.createDocumentSerializer ser)
let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
let needsTable table =
not (List.contains table tables)
let creatingTable = "Creating {Table} table..."
// Theme tables
if needsTable Table.Theme then
log.LogInformation(creatingTable, Table.Theme)
do! conn.ensureTable Table.Theme
if needsTable Table.ThemeAsset then
log.LogInformation(creatingTable, Table.ThemeAsset)
do! conn.customNonQuery
@@ -39,32 +39,32 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
updated_on TEXT NOT NULL,
data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))" []
// Web log table
if needsTable Table.WebLog then
log.LogInformation(creatingTable, Table.WebLog)
do! conn.ensureTable Table.WebLog
// Category table
if needsTable Table.Category then
log.LogInformation(creatingTable, Table.Category)
do! conn.ensureTable Table.Category
do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ]
// Web log user table
if needsTable Table.WebLogUser then
log.LogInformation(creatingTable, Table.WebLogUser)
do! conn.ensureTable Table.WebLogUser
do! conn.ensureFieldIndex
Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]
// Page tables
if needsTable Table.Page then
log.LogInformation(creatingTable, Table.Page)
do! conn.ensureTable Table.Page
do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ]
do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
if needsTable Table.PageRevision then
log.LogInformation(creatingTable, Table.PageRevision)
do! conn.customNonQuery
@@ -73,7 +73,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" []
// Post tables
if needsTable Table.Post then
log.LogInformation(creatingTable, Table.Post)
@@ -85,7 +85,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
"status"
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
// TODO: index categories by post?
if needsTable Table.PostRevision then
log.LogInformation(creatingTable, Table.PostRevision)
do! conn.customNonQuery
@@ -94,18 +94,18 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" []
if needsTable Table.PostComment then
log.LogInformation(creatingTable, Table.PostComment)
do! conn.ensureTable Table.PostComment
do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ]
// Tag map table
if needsTable Table.TagMap then
log.LogInformation(creatingTable, Table.TagMap)
do! conn.ensureTable Table.TagMap
do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]
// Uploaded file table
if needsTable Table.Upload then
log.LogInformation(creatingTable, Table.Upload)
@@ -117,7 +117,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
updated_on TEXT NOT NULL,
data BLOB NOT NULL);
CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" []
// Database version table
if needsTable Table.DbVersion then
log.LogInformation(creatingTable, Table.DbVersion)
@@ -125,11 +125,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
$"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" []
}
/// Set the database version to the specified version
let setDbVersion version =
conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" []
/// Implement the changes between v2-rc1 and v2-rc2
let migrateV2Rc1ToV2Rc2 () = backgroundTask {
let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2"
@@ -223,7 +223,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|> Option.map (Utils.deserialize<Chapter list> ser)
ChapterFile = Map.tryString "chapter_file" epRdr
ChapterType = Map.tryString "chapter_type" epRdr
ChapterWaypoints = None
ChapterWaypoints = None
TranscriptUrl = Map.tryString "transcript_url" epRdr
TranscriptType = Map.tryString "transcript_type" epRdr
TranscriptLang = Map.tryString "transcript_lang" epRdr
@@ -241,7 +241,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
cmd.Parameters.AddWithValue("@id", string postId) ] |> ignore
let _ = cmd.ExecuteNonQuery()
cmd.Parameters.Clear())
logStep "Migrating dates/times"
let inst (dt: DateTime) =
DateTime(dt.Ticks, DateTimeKind.Utc)
@@ -408,10 +408,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
let _ = cmd.ExecuteNonQuery()
())
cmd.Parameters.Clear()
conn.Close()
conn.Open()
logStep "Dropping old tables and columns"
cmd.CommandText <-
"ALTER TABLE web_log_user DROP COLUMN salt;
@@ -420,11 +420,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
DROP TABLE page_meta;
DROP TABLE web_log_feed_podcast"
do! write cmd
logStep "Setting database version to v2-rc2"
do! setDbVersion "v2-rc2"
}
/// Migrate from v2-rc2 to v2
let migrateV2Rc2ToV2 () = backgroundTask {
Utils.Migration.logStep log "v2-rc2 to v2" "Setting database version; no migration required"
@@ -443,7 +443,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
do! setDbVersion "v2.1.1"
}
/// Migrate from v2.1.1 to v2.2
let migrateV2point1point1ToV2point2 () = backgroundTask {
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase"
@@ -452,6 +452,14 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
do! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data among versions (up only)
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@@ -459,33 +467,37 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
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
do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1"
if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 ()
v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion
}
/// The connection for this instance
member _.Conn = conn
interface IData with
member _.Category = SQLiteCategoryData (conn, ser, log)
member _.Page = SQLitePageData (conn, log)
member _.Post = SQLitePostData (conn, log)
@@ -495,9 +507,9 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
member _.Upload = SQLiteUploadData (conn, log)
member _.WebLog = SQLiteWebLogData (conn, log)
member _.WebLogUser = SQLiteWebLogUserData (conn, log)
member _.Serializer = ser
member _.StartUp () = backgroundTask {
do! ensureTables ()
let! version = conn.customSingle<string> $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0)
+1 -1
View File
@@ -79,7 +79,7 @@ module Migration =
open Microsoft.Extensions.Logging
/// <summary>The current database version</summary>
let currentDbVersion = "v2.2"
let currentDbVersion = "v3"
/// <summary>Log a migration step</summary>
/// <param name="log">The logger to which the message should be logged</param>