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

Move OpenGraph property generation to models (#52)

Browse Source 
- 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:
Daniel J. Summers 2025-07-10 23:03:16 -04:00
parent 210dd41cee
commit 3ad6b5a521
17 changed files with 799 additions and 293 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/MyWebLog.Data/Converters.fs
View File

@ -65,6 +65,14 @@ module Json =
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) = override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.Parse) reader.Value (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> /// <summary>Converter for the <see cref="Permalink" /> type</summary>
type PermalinkConverter() = type PermalinkConverter() =
inherit JsonConverter<Permalink>() inherit JsonConverter<Permalink>()
@ -159,6 +167,7 @@ module Json =
CustomFeedSourceConverter() CustomFeedSourceConverter()
ExplicitRatingConverter() ExplicitRatingConverter()
MarkupTextConverter() MarkupTextConverter()
OpenGraphTypeConverter()
PermalinkConverter() PermalinkConverter()
PageIdConverter() PageIdConverter()
PodcastMediumConverter() PodcastMediumConverter()

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

@ -10,17 +10,17 @@ open Npgsql.FSharp
/// Data implementation for PostgreSQL /// Data implementation for PostgreSQL
type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) = type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
/// Create any needed tables /// Create any needed tables
let ensureTables () = backgroundTask { let ensureTables () = backgroundTask {
// Set up the PostgreSQL document store // Set up the PostgreSQL document store
Configuration.useSerializer (Utils.createDocumentSerializer ser) Configuration.useSerializer (Utils.createDocumentSerializer ser)
let! tables = let! tables =
Custom.list Custom.list
"SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename") "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables) let needsTable table = not (List.contains table tables)
let sql = seq { let sql = seq {
// Theme tables // Theme tables
if needsTable Table.Theme then if needsTable Table.Theme then
@ -33,25 +33,25 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL, data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))" PRIMARY KEY (theme_id, path))"
// Web log table // Web log table
if needsTable Table.WebLog then if needsTable Table.WebLog then
Query.Definition.ensureTable Table.WebLog Query.Definition.ensureTable Table.WebLog
Query.Definition.ensureKey Table.WebLog PostgreSQL Query.Definition.ensureKey Table.WebLog PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLog Optimized Query.Definition.ensureDocumentIndex Table.WebLog Optimized
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
Query.Definition.ensureTable Table.Category Query.Definition.ensureTable Table.Category
Query.Definition.ensureKey Table.Category PostgreSQL Query.Definition.ensureKey Table.Category PostgreSQL
Query.Definition.ensureDocumentIndex Table.Category Optimized Query.Definition.ensureDocumentIndex Table.Category Optimized
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
Query.Definition.ensureTable Table.WebLogUser Query.Definition.ensureTable Table.WebLogUser
Query.Definition.ensureKey Table.WebLogUser PostgreSQL Query.Definition.ensureKey Table.WebLogUser PostgreSQL
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
Query.Definition.ensureTable Table.Page Query.Definition.ensureTable Table.Page
@ -65,7 +65,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" PRIMARY KEY (page_id, as_of))"
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
Query.Definition.ensureTable Table.Post Query.Definition.ensureTable Table.Post
@ -90,13 +90,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
Query.Definition.ensureTable Table.PostComment Query.Definition.ensureTable Table.PostComment
Query.Definition.ensureKey Table.PostComment PostgreSQL Query.Definition.ensureKey Table.PostComment PostgreSQL
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
Query.Definition.ensureTable Table.TagMap Query.Definition.ensureTable Table.TagMap
Query.Definition.ensureKey Table.TagMap PostgreSQL Query.Definition.ensureKey Table.TagMap PostgreSQL
Query.Definition.ensureDocumentIndex Table.TagMap Optimized Query.Definition.ensureDocumentIndex Table.TagMap Optimized
// Uploaded file table // Uploaded file table
if needsTable Table.Upload then if needsTable Table.Upload then
$"CREATE TABLE {Table.Upload} ( $"CREATE TABLE {Table.Upload} (
@ -107,13 +107,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
data BYTEA NOT NULL)" data BYTEA NOT NULL)"
$"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)" $"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)"
$"CREATE INDEX idx_upload_path ON {Table.Upload} (web_log_id, path)" $"CREATE INDEX idx_upload_path ON {Table.Upload} (web_log_id, path)"
// Database version table // Database version table
if needsTable Table.DbVersion then if needsTable Table.DbVersion then
$"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)" $"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
} }
Configuration.dataSource () Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
@ -128,13 +128,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|> Async.RunSynchronously |> Async.RunSynchronously
|> ignore |> ignore
} }
/// Set a specific database version /// Set a specific database version
let setDbVersion version = backgroundTask { let setDbVersion version = backgroundTask {
do! Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" [] do! Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
return version return version
} }
/// Migrate from v2-rc2 to v2 (manual migration required) /// Migrate from v2-rc2 to v2 (manual migration required)
let migrateV2Rc2ToV2 () = backgroundTask { let migrateV2Rc2ToV2 () = backgroundTask {
let! webLogs = let! webLogs =
@ -152,11 +152,11 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
let tables = let tables =
[ Table.Category; Table.Page; Table.Post; Table.PostComment; Table.TagMap; Table.Theme; Table.WebLog [ Table.Category; Table.Page; Table.Post; Table.PostComment; Table.TagMap; Table.Theme; Table.WebLog
Table.WebLogUser ] Table.WebLogUser ]
Utils.Migration.logStep log migration "Adding unique indexes on ID fields" Utils.Migration.logStep log migration "Adding unique indexes on ID fields"
do! Custom.nonQuery do! Custom.nonQuery
(tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") [] (tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") []
Utils.Migration.logStep log migration "Removing constraints" Utils.Migration.logStep log migration "Removing constraints"
let fkToDrop = let fkToDrop =
[ "page_revision", "page_revision_page_id_fkey" [ "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}") |> List.map (fun (tbl, fk) -> $"ALTER TABLE {tbl} DROP CONSTRAINT {fk}")
|> String.concat "; ") |> String.concat "; ")
[] []
Utils.Migration.logStep log migration "Dropping old indexes" Utils.Migration.logStep log migration "Dropping old indexes"
let toDrop = let toDrop =
[ "idx_category"; "page_author_idx"; "page_permalink_idx"; "page_web_log_idx"; "post_author_idx" [ "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_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" ] "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 "; ") [] do! Custom.nonQuery (toDrop |> List.map (sprintf "DROP INDEX %s") |> String.concat "; ") []
Utils.Migration.logStep log migration "Dropping old ID columns" Utils.Migration.logStep log migration "Dropping old ID columns"
do! Custom.nonQuery (tables |> List.map (sprintf "ALTER TABLE %s DROP COLUMN id") |> String.concat "; ") [] do! Custom.nonQuery (tables |> List.map (sprintf "ALTER TABLE %s DROP COLUMN id") |> String.concat "; ") []
Utils.Migration.logStep log migration "Adding new indexes" Utils.Migration.logStep log migration "Adding new indexes"
let newIdx = let newIdx =
[ yield! tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) [ 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}']))" $"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 ] Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL ]
do! Custom.nonQuery (newIdx |> String.concat "; ") [] do! Custom.nonQuery (newIdx |> String.concat "; ") []
Utils.Migration.logStep log migration "Setting database to version 2.1.1" Utils.Migration.logStep log migration "Setting database to version 2.1.1"
return! setDbVersion "v2.1.1" return! setDbVersion "v2.1.1"
} }
@ -224,33 +224,45 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
return! setDbVersion "v2.2" 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 /// Do required data migration between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
if v = "v2-rc2" then if v = "v2-rc2" then
let! webLogs = let! webLogs =
Custom.list Custom.list
$"SELECT url_base, slug FROM {Table.WebLog}" [] $"SELECT url_base, slug FROM {Table.WebLog}" []
(fun row -> row.string "url_base", row.string "slug") (fun row -> row.string "url_base", row.string "slug")
Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs
if v = "v2" then if v = "v2" then
let! ver = migrateV2ToV2point1point1 () let! ver = migrateV2ToV2point1point1 ()
v <- ver v <- ver
if v = "v2.1.1" then if v = "v2.1.1" then
let! ver = migrateV2point1point1ToV2point2 () let! ver = migrateV2point1point1ToV2point2 ()
v <- ver v <- ver
if v = "v2.2" then
let! ver = migrateV2point2ToV3 ()
v <- ver
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
let! _ = setDbVersion Utils.Migration.currentDbVersion let! _ = setDbVersion Utils.Migration.currentDbVersion
() ()
} }
interface IData with interface IData with
member _.Category = PostgresCategoryData log member _.Category = PostgresCategoryData log
member _.Page = PostgresPageData log member _.Page = PostgresPageData log
member _.Post = PostgresPostData log member _.Post = PostgresPostData log
@ -260,13 +272,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
member _.Upload = PostgresUploadData log member _.Upload = PostgresUploadData log
member _.WebLog = PostgresWebLogData log member _.WebLog = PostgresWebLogData log
member _.WebLogUser = PostgresWebLogUserData log member _.WebLogUser = PostgresWebLogUserData log
member _.Serializer = ser member _.Serializer = ser
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
log.LogTrace "PostgresData.StartUp" log.LogTrace "PostgresData.StartUp"
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")
do! migrate version do! migrate version
} }

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

@ -6,38 +6,38 @@ open RethinkDb.Driver
/// Functions to assist with retrieving data /// Functions to assist with retrieving data
module private RethinkHelpers = module private RethinkHelpers =
/// Table names /// Table names
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Table = module Table =
/// The category table /// The category table
let Category = "Category" let Category = "Category"
/// The comment table /// The comment table
let Comment = "Comment" let Comment = "Comment"
/// The database version table /// The database version table
let DbVersion = "DbVersion" let DbVersion = "DbVersion"
/// The page table /// The page table
let Page = "Page" let Page = "Page"
/// The post table /// The post table
let Post = "Post" let Post = "Post"
/// The tag map table /// The tag map table
let TagMap = "TagMap" let TagMap = "TagMap"
/// The theme table /// The theme table
let Theme = "Theme" let Theme = "Theme"
/// The theme asset table /// The theme asset table
let ThemeAsset = "ThemeAsset" let ThemeAsset = "ThemeAsset"
/// The uploaded file table /// The uploaded file table
let Upload = "Upload" let Upload = "Upload"
/// The web log table /// The web log table
let WebLog = "WebLog" let WebLog = "WebLog"
@ -47,24 +47,24 @@ module private RethinkHelpers =
/// A list of all tables /// A list of all tables
let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ] let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Index names for indexes not on a data item's name /// Index names for indexes not on a data item's name
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Index = module Index =
/// An index by web log ID and e-mail address /// An index by web log ID and e-mail address
let LogOn = "LogOn" let LogOn = "LogOn"
/// An index by web log ID and uploaded file path /// An index by web log ID and uploaded file path
let WebLogAndPath = "WebLogAndPath" let WebLogAndPath = "WebLogAndPath"
/// An index by web log ID and mapped tag /// An index by web log ID and mapped tag
let WebLogAndTag = "WebLogAndTag" let WebLogAndTag = "WebLogAndTag"
/// An index by web log ID and tag URL value /// An index by web log ID and tag URL value
let WebLogAndUrl = "WebLogAndUrl" let WebLogAndUrl = "WebLogAndUrl"
/// Shorthand for the ReQL starting point /// Shorthand for the ReQL starting point
let r = RethinkDB.R let r = RethinkDB.R
@ -73,14 +73,14 @@ module private RethinkHelpers =
fun conn -> backgroundTask { fun conn -> backgroundTask {
match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None 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 /// Get the first item from a list, or None if the list is empty
let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) = let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) =
fun conn -> backgroundTask { fun conn -> backgroundTask {
let! results = f conn let! results = f conn
return results |> List.tryHead return results |> List.tryHead
} }
/// Cast a strongly-typed list to an object list /// Cast a strongly-typed list to an object list
let objList<'T> (objects: 'T list) = objects |> List.map (fun it -> it :> obj) 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 /// RethinkDB implementation of data functions for myWebLog
type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<RethinkDbData>) = type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<RethinkDbData>) =
/// Match theme asset IDs by their prefix (the theme ID) /// Match theme asset IDs by their prefix (the theme ID)
let matchAssetByThemeId themeId = let matchAssetByThemeId themeId =
let keyPrefix = $"^{themeId}/" let keyPrefix = $"^{themeId}/"
fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes /// Function to exclude template text from themes
let withoutTemplateText (row: Ast.ReqlExpr) : obj = let withoutTemplateText (row: Ast.ReqlExpr) : obj =
{| Templates = row[nameof Theme.Empty.Templates].Merge(r.HashMap(nameof ThemeTemplate.Empty.Text, "")) |} {| 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 /// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask { let ensureIndexes table fields = backgroundTask {
let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn } 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 } do! rethink { withTable table; indexWait; result; withRetryDefault; ignoreResult conn }
} }
/// The batch size for restoration methods /// The batch size for restoration methods
let restoreBatchSize = 100 let restoreBatchSize = 100
/// A value to use when files need to be retrieved without their data /// A value to use when files need to be retrieved without their data
let emptyFile = r.Binary(Array.Empty<byte>()) let emptyFile = r.Binary(Array.Empty<byte>())
/// Delete assets for the given theme ID /// Delete assets for the given theme ID
let deleteAssetsByTheme themeId = rethink { let deleteAssetsByTheme themeId = rethink {
withTable Table.ThemeAsset withTable Table.ThemeAsset
@ -194,7 +194,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
delete delete
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
/// Set a specific database version /// Set a specific database version
let setDbVersion (version: string) = backgroundTask { let setDbVersion (version: string) = backgroundTask {
do! rethink { do! rethink {
@ -208,7 +208,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
/// Migrate from v2-rc1 to v2-rc2 /// Migrate from v2-rc1 to v2-rc2
let migrateV2Rc1ToV2Rc2 () = backgroundTask { let migrateV2Rc1ToV2Rc2 () = backgroundTask {
let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2" 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 ] update [ nameof WebLog.Empty.RedirectRules, [] :> obj ]
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
Utils.Migration.logStep log "v2 to v2.1" "Setting database version to v2.1" Utils.Migration.logStep log "v2 to v2.1" "Setting database version to v2.1"
do! setDbVersion "v2.1" do! setDbVersion "v2.1"
} }
/// Migrate from v2.1 to v2.1.1 /// Migrate from v2.1 to v2.1.1
let migrateV2point1ToV2point1point1 () = backgroundTask { let migrateV2point1ToV2point1point1 () = backgroundTask {
Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required" 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" 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 /// Migrate data between versions
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
if v = "v2-rc1" then if v = "v2-rc1" then
do! migrateV2Rc1ToV2Rc2 () do! migrateV2Rc1ToV2Rc2 ()
v <- "v2-rc2" v <- "v2-rc2"
@ -267,38 +279,42 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
if v = "v2-rc2" then if v = "v2-rc2" then
do! migrateV2Rc2ToV2 () do! migrateV2Rc2ToV2 ()
v <- "v2" v <- "v2"
if v = "v2" then if v = "v2" then
do! migrateV2ToV2point1 () do! migrateV2ToV2point1 ()
v <- "v2.1" v <- "v2.1"
if v = "v2.1" then if v = "v2.1" then
do! migrateV2point1ToV2point1point1 () do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1" v <- "v2.1.1"
if v = "v2.1.1" then if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 () do! migrateV2point1point1ToV2point2 ()
v <- "v2.2" v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion do! setDbVersion Utils.Migration.currentDbVersion
} }
/// The connection for this instance /// The connection for this instance
member _.Conn = conn member _.Conn = conn
interface IData with interface IData with
member _.Category = { member _.Category = {
new ICategoryData with new ICategoryData with
member _.Add cat = rethink { member _.Add cat = rethink {
withTable Table.Category withTable Table.Category
insert cat insert cat
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.Empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
@ -313,7 +329,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
count count
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindAllForView webLogId = backgroundTask { member _.FindAllForView webLogId = backgroundTask {
let! cats = rethink<Category list> { let! cats = rethink<Category list> {
withTable Table.Category withTable Table.Category
@ -353,7 +369,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> Option.defaultValue 0 }) |> Option.defaultValue 0 })
|> Array.ofSeq |> Array.ofSeq
} }
member _.FindById catId webLogId = member _.FindById catId webLogId =
rethink<Category> { rethink<Category> {
withTable Table.Category withTable Table.Category
@ -361,13 +377,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId _.WebLogId <| conn |> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByWebLog webLogId = rethink<Category list> { member _.FindByWebLog webLogId = rethink<Category list> {
withTable Table.Category withTable Table.Category
getAll [ webLogId ] (nameof Category.Empty.WebLogId) getAll [ webLogId ] (nameof Category.Empty.WebLogId)
result; withRetryDefault conn result; withRetryDefault conn
} }
member this.Delete catId webLogId = backgroundTask { member this.Delete catId webLogId = backgroundTask {
match! this.FindById catId webLogId with match! this.FindById catId webLogId with
| Some cat -> | Some cat ->
@ -394,7 +410,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
{| CategoryIds = {| CategoryIds =
row[nameof Post.Empty.CategoryIds].CoerceTo("array") row[nameof Post.Empty.CategoryIds].CoerceTo("array")
.SetDifference(r.Array(catId)) |} :> obj) .SetDifference(r.Array(catId)) |} :> obj)
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
// Delete the category itself // Delete the category itself
do! rethink { do! rethink {
@ -406,7 +422,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return if children = 0 then CategoryDeleted else ReassignedChildCategories return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }
member _.Restore cats = backgroundTask { member _.Restore cats = backgroundTask {
for batch in cats |> List.chunkBySize restoreBatchSize do for batch in cats |> List.chunkBySize restoreBatchSize do
do! rethink { do! rethink {
@ -415,7 +431,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member _.Update cat = rethink { member _.Update cat = rethink {
withTable Table.Category withTable Table.Category
get cat.Id get cat.Id
@ -427,10 +443,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.Page = { member _.Page = {
new IPageData with new IPageData with
member _.Add page = rethink { member _.Add page = rethink {
withTable Table.Page withTable Table.Page
insert 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) orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase() :> obj)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.CountAll webLogId = rethink<int> { member _.CountAll webLogId = rethink<int> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
@ -473,7 +489,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
return result.Deleted > 0UL return result.Deleted > 0UL
} }
member _.FindById pageId webLogId = member _.FindById pageId webLogId =
rethink<Page list> { rethink<Page list> {
withTable Table.Page withTable Table.Page
@ -495,7 +511,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindCurrentPermalink permalinks webLogId = backgroundTask { member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
let! result = let! result =
(rethink<Page list> { (rethink<Page list> {
@ -509,7 +525,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst) conn |> tryFirst) conn
return result |> Option.map _.Permalink return result |> Option.map _.Permalink
} }
member _.FindFullById pageId webLogId = member _.FindFullById pageId webLogId =
rethink<Page> { rethink<Page> {
withTable Table.Page withTable Table.Page
@ -517,13 +533,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId _.WebLogId <| conn |> verifyWebLog webLogId _.WebLogId <| conn
member _.FindFullByWebLog webLogId = rethink<Page> { member _.FindFullByWebLog webLogId = rethink<Page> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindListed webLogId = rethink<Page list> { member _.FindListed webLogId = rethink<Page list> {
withTable Table.Page withTable Table.Page
getAll [ webLogId ] (nameof Page.Empty.WebLogId) getAll [ webLogId ] (nameof Page.Empty.WebLogId)
@ -546,7 +562,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit 25 limit 25
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.Restore pages = backgroundTask { member _.Restore pages = backgroundTask {
for batch in pages |> List.chunkBySize restoreBatchSize do for batch in pages |> List.chunkBySize restoreBatchSize do
do! rethink { do! rethink {
@ -555,7 +571,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member _.Update page = rethink { member _.Update page = rethink {
withTable Table.Page withTable Table.Page
get page.Id get page.Id
@ -572,7 +588,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
] ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member this.UpdatePriorPermalinks pageId webLogId permalinks = backgroundTask { member this.UpdatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! this.FindById pageId webLogId with match! this.FindById pageId webLogId with
| Some _ -> | Some _ ->
@ -586,16 +602,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
| None -> return false | None -> return false
} }
} }
member _.Post = { member _.Post = {
new IPostData with new IPostData with
member _.Add post = rethink { member _.Add post = rethink {
withTable Table.Post withTable Table.Post
insert post insert post
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.CountByStatus status webLogId = rethink<int> { member _.CountByStatus status webLogId = rethink<int> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
@ -614,7 +630,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
return result.Deleted > 0UL return result.Deleted > 0UL
} }
member _.FindById postId webLogId = member _.FindById postId webLogId =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
@ -625,7 +641,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindByPermalink permalink webLogId = member _.FindByPermalink permalink webLogId =
rethink<Post list> { rethink<Post list> {
withTable Table.Post withTable Table.Post
@ -636,7 +652,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindFullById postId webLogId = member _.FindFullById postId webLogId =
rethink<Post> { rethink<Post> {
withTable Table.Post withTable Table.Post
@ -658,13 +674,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst) conn |> tryFirst) conn
return result |> Option.map _.Permalink return result |> Option.map _.Permalink
} }
member _.FindFullByWebLog webLogId = rethink<Post> { member _.FindFullByWebLog webLogId = rethink<Post> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll (objList categoryIds) (nameof Post.Empty.CategoryIds) getAll (objList categoryIds) (nameof Post.Empty.CategoryIds)
@ -678,7 +694,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ webLogId ] (nameof Post.Empty.WebLogId) getAll [ webLogId ] (nameof Post.Empty.WebLogId)
@ -703,7 +719,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> { member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
withTable Table.Post withTable Table.Post
getAll [ tag ] (nameof Post.Empty.Tags) getAll [ tag ] (nameof Post.Empty.Tags)
@ -716,7 +732,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
limit (postsPerPage + 1) limit (postsPerPage + 1)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindSurroundingPosts webLogId publishedOn = backgroundTask { member _.FindSurroundingPosts webLogId publishedOn = backgroundTask {
let! older = let! older =
rethink<Post list> { rethink<Post list> {
@ -744,7 +760,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
|> tryFirst <| conn |> tryFirst <| conn
return older, newer return older, newer
} }
member _.Restore pages = backgroundTask { member _.Restore pages = backgroundTask {
for batch in pages |> List.chunkBySize restoreBatchSize do for batch in pages |> List.chunkBySize restoreBatchSize do
do! rethink { do! rethink {
@ -753,7 +769,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member this.Update post = backgroundTask { member this.Update post = backgroundTask {
match! this.FindById post.Id post.WebLogId with match! this.FindById post.Id post.WebLogId with
| Some _ -> | Some _ ->
@ -779,10 +795,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
| None -> return false | None -> return false
} }
} }
member _.TagMap = { member _.TagMap = {
new ITagMapData with new ITagMapData with
member _.Delete tagMapId webLogId = backgroundTask { member _.Delete tagMapId webLogId = backgroundTask {
let! result = rethink<Model.Result> { let! result = rethink<Model.Result> {
withTable Table.TagMap withTable Table.TagMap
@ -793,7 +809,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
return result.Deleted > 0UL return result.Deleted > 0UL
} }
member _.FindById tagMapId webLogId = member _.FindById tagMapId webLogId =
rethink<TagMap> { rethink<TagMap> {
withTable Table.TagMap withTable Table.TagMap
@ -801,7 +817,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId _.WebLogId <| conn |> verifyWebLog webLogId _.WebLogId <| conn
member _.FindByUrlValue urlValue webLogId = member _.FindByUrlValue urlValue webLogId =
rethink<TagMap list> { rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
@ -810,7 +826,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<TagMap list> { member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] 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) orderBy (nameof TagMap.Empty.Tag)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindMappingForTags tags webLogId = rethink<TagMap list> { member _.FindMappingForTags tags webLogId = rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.Restore tagMaps = backgroundTask { member _.Restore tagMaps = backgroundTask {
for batch in tagMaps |> List.chunkBySize restoreBatchSize do for batch in tagMaps |> List.chunkBySize restoreBatchSize do
do! rethink { do! rethink {
@ -833,7 +849,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member _.Save tagMap = rethink { member _.Save tagMap = rethink {
withTable Table.TagMap withTable Table.TagMap
get tagMap.Id get tagMap.Id
@ -841,10 +857,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.Theme = { member _.Theme = {
new IThemeData with new IThemeData with
member _.All () = rethink<Theme list> { member _.All () = rethink<Theme list> {
withTable Table.Theme withTable Table.Theme
filter (fun row -> row[nameof Theme.Empty.Id].Ne "admin" :> obj) 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) orderBy (nameof Theme.Empty.Id)
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.Exists themeId = backgroundTask { member _.Exists themeId = backgroundTask {
let! count = rethink<int> { let! count = rethink<int> {
withTable Table.Theme withTable Table.Theme
@ -862,13 +878,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
return count > 0 return count > 0
} }
member _.FindById themeId = rethink<Theme> { member _.FindById themeId = rethink<Theme> {
withTable Table.Theme withTable Table.Theme
get themeId get themeId
resultOption; withRetryOptionDefault conn resultOption; withRetryOptionDefault conn
} }
member _.FindByIdWithoutText themeId = member _.FindByIdWithoutText themeId =
rethink<Theme list> { rethink<Theme list> {
withTable Table.Theme withTable Table.Theme
@ -877,7 +893,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member this.Delete themeId = backgroundTask { member this.Delete themeId = backgroundTask {
match! this.FindByIdWithoutText themeId with match! this.FindByIdWithoutText themeId with
| Some _ -> | Some _ ->
@ -891,7 +907,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return true return true
| None -> return false | None -> return false
} }
member _.Save theme = rethink { member _.Save theme = rethink {
withTable Table.Theme withTable Table.Theme
get theme.Id get theme.Id
@ -899,37 +915,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.ThemeAsset = { member _.ThemeAsset = {
new IThemeAssetData with new IThemeAssetData with
member _.All () = rethink<ThemeAsset list> { member _.All () = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile)) merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.DeleteByTheme themeId = deleteAssetsByTheme themeId member _.DeleteByTheme themeId = deleteAssetsByTheme themeId
member _.FindById assetId = rethink<ThemeAsset> { member _.FindById assetId = rethink<ThemeAsset> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
get assetId get assetId
resultOption; withRetryOptionDefault conn resultOption; withRetryOptionDefault conn
} }
member _.FindByTheme themeId = rethink<ThemeAsset list> { member _.FindByTheme themeId = rethink<ThemeAsset list> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId) filter (matchAssetByThemeId themeId)
merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile)) merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindByThemeWithData themeId = rethink<ThemeAsset> { member _.FindByThemeWithData themeId = rethink<ThemeAsset> {
withTable Table.ThemeAsset withTable Table.ThemeAsset
filter (matchAssetByThemeId themeId) filter (matchAssetByThemeId themeId)
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.Save asset = rethink { member _.Save asset = rethink {
withTable Table.ThemeAsset withTable Table.ThemeAsset
get asset.Id get asset.Id
@ -937,16 +953,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.Upload = { member _.Upload = {
new IUploadData with new IUploadData with
member _.Add upload = rethink { member _.Add upload = rethink {
withTable Table.Upload withTable Table.Upload
insert upload insert upload
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.Delete uploadId webLogId = backgroundTask { member _.Delete uploadId webLogId = backgroundTask {
let! upload = let! upload =
rethink<Upload> { rethink<Upload> {
@ -966,7 +982,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return Ok (string up.Path) return Ok (string up.Path)
| None -> return Result.Error $"Upload ID {uploadId} not found" | None -> return Result.Error $"Upload ID {uploadId} not found"
} }
member _.FindByPath path webLogId = member _.FindByPath path webLogId =
rethink<Upload> { rethink<Upload> {
withTable Table.Upload withTable Table.Upload
@ -974,7 +990,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultCursor; withRetryCursorDefault; toList resultCursor; withRetryCursorDefault; toList
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<Upload> { member _.FindByWebLog webLogId = rethink<Upload> {
withTable Table.Upload withTable Table.Upload
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] 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)) merge (r.HashMap(nameof Upload.Empty.Data, emptyFile))
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.FindByWebLogWithData webLogId = rethink<Upload> { member _.FindByWebLogWithData webLogId = rethink<Upload> {
withTable Table.Upload withTable Table.Upload
between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
[ Index Index.WebLogAndPath ] [ Index Index.WebLogAndPath ]
resultCursor; withRetryCursorDefault; toList conn resultCursor; withRetryCursorDefault; toList conn
} }
member _.Restore uploads = backgroundTask { member _.Restore uploads = backgroundTask {
// Files can be large; we'll do 5 at a time // Files can be large; we'll do 5 at a time
for batch in uploads |> List.chunkBySize 5 do for batch in uploads |> List.chunkBySize 5 do
@ -1000,21 +1016,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
} }
} }
member _.WebLog = { member _.WebLog = {
new IWebLogData with new IWebLogData with
member _.Add webLog = rethink { member _.Add webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
insert webLog insert webLog
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
member _.All () = rethink<WebLog list> { member _.All () = rethink<WebLog list> {
withTable Table.WebLog withTable Table.WebLog
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.Delete webLogId = backgroundTask { member _.Delete webLogId = backgroundTask {
// Comments should be deleted by post IDs // Comments should be deleted by post IDs
let! thePostIds = rethink<{| Id: string |} list> { let! thePostIds = rethink<{| Id: string |} list> {
@ -1061,7 +1077,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member _.FindByHost url = member _.FindByHost url =
rethink<WebLog list> { rethink<WebLog list> {
withTable Table.WebLog withTable Table.WebLog
@ -1076,21 +1092,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
get webLogId get webLogId
resultOption; withRetryOptionDefault conn resultOption; withRetryOptionDefault conn
} }
member _.UpdateRedirectRules webLog = rethink { member _.UpdateRedirectRules webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.Id get webLog.Id
update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ] update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.UpdateRssOptions webLog = rethink { member _.UpdateRssOptions webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.Id get webLog.Id
update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ] update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ]
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.UpdateSettings webLog = rethink { member _.UpdateSettings webLog = rethink {
withTable Table.WebLog withTable Table.WebLog
get webLog.Id get webLog.Id
@ -1108,16 +1124,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.WebLogUser = { member _.WebLogUser = {
new IWebLogUserData with new IWebLogUserData with
member _.Add user = rethink { member _.Add user = rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
insert user insert user
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
member _.FindById userId webLogId = member _.FindById userId webLogId =
rethink<WebLogUser> { rethink<WebLogUser> {
withTable Table.WebLogUser withTable Table.WebLogUser
@ -1125,7 +1141,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
resultOption; withRetryOptionDefault resultOption; withRetryOptionDefault
} }
|> verifyWebLog webLogId _.WebLogId <| conn |> verifyWebLog webLogId _.WebLogId <| conn
member this.Delete userId webLogId = backgroundTask { member this.Delete userId webLogId = backgroundTask {
match! this.FindById userId webLogId with match! this.FindById userId webLogId with
| Some _ -> | Some _ ->
@ -1155,7 +1171,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
return Ok true return Ok true
| None -> return Result.Error "User does not exist" | None -> return Result.Error "User does not exist"
} }
member _.FindByEmail email webLogId = member _.FindByEmail email webLogId =
rethink<WebLogUser list> { rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
@ -1164,14 +1180,14 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
result; withRetryDefault result; withRetryDefault
} }
|> tryFirst <| conn |> tryFirst <| conn
member _.FindByWebLog webLogId = rethink<WebLogUser list> { member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser withTable Table.WebLogUser
getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId) getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase()) orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase())
result; withRetryDefault conn result; withRetryDefault conn
} }
member _.FindNames webLogId userIds = backgroundTask { member _.FindNames webLogId userIds = backgroundTask {
let! users = rethink<WebLogUser list> { let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser 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 }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }
member _.Restore users = backgroundTask { member _.Restore users = backgroundTask {
for batch in users |> List.chunkBySize restoreBatchSize do for batch in users |> List.chunkBySize restoreBatchSize do
do! rethink { do! rethink {
@ -1190,7 +1206,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
} }
member this.SetLastSeen userId webLogId = backgroundTask { member this.SetLastSeen userId webLogId = backgroundTask {
match! this.FindById userId webLogId with match! this.FindById userId webLogId with
| Some _ -> | Some _ ->
@ -1202,7 +1218,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
} }
| None -> () | None -> ()
} }
member _.Update user = rethink { member _.Update user = rethink {
withTable Table.WebLogUser withTable Table.WebLogUser
get user.Id get user.Id
@ -1218,30 +1234,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
write; withRetryDefault; ignoreResult conn write; withRetryDefault; ignoreResult conn
} }
} }
member _.Serializer = member _.Serializer =
Net.Converter.Serializer Net.Converter.Serializer
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn } let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
if not (dbs |> List.contains config.Database) then if not (dbs |> List.contains config.Database) then
log.LogInformation $"Creating database {config.Database}..." log.LogInformation $"Creating database {config.Database}..."
do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn } do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn }
let! tables = rethink<string list> { tableList; result; withRetryOnce conn } let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
for tbl in Table.all do for tbl in Table.all do
if not (tables |> List.contains tbl) then if not (tables |> List.contains tbl) then
log.LogInformation $"Creating table {tbl}..." log.LogInformation $"Creating table {tbl}..."
do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn } do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
if not (List.contains Table.DbVersion tables) then if List.isEmpty tables then
// Version table added in v2-rc2; this will flag that migration to be run // 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 { do! rethink {
withTable Table.DbVersion withTable Table.DbVersion
insert {| Id = "v2-rc1" |} insert {| Id = "v2-rc1" |}
write; withRetryOnce; ignoreResult conn write; withRetryOnce; ignoreResult conn
} }
do! ensureIndexes Table.Category [ nameof Category.Empty.WebLogId ] do! ensureIndexes Table.Category [ nameof Category.Empty.WebLogId ]
do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ] do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ]
do! ensureIndexes Table.Page [ nameof Page.Empty.WebLogId; nameof Page.Empty.AuthorId ] 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.Upload []
do! ensureIndexes Table.WebLog [ nameof WebLog.Empty.UrlBase ] do! ensureIndexes Table.WebLog [ nameof WebLog.Empty.UrlBase ]
do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ] do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ]
let! version = rethink<{| Id: string |} list> { let! version = rethink<{| Id: string |} list> {
withTable Table.DbVersion withTable Table.DbVersion
limit 1 limit 1

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

@ -12,24 +12,24 @@ open NodaTime
/// SQLite myWebLog data implementation /// SQLite myWebLog data implementation
type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSerializer) = type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSerializer) =
/// Create tables (and their associated indexes) if they do not exist /// Create tables (and their associated indexes) if they do not exist
let ensureTables () = backgroundTask { let ensureTables () = backgroundTask {
Configuration.useSerializer (Utils.createDocumentSerializer ser) Configuration.useSerializer (Utils.createDocumentSerializer ser)
let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0) let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
let needsTable table = let needsTable table =
not (List.contains table tables) not (List.contains table tables)
let creatingTable = "Creating {Table} table..." let creatingTable = "Creating {Table} table..."
// Theme tables // Theme tables
if needsTable Table.Theme then if needsTable Table.Theme then
log.LogInformation(creatingTable, Table.Theme) log.LogInformation(creatingTable, Table.Theme)
do! conn.ensureTable Table.Theme do! conn.ensureTable Table.Theme
if needsTable Table.ThemeAsset then if needsTable Table.ThemeAsset then
log.LogInformation(creatingTable, Table.ThemeAsset) log.LogInformation(creatingTable, Table.ThemeAsset)
do! conn.customNonQuery do! conn.customNonQuery
@ -39,32 +39,32 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL, data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))" [] PRIMARY KEY (theme_id, path))" []
// Web log table // Web log table
if needsTable Table.WebLog then if needsTable Table.WebLog then
log.LogInformation(creatingTable, Table.WebLog) log.LogInformation(creatingTable, Table.WebLog)
do! conn.ensureTable Table.WebLog do! conn.ensureTable Table.WebLog
// Category table // Category table
if needsTable Table.Category then if needsTable Table.Category then
log.LogInformation(creatingTable, Table.Category) log.LogInformation(creatingTable, Table.Category)
do! conn.ensureTable Table.Category do! conn.ensureTable Table.Category
do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ] do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ]
// Web log user table // Web log user table
if needsTable Table.WebLogUser then if needsTable Table.WebLogUser then
log.LogInformation(creatingTable, Table.WebLogUser) log.LogInformation(creatingTable, Table.WebLogUser)
do! conn.ensureTable Table.WebLogUser do! conn.ensureTable Table.WebLogUser
do! conn.ensureFieldIndex do! conn.ensureFieldIndex
Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ] Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]
// Page tables // Page tables
if needsTable Table.Page then if needsTable Table.Page then
log.LogInformation(creatingTable, Table.Page) log.LogInformation(creatingTable, Table.Page)
do! conn.ensureTable Table.Page do! conn.ensureTable Table.Page
do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ] do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ]
do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
if needsTable Table.PageRevision then if needsTable Table.PageRevision then
log.LogInformation(creatingTable, Table.PageRevision) log.LogInformation(creatingTable, Table.PageRevision)
do! conn.customNonQuery do! conn.customNonQuery
@ -73,7 +73,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" [] PRIMARY KEY (page_id, as_of))" []
// Post tables // Post tables
if needsTable Table.Post then if needsTable Table.Post then
log.LogInformation(creatingTable, Table.Post) log.LogInformation(creatingTable, Table.Post)
@ -85,7 +85,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
"status" "status"
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ] [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
// TODO: index categories by post? // TODO: index categories by post?
if needsTable Table.PostRevision then if needsTable Table.PostRevision then
log.LogInformation(creatingTable, Table.PostRevision) log.LogInformation(creatingTable, Table.PostRevision)
do! conn.customNonQuery do! conn.customNonQuery
@ -94,18 +94,18 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
as_of TEXT NOT NULL, as_of TEXT NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" [] PRIMARY KEY (post_id, as_of))" []
if needsTable Table.PostComment then if needsTable Table.PostComment then
log.LogInformation(creatingTable, Table.PostComment) log.LogInformation(creatingTable, Table.PostComment)
do! conn.ensureTable Table.PostComment do! conn.ensureTable Table.PostComment
do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ] do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ]
// Tag map table // Tag map table
if needsTable Table.TagMap then if needsTable Table.TagMap then
log.LogInformation(creatingTable, Table.TagMap) log.LogInformation(creatingTable, Table.TagMap)
do! conn.ensureTable Table.TagMap do! conn.ensureTable Table.TagMap
do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ] do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]
// Uploaded file table // Uploaded file table
if needsTable Table.Upload then if needsTable Table.Upload then
log.LogInformation(creatingTable, Table.Upload) log.LogInformation(creatingTable, Table.Upload)
@ -117,7 +117,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
updated_on TEXT NOT NULL, updated_on TEXT NOT NULL,
data BLOB NOT NULL); data BLOB NOT NULL);
CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" [] CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" []
// Database version table // Database version table
if needsTable Table.DbVersion then if needsTable Table.DbVersion then
log.LogInformation(creatingTable, Table.DbVersion) 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); $"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" [] INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" []
} }
/// Set the database version to the specified version /// Set the database version to the specified version
let setDbVersion version = let setDbVersion version =
conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" [] conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" []
/// Implement the changes between v2-rc1 and v2-rc2 /// Implement the changes between v2-rc1 and v2-rc2
let migrateV2Rc1ToV2Rc2 () = backgroundTask { let migrateV2Rc1ToV2Rc2 () = backgroundTask {
let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2" 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) |> Option.map (Utils.deserialize<Chapter list> ser)
ChapterFile = Map.tryString "chapter_file" epRdr ChapterFile = Map.tryString "chapter_file" epRdr
ChapterType = Map.tryString "chapter_type" epRdr ChapterType = Map.tryString "chapter_type" epRdr
ChapterWaypoints = None ChapterWaypoints = None
TranscriptUrl = Map.tryString "transcript_url" epRdr TranscriptUrl = Map.tryString "transcript_url" epRdr
TranscriptType = Map.tryString "transcript_type" epRdr TranscriptType = Map.tryString "transcript_type" epRdr
TranscriptLang = Map.tryString "transcript_lang" 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 cmd.Parameters.AddWithValue("@id", string postId) ] |> ignore
let _ = cmd.ExecuteNonQuery() let _ = cmd.ExecuteNonQuery()
cmd.Parameters.Clear()) cmd.Parameters.Clear())
logStep "Migrating dates/times" logStep "Migrating dates/times"
let inst (dt: DateTime) = let inst (dt: DateTime) =
DateTime(dt.Ticks, DateTimeKind.Utc) DateTime(dt.Ticks, DateTimeKind.Utc)
@ -408,10 +408,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
let _ = cmd.ExecuteNonQuery() let _ = cmd.ExecuteNonQuery()
()) ())
cmd.Parameters.Clear() cmd.Parameters.Clear()
conn.Close() conn.Close()
conn.Open() conn.Open()
logStep "Dropping old tables and columns" logStep "Dropping old tables and columns"
cmd.CommandText <- cmd.CommandText <-
"ALTER TABLE web_log_user DROP COLUMN salt; "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 page_meta;
DROP TABLE web_log_feed_podcast" DROP TABLE web_log_feed_podcast"
do! write cmd do! write cmd
logStep "Setting database version to v2-rc2" logStep "Setting database version to v2-rc2"
do! setDbVersion "v2-rc2" do! setDbVersion "v2-rc2"
} }
/// Migrate from v2-rc2 to v2 /// Migrate from v2-rc2 to v2
let migrateV2Rc2ToV2 () = backgroundTask { let migrateV2Rc2ToV2 () = backgroundTask {
Utils.Migration.logStep log "v2-rc2 to v2" "Setting database version; no migration required" 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" Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
do! setDbVersion "v2.1.1" do! setDbVersion "v2.1.1"
} }
/// Migrate from v2.1.1 to v2.2 /// Migrate from v2.1.1 to v2.2
let migrateV2point1point1ToV2point2 () = backgroundTask { let migrateV2point1point1ToV2point2 () = backgroundTask {
Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase" 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" 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) /// Migrate data among versions (up only)
let migrate version = backgroundTask { let migrate version = backgroundTask {
let mutable v = defaultArg version "" let mutable v = defaultArg version ""
@ -459,33 +467,37 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
if v = "v2-rc1" then if v = "v2-rc1" then
do! migrateV2Rc1ToV2Rc2 () do! migrateV2Rc1ToV2Rc2 ()
v <- "v2-rc2" v <- "v2-rc2"
if v = "v2-rc2" then if v = "v2-rc2" then
do! migrateV2Rc2ToV2 () do! migrateV2Rc2ToV2 ()
v <- "v2" v <- "v2"
if v = "v2" then if v = "v2" then
do! migrateV2ToV2point1 () do! migrateV2ToV2point1 ()
v <- "v2.1" v <- "v2.1"
if v = "v2.1" then if v = "v2.1" then
do! migrateV2point1ToV2point1point1 () do! migrateV2point1ToV2point1point1 ()
v <- "v2.1.1" v <- "v2.1.1"
if v = "v2.1.1" then if v = "v2.1.1" then
do! migrateV2point1point1ToV2point2 () do! migrateV2point1point1ToV2point2 ()
v <- "v2.2" v <- "v2.2"
if v = "v2.2" then
do! migrateV2point2ToV3 ()
v <- "v3"
if v <> Utils.Migration.currentDbVersion then if v <> Utils.Migration.currentDbVersion then
log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
do! setDbVersion Utils.Migration.currentDbVersion do! setDbVersion Utils.Migration.currentDbVersion
} }
/// The connection for this instance /// The connection for this instance
member _.Conn = conn member _.Conn = conn
interface IData with interface IData with
member _.Category = SQLiteCategoryData (conn, ser, log) member _.Category = SQLiteCategoryData (conn, ser, log)
member _.Page = SQLitePageData (conn, log) member _.Page = SQLitePageData (conn, log)
member _.Post = SQLitePostData (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 _.Upload = SQLiteUploadData (conn, log)
member _.WebLog = SQLiteWebLogData (conn, log) member _.WebLog = SQLiteWebLogData (conn, log)
member _.WebLogUser = SQLiteWebLogUserData (conn, log) member _.WebLogUser = SQLiteWebLogUserData (conn, log)
member _.Serializer = ser member _.Serializer = ser
member _.StartUp () = backgroundTask { member _.StartUp () = backgroundTask {
do! ensureTables () do! ensureTables ()
let! version = conn.customSingle<string> $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0) let! version = conn.customSingle<string> $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0)

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

@ -79,7 +79,7 @@ module Migration =
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
/// <summary>The current database version</summary> /// <summary>The current database version</summary>
let currentDbVersion = "v2.2" let currentDbVersion = "v3"
/// <summary>Log a migration step</summary> /// <summary>Log a migration step</summary>
/// <param name="log">The logger to which the message should be logged</param> /// <param name="log">The logger to which the message should be logged</param>

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

@ -348,6 +348,9 @@ type WebLog = {
/// <summary>Redirect rules for this weblog</summary> /// <summary>Redirect rules for this weblog</summary>
RedirectRules: RedirectRule list RedirectRules: RedirectRule list
/// <summary>Whether to automatically apply OpenGraph properties to all pages / posts</summary>
AutoOpenGraph: bool
} with } with
/// <summary>An empty web log</summary> /// <summary>An empty web log</summary>
@ -364,7 +367,8 @@ type WebLog = {
Rss = RssOptions.Empty Rss = RssOptions.Empty
AutoHtmx = false AutoHtmx = false
Uploads = Database Uploads = Database
RedirectRules = [] } RedirectRules = []
AutoOpenGraph = true }
/// <summary> /// <summary>
/// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain) /// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain)

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

@ -19,6 +19,17 @@ module private Helpers =
/// <summary>Pipeline with most extensions enabled</summary> /// <summary>Pipeline with most extensions enabled</summary>
let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build() let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build()
/// <summary>Derive a MIME type from the given URL and candidates</summary>
/// <param name="url">The URL from which the MIME type should be derived</param>
/// <param name="candidates">The candidates for the MIME type derivation</param>
/// <returns><c>Some</c> with the type if it was derived, <c>None</c> otherwise</returns>
let deriveMimeType (url: string) (candidates: System.Collections.Generic.IDictionary<string, string>) =
match url.LastIndexOf '.' with
| extIdx when extIdx >= 0 ->
let ext = url[extIdx + 1..]
if candidates.ContainsKey ext then Some candidates[ext] else None
| _ -> None
/// <summary>Functions to support NodaTime manipulation</summary> /// <summary>Functions to support NodaTime manipulation</summary>
module Noda = module Noda =
@ -401,6 +412,15 @@ type OpenGraphAudio = {
SecureUrl = None SecureUrl = None
Type = None } Type = None }
/// <summary>MIME types we can derive from the file extension</summary>
static member private DeriveTypes =
[ "aac", "audio/aac"
"mp3", "audio/mpeg"
"oga", "audio/ogg"
"wav", "audio/wav"
"weba", "audio/webm" ]
|> dict
/// <summary>The <c>meta</c> properties for this image</summary> /// <summary>The <c>meta</c> properties for this image</summary>
member this.Properties = seq { member this.Properties = seq {
yield ("og:audio", this.Url) yield ("og:audio", this.Url)
@ -411,8 +431,9 @@ type OpenGraphAudio = {
match this.Type with match this.Type with
| Some typ -> yield ("og:audio:type", typ) | Some typ -> yield ("og:audio:type", typ)
| None -> | None ->
// TODO: derive mime type from extension match deriveMimeType this.Url OpenGraphAudio.DeriveTypes with
() | Some it -> yield "og:audio:type", it
| None -> ()
} }
@ -447,21 +468,36 @@ type OpenGraphImage = {
Height = None Height = None
Alt = None } Alt = None }
/// <summary>MIME types we can derive from the file extension</summary>
static member private DeriveTypes =
[ "bmp", "image/bmp"
"gif", "image/gif"
"ico", "image/vnd.microsoft.icon"
"jpeg", "image/jpeg"
"jpg", "image/jpeg"
"png", "image/png"
"svg", "image/svg+xml"
"tif", "image/tiff"
"tiff", "image/tiff"
"webp", "image/webp" ]
|> dict
/// <summary>The <c>meta</c> properties for this image</summary> /// <summary>The <c>meta</c> properties for this image</summary>
member this.Properties = seq { member this.Properties = seq {
yield ("og:image", this.Url) yield "og:image", this.Url
match this.SecureUrl with match this.SecureUrl with
| Some url -> yield ("og:image:secure_url", url) | Some url -> yield "og:image:secure_url", url
| None when this.Url.StartsWith "https:" -> yield ("og:image:secure_url", this.Url) | None when this.Url.StartsWith "https:" -> yield "og:image:secure_url", this.Url
| None -> () | None -> ()
match this.Type with match this.Type with
| Some typ -> yield ("og:image:type", typ) | Some typ -> yield "og:image:type", typ
| None -> | None ->
// TODO: derive mime type based on common image extensions match deriveMimeType this.Url OpenGraphImage.DeriveTypes with
() | Some it -> yield "og:image:type", it
match this.Width with Some width -> yield ("og:image:width", string width) | None -> () | None -> ()
match this.Height with Some height -> yield ("og:image:height", string height) | None -> () match this.Width with Some width -> yield "og:image:width", string width | None -> ()
match this.Alt with Some alt -> yield ("og:image:alt", alt) | None -> () match this.Height with Some height -> yield "og:image:height", string height | None -> ()
match this.Alt with Some alt -> yield "og:image:alt", alt | None -> ()
} }
@ -492,20 +528,30 @@ type OpenGraphVideo = {
Width = None Width = None
Height = None } Height = None }
/// <summary>MIME types we can derive from the file extension</summary>
static member private DeriveTypes =
[ "avi", "video/x-msvideo"
"mp4", "video/mp4"
"mpeg", "video/mpeg"
"ogv", "video/ogg"
"webm", "video/webm" ]
|> dict
/// <summary>The <c>meta</c> properties for this video</summary> /// <summary>The <c>meta</c> properties for this video</summary>
member this.Properties = seq { member this.Properties = seq {
yield ("og:video", this.Url) yield "og:video", this.Url
match this.SecureUrl with match this.SecureUrl with
| Some url -> yield ("og:video:secure_url", url) | Some url -> yield "og:video:secure_url", url
| None when this.Url.StartsWith "https:" -> yield ("og:video:secure_url", this.Url) | None when this.Url.StartsWith "https:" -> yield "og:video:secure_url", this.Url
| None -> () | None -> ()
match this.Type with match this.Type with
| Some typ -> yield ("og:video:type", typ) | Some typ -> yield "og:video:type", typ
| None -> | None ->
// TODO: derive mime type based on common video extensions match deriveMimeType this.Url OpenGraphVideo.DeriveTypes with
() | Some it -> yield "og:video:type", it
match this.Width with Some width -> yield ("og:video:width", string width) | None -> () | None -> ()
match this.Height with Some height -> yield ("og:video:height", string height) | None -> () match this.Width with Some width -> yield "og:video:width", string width | None -> ()
match this.Height with Some height -> yield "og:video:height", string height | None -> ()
} }
@ -567,7 +613,6 @@ type OpenGraphType =
/// <summary>Properties for OpenGraph</summary> /// <summary>Properties for OpenGraph</summary>
[<CLIMutable>] [<CLIMutable>]
type OpenGraphProperties = { type OpenGraphProperties = {
/// <summary>The type of object represented</summary> /// <summary>The type of object represented</summary>
Type: OpenGraphType Type: OpenGraphType
@ -594,7 +639,34 @@ type OpenGraphProperties = {
/// <summary>Free-form items</summary> /// <summary>Free-form items</summary>
Other: MetaItem list option Other: MetaItem list option
} } with
/// <summary>An empty set of OpenGraph properties</summary>
static member Empty =
{ Type = Article
Image = OpenGraphImage.Empty
Audio = None
Description = None
Determiner = None
Locale = None
LocaleAlternate = None
Video = None
Other = None }
/// <summary>The <c>meta</c> properties for this page or post</summary>
member this.Properties = seq {
yield "og:type", string this.Type
yield! this.Image.Properties
match this.Description with Some desc -> yield "og:description", desc | None -> ()
match this.Determiner with Some det -> yield "og:determiner", det | None -> ()
match this.Locale with Some loc -> yield "og:locale", loc | None -> ()
match this.LocaleAlternate with
| Some alt -> yield! alt |> List.map (fun it -> "og:locale:alternate", it)
| None -> ()
match this.Audio with Some audio -> yield! audio.Properties | None -> ()
match this.Video with Some video -> yield! video.Properties | None -> ()
match this.Other with Some oth -> yield! oth |> List.map (fun it -> it.Name, it.Value) | None -> ()
}
/// <summary>A permanent link</summary> /// <summary>A permanent link</summary>

41
src/MyWebLog.Domain/ViewModels.fs
View File

@ -1249,36 +1249,41 @@ type SettingsModel = {
/// <summary>The default location for uploads</summary> /// <summary>The default location for uploads</summary>
Uploads: string Uploads: string
/// <summary>Whether to automatically apply OpenGraph properties to all pages and posts</summary>
AutoOpenGraph: bool
} with } with
/// <summary>Create a settings model from a web log</summary> /// <summary>Create a settings model from a web log</summary>
/// <param name="webLog">The web log from which this model should be created</param> /// <param name="webLog">The web log from which this model should be created</param>
/// <returns>A populated <c>SettingsModel</c> instance</returns> /// <returns>A populated <c>SettingsModel</c> instance</returns>
static member FromWebLog(webLog: WebLog) = static member FromWebLog(webLog: WebLog) =
{ Name = webLog.Name { Name = webLog.Name
Slug = webLog.Slug Slug = webLog.Slug
Subtitle = defaultArg webLog.Subtitle "" Subtitle = defaultArg webLog.Subtitle ""
DefaultPage = webLog.DefaultPage DefaultPage = webLog.DefaultPage
PostsPerPage = webLog.PostsPerPage PostsPerPage = webLog.PostsPerPage
TimeZone = webLog.TimeZone TimeZone = webLog.TimeZone
ThemeId = string webLog.ThemeId ThemeId = string webLog.ThemeId
AutoHtmx = webLog.AutoHtmx AutoHtmx = webLog.AutoHtmx
Uploads = string webLog.Uploads } Uploads = string webLog.Uploads
AutoOpenGraph = webLog.AutoOpenGraph }
/// <summary>Update a web log with settings from the form</summary> /// <summary>Update a web log with settings from the form</summary>
/// <param name="webLog">The web log to be updated</param> /// <param name="webLog">The web log to be updated</param>
/// <returns>The web log, updated with the value from this model</returns> /// <returns>The web log, updated with the value from this model</returns>
member this.Update(webLog: WebLog) = member this.Update(webLog: WebLog) =
{ webLog with { webLog with
Name = this.Name Name = this.Name
Slug = this.Slug Slug = this.Slug
Subtitle = if this.Subtitle = "" then None else Some this.Subtitle Subtitle = if this.Subtitle = "" then None else Some this.Subtitle
DefaultPage = this.DefaultPage DefaultPage = this.DefaultPage
PostsPerPage = this.PostsPerPage PostsPerPage = this.PostsPerPage
TimeZone = this.TimeZone TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx AutoHtmx = this.AutoHtmx
Uploads = UploadDestination.Parse this.Uploads } Uploads = UploadDestination.Parse this.Uploads
AutoOpenGraph = this.AutoOpenGraph }
/// <summary>View model for uploading a file</summary> /// <summary>View model for uploading a file</summary>

18
src/MyWebLog.Tests/Data/ConvertersTests.fs
View File

@ -90,7 +90,7 @@ let explicitRatingConverterTests = testList "ExplicitRatingConverter" [
} }
] ]
/// Unit tests for the MarkupText type /// Unit tests for the MarkupTextConverter type
let markupTextConverterTests = testList "MarkupTextConverter" [ let markupTextConverterTests = testList "MarkupTextConverter" [
let opts = JsonSerializerSettings() let opts = JsonSerializerSettings()
opts.Converters.Add(MarkupTextConverter()) opts.Converters.Add(MarkupTextConverter())
@ -104,6 +104,20 @@ let markupTextConverterTests = testList "MarkupTextConverter" [
} }
] ]
/// Unit tests for the OpenGraphTypeConverter type
let openGraphTypeConverterTests = testList "OpenGraphTypeConverter" [
let opts = JsonSerializerSettings()
opts.Converters.Add(OpenGraphTypeConverter())
test "succeeds when serializing" {
let after = JsonConvert.SerializeObject(VideoTvShow, opts)
Expect.equal after "\"video.tv_show\"" "OpenGraph type serialized incorrectly"
}
test "succeeds when deserializing" {
let after = JsonConvert.DeserializeObject<OpenGraphType>("\"book\"", opts)
Expect.equal after Book "OpenGraph type deserialized incorrectly"
}
]
/// Unit tests for the PermalinkConverter type /// Unit tests for the PermalinkConverter type
let permalinkConverterTests = testList "PermalinkConverter" [ let permalinkConverterTests = testList "PermalinkConverter" [
let opts = JsonSerializerSettings() let opts = JsonSerializerSettings()
@ -257,6 +271,7 @@ let configureTests = test "Json.configure succeeds" {
Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedSourceConverter>) "Custom feed source converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedSourceConverter>) "Custom feed source converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<ExplicitRatingConverter>) "Explicit rating converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<ExplicitRatingConverter>) "Explicit rating converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<MarkupTextConverter>) "Markup text converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<MarkupTextConverter>) "Markup text converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<OpenGraphTypeConverter>) "OpenGraph type converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PermalinkConverter>) "Permalink converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PermalinkConverter>) "Permalink converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PageIdConverter>) "Page ID converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PageIdConverter>) "Page ID converter not found"
Expect.hasCountOf ser.Converters 1u (has typeof<PodcastMediumConverter>) "Podcast medium converter not found" Expect.hasCountOf ser.Converters 1u (has typeof<PodcastMediumConverter>) "Podcast medium converter not found"
@ -282,6 +297,7 @@ let all = testList "Converters" [
customFeedSourceConverterTests customFeedSourceConverterTests
explicitRatingConverterTests explicitRatingConverterTests
markupTextConverterTests markupTextConverterTests
openGraphTypeConverterTests
permalinkConverterTests permalinkConverterTests
pageIdConverterTests pageIdConverterTests
podcastMediumConverterTests podcastMediumConverterTests

8
src/MyWebLog.Tests/Data/PageDataTests.fs
View File

@ -1,6 +1,6 @@
/// <summary> /// <summary>
/// Integration tests for <see cref="IPageData" /> implementations /// Integration tests for <see cref="IPageData" /> implementations
/// </summary> /// </summary>
module PageDataTests module PageDataTests
open System open System
@ -35,8 +35,9 @@ let ``Add succeeds`` (data: IData) = task {
Text = "<h1>A new page</h1>" Text = "<h1>A new page</h1>"
Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ] Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ]
PriorPermalinks = [ Permalink "2024/the-new-page.htm" ] PriorPermalinks = [ Permalink "2024/the-new-page.htm" ]
Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<h1>A new page</h1>" } ] } Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<h1>A new page</h1>" } ]
do! data.Page.Add page OpenGraph = Some { OpenGraphProperties.Empty with Type = Book } }
do! data.Page.Add page
let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test") let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test")
Expect.isSome stored "The page should have been added" Expect.isSome stored "The page should have been added"
let pg = stored.Value let pg = stored.Value
@ -53,6 +54,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.equal pg.Metadata page.Metadata "Metadata not saved properly" Expect.equal pg.Metadata page.Metadata "Metadata not saved properly"
Expect.equal pg.PriorPermalinks page.PriorPermalinks "Prior permalinks not saved properly" Expect.equal pg.PriorPermalinks page.PriorPermalinks "Prior permalinks not saved properly"
Expect.equal pg.Revisions page.Revisions "Revisions not saved properly" Expect.equal pg.Revisions page.Revisions "Revisions not saved properly"
Expect.equal pg.OpenGraph page.OpenGraph "OpenGraph properties not saved properly"
} }
let ``All succeeds`` (data: IData) = task { let ``All succeeds`` (data: IData) = task {

8
src/MyWebLog.Tests/Data/PostDataTests.fs
View File

@ -1,6 +1,6 @@
/// <summary> /// <summary>
/// Integration tests for <see cref="IPostData" /> implementations /// Integration tests for <see cref="IPostData" /> implementations
/// </summary> /// </summary>
module PostDataTests module PostDataTests
open System open System
@ -54,7 +54,7 @@ let ``Add succeeds`` (data: IData) = task {
{ Id = PostId "a-new-post" { Id = PostId "a-new-post"
WebLogId = WebLogId "test" WebLogId = WebLogId "test"
AuthorId = WebLogUserId "test-author" AuthorId = WebLogUserId "test-author"
Status = Published Status = Published
Title = "A New Test Post" Title = "A New Test Post"
Permalink = Permalink "2020/test-post.html" Permalink = Permalink "2020/test-post.html"
PublishedOn = Some (Noda.epoch + Duration.FromMinutes 1L) PublishedOn = Some (Noda.epoch + Duration.FromMinutes 1L)
@ -66,7 +66,8 @@ let ``Add succeeds`` (data: IData) = task {
Episode = Some { Episode.Empty with Media = "test-ep.mp3" } Episode = Some { Episode.Empty with Media = "test-ep.mp3" }
Metadata = [ { Name = "Meta"; Value = "Data" } ] Metadata = [ { Name = "Meta"; Value = "Data" } ]
PriorPermalinks = [ Permalink "2020/test-post-a.html" ] PriorPermalinks = [ Permalink "2020/test-post-a.html" ]
Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ] } Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ]
OpenGraph = Some { OpenGraphProperties.Empty with Type = VideoMovie } }
do! data.Post.Add post do! data.Post.Add post
let! stored = data.Post.FindFullById post.Id post.WebLogId let! stored = data.Post.FindFullById post.Id post.WebLogId
Expect.isSome stored "The added post should have been retrieved" Expect.isSome stored "The added post should have been retrieved"
@ -87,6 +88,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.equal it.Metadata post.Metadata "Metadata items not saved properly" Expect.equal it.Metadata post.Metadata "Metadata items not saved properly"
Expect.equal it.PriorPermalinks post.PriorPermalinks "Prior permalinks not saved properly" Expect.equal it.PriorPermalinks post.PriorPermalinks "Prior permalinks not saved properly"
Expect.equal it.Revisions post.Revisions "Revisions not saved properly" Expect.equal it.Revisions post.Revisions "Revisions not saved properly"
Expect.equal it.OpenGraph post.OpenGraph "OpenGraph properties not saved correctly"
} }
let ``CountByStatus succeeds`` (data: IData) = task { let ``CountByStatus succeeds`` (data: IData) = task {

8
src/MyWebLog.Tests/Data/WebLogDataTests.fs
View File

@ -1,6 +1,6 @@
/// <summary> /// <summary>
/// Integration tests for <see cref="IWebLogData" /> implementations /// Integration tests for <see cref="IWebLogData" /> implementations
/// </summary> /// </summary>
module WebLogDataTests module WebLogDataTests
open System open System
@ -25,14 +25,15 @@ let ``Add succeeds`` (data: IData) = task {
Rss = Rss =
{ IsFeedEnabled = true { IsFeedEnabled = true
FeedName = "my-feed.xml" FeedName = "my-feed.xml"
ItemsInFeed = None ItemsInFeed = None
IsCategoryEnabled = false IsCategoryEnabled = false
IsTagEnabled = false IsTagEnabled = false
Copyright = Some "go for it" Copyright = Some "go for it"
CustomFeeds = [] } CustomFeeds = [] }
AutoHtmx = true AutoHtmx = true
Uploads = Disk Uploads = Disk
RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ] } RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ]
AutoOpenGraph = false }
let! webLog = data.WebLog.FindById (WebLogId "new-weblog") let! webLog = data.WebLog.FindById (WebLogId "new-weblog")
Expect.isSome webLog "The web log should have been returned" Expect.isSome webLog "The web log should have been returned"
let it = webLog.Value let it = webLog.Value
@ -48,6 +49,7 @@ let ``Add succeeds`` (data: IData) = task {
Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect" Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
Expect.equal it.Uploads Disk "Upload destination is incorrect" Expect.equal it.Uploads Disk "Upload destination is incorrect"
Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect" Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect"
Expect.isFalse it.AutoOpenGraph "Auto OpenGraph flag is incorrect"
let rss = it.Rss let rss = it.Rss
Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect" Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect"
Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect" Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect"

345
src/MyWebLog.Tests/Domain/SupportTypesTests.fs
View File

@ -257,6 +257,346 @@ let markupTextTests = testList "MarkupText" [
] ]
] ]
/// Unit tests for the OpenGraphAudio type
let openGraphAudioTests = testList "OpenGraphAudio" [
testList "Properties" [
test "succeeds with minimum required" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "http://test.this" }.Properties
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:audio", "http://test.this") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "https://test.this" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:audio", "https://test.this") "The URL was not written correctly"
Expect.equal
props[1] ("og:audio:secure_url", "https://test.this") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props =
{ Url = "http://test.this"
SecureUrl = Some "https://test.other"
Type = Some "audio/mpeg" }.Properties
|> Array.ofSeq
Expect.hasLength props 3 "There should be three properties"
Expect.equal props[0] ("og:audio", "http://test.this") "The URL was not written correctly"
Expect.equal
props[1] ("og:audio:secure_url", "https://test.other") "The Secure URL was not written correctly"
Expect.equal props[2] ("og:audio:type", "audio/mpeg") "The MIME type was not written correctly"
}
test "succeeds when deriving AAC" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/this/cool.file.aac" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:audio:type", "audio/aac") "The MIME type for AAC was not derived correctly"
}
test "succeeds when deriving MP3" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/an.other/song.mp3" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:audio:type", "audio/mpeg") "The MIME type for MP3 was not derived correctly"
}
test "succeeds when deriving OGA" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/talks/speex.oga" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:audio:type", "audio/ogg") "The MIME type for OGA was not derived correctly"
}
test "succeeds when deriving WAV" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/some/old.school.wav" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:audio:type", "audio/wav") "The MIME type for WAV was not derived correctly"
}
test "succeeds when deriving WEBA" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/new/format/file.weba" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:audio:type", "audio/webm") "The MIME type for WEBA was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq { OpenGraphAudio.Empty with Url = "/profile.jpg" }.Properties
Expect.hasLength props 1 "There should be one property (only URL; no type derived)"
}
]
]
/// Tests for the OpenGraphImage type
let openGraphImageTests = testList "OpenGraphImage" [
testList "Properties" [
test "succeeds with minimum required" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "http://test.url" }.Properties
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:image", "http://test.url") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "https://secure.url" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:image", "https://secure.url") "The URL was not written correctly"
Expect.equal
props[1] ("og:image:secure_url", "https://secure.url") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props =
{ Url = "http://test.this"
SecureUrl = Some "https://test.other"
Type = Some "image/jpeg"
Width = Some 400
Height = Some 600
Alt = Some "This ought to be good" }.Properties
|> Array.ofSeq
Expect.hasLength props 6 "There should be six properties"
Expect.equal props[0] ("og:image", "http://test.this") "The URL was not written correctly"
Expect.equal
props[1] ("og:image:secure_url", "https://test.other") "The Secure URL was not written correctly"
Expect.equal props[2] ("og:image:type", "image/jpeg") "The MIME type was not written correctly"
Expect.equal props[3] ("og:image:width", "400") "The width was not written correctly"
Expect.equal props[4] ("og:image:height", "600") "The height was not written correctly"
Expect.equal props[5] ("og:image:alt", "This ought to be good") "The alt text was not written correctly"
}
test "succeeds when deriving BMP" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/old/windows.bmp" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/bmp") "The MIME type for BMP was not derived correctly"
}
test "succeeds when deriving GIF" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/its.a.soft.g.gif" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/gif") "The MIME type for GIF was not derived correctly"
}
test "succeeds when deriving ICO" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/favicon.ico" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal
props[1] ("og:image:type", "image/vnd.microsoft.icon") "The MIME type for ICO was not derived correctly"
}
test "succeeds when deriving JPEG" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/big/name/photo.jpeg" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/jpeg") "The MIME type for JPEG was not derived correctly"
}
test "succeeds when deriving PNG" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/some/nice/graphic.png" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/png") "The MIME type for PNG was not derived correctly"
}
test "succeeds when deriving SVG" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/fancy-new-vector.svg" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/svg+xml") "The MIME type for SVG was not derived correctly"
}
test "succeeds when deriving TIF" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/tagged/file.tif" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/tiff") "The MIME type for TIF was not derived correctly"
}
test "succeeds when deriving TIFF" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/tagged/file.two.tiff" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/tiff") "The MIME type for TIFF was not derived correctly"
}
test "succeeds when deriving WEBP" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/modern/photo.webp" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:image:type", "image/webp") "The MIME type for WEBP was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq { OpenGraphImage.Empty with Url = "/intro.mp3" }.Properties
Expect.hasLength props 1 "There should be one property (only URL; no type derived)"
}
]
]
/// Unit tests for the OpenGraphVideo type
let openGraphVideoTests = testList "OpenGraphVideo" [
testList "Properties" [
test "succeeds with minimum required" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "http://url.test" }.Properties
Expect.hasLength props 1 "There should be one property"
Expect.equal props[0] ("og:video", "http://url.test") "The URL was not written correctly"
}
test "succeeds with secure URL" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "https://url.secure" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[0] ("og:video", "https://url.secure") "The URL was not written correctly"
Expect.equal
props[1] ("og:video:secure_url", "https://url.secure") "The Secure URL was not written correctly"
}
test "succeeds with all properties filled" {
let props =
{ Url = "http://test.this"
SecureUrl = Some "https://test.other"
Type = Some "video/mpeg"
Width = Some 1200
Height = Some 900 }.Properties
|> Array.ofSeq
Expect.hasLength props 5 "There should be five properties"
Expect.equal props[0] ("og:video", "http://test.this") "The URL was not written correctly"
Expect.equal
props[1] ("og:video:secure_url", "https://test.other") "The Secure URL was not written correctly"
Expect.equal props[2] ("og:video:type", "video/mpeg") "The MIME type was not written correctly"
Expect.equal props[3] ("og:video:width", "1200") "The width was not written correctly"
Expect.equal props[4] ("og:video:height", "900") "The height was not written correctly"
}
test "succeeds when deriving AVI" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/my.video.avi" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:video:type", "video/x-msvideo") "The MIME type for AVI was not derived correctly"
}
test "succeeds when deriving MP4" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/chapters/1/01.mp4" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:video:type", "video/mp4") "The MIME type for MP4 was not derived correctly"
}
test "succeeds when deriving MPEG" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/viral/video.mpeg" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:video:type", "video/mpeg") "The MIME type for MPEG was not derived correctly"
}
test "succeeds when deriving OGV" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/open/video/example.ogv" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:video:type", "video/ogg") "The MIME type for OGV was not derived correctly"
}
test "succeeds when deriving WEBM" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/images/hero.webm" }.Properties
Expect.hasLength props 2 "There should be two properties"
Expect.equal props[1] ("og:video:type", "video/webm") "The MIME type for WEBM was not derived correctly"
}
test "succeeds when type cannot be derived" {
let props = Array.ofSeq { OpenGraphVideo.Empty with Url = "/favicon.ico" }.Properties
Expect.hasLength props 1 "There should be one property (only URL; no type derived)"
}
]
]
/// Unit tests for the OpenGraphType type
let openGraphTypeTests = testList "OpenGraphType" [
testList "Parse" [
test "succeeds for \"article\"" {
Expect.equal (OpenGraphType.Parse "article") Article "\"article\" not parsed correctly"
}
test "succeeds for \"book\"" {
Expect.equal (OpenGraphType.Parse "book") Book "\"book\" not parsed correctly"
}
test "succeeds for \"music.album\"" {
Expect.equal (OpenGraphType.Parse "music.album") MusicAlbum "\"music.album\" not parsed correctly"
}
test "succeeds for \"music.playlist\"" {
Expect.equal (OpenGraphType.Parse "music.playlist") MusicPlaylist "\"music.playlist\" not parsed correctly"
}
test "succeeds for \"music.radio_station\"" {
Expect.equal
(OpenGraphType.Parse "music.radio_station")
MusicRadioStation
"\"music.radio_station\" not parsed correctly"
}
test "succeeds for \"music.song\"" {
Expect.equal (OpenGraphType.Parse "music.song") MusicSong "\"music.song\" not parsed correctly"
}
test "succeeds for \"payment.link\"" {
Expect.equal (OpenGraphType.Parse "payment.link") PaymentLink "\"payment.link\" not parsed correctly"
}
test "succeeds for \"profile\"" {
Expect.equal (OpenGraphType.Parse "profile") Profile "\"profile\" not parsed correctly"
}
test "succeeds for \"video.episode\"" {
Expect.equal (OpenGraphType.Parse "video.episode") VideoEpisode "\"video.episode\" not parsed correctly"
}
test "succeeds for \"video.movie\"" {
Expect.equal (OpenGraphType.Parse "video.movie") VideoMovie "\"video.movie\" not parsed correctly"
}
test "succeeds for \"video.other\"" {
Expect.equal (OpenGraphType.Parse "video.other") VideoOther "\"video.other\" not parsed correctly"
}
test "succeeds for \"video.tv_show\"" {
Expect.equal (OpenGraphType.Parse "video.tv_show") VideoTvShow "\"video.tv_show\" not parsed correctly"
}
test "succeeds for \"website\"" {
Expect.equal (OpenGraphType.Parse "website") Website "\"website\" not parsed correctly"
}
test "fails for invalid type" {
Expect.throwsT<ArgumentException>
(fun () -> ignore (OpenGraphType.Parse "anthology")) "Invalid value should have raised an exception"
}
]
testList "ToString" [
test "succeeds for Article" {
Expect.equal (string Article) "article" "Article string incorrect"
}
test "succeeds for Book" {
Expect.equal (string Book) "book" "Book string incorrect"
}
test "succeeds for MusicAlbum" {
Expect.equal (string MusicAlbum) "music.album" "MusicAlbum string incorrect"
}
test "succeeds for MusicPlaylist" {
Expect.equal (string MusicPlaylist) "music.playlist" "MusicPlaylist string incorrect"
}
test "succeeds for MusicRadioStation" {
Expect.equal (string MusicRadioStation) "music.radio_station" "MusicRadioStation string incorrect"
}
test "succeeds for MusicSong" {
Expect.equal (string MusicSong) "music.song" "MusicSong string incorrect"
}
test "succeeds for PaymentLink" {
Expect.equal (string PaymentLink) "payment.link" "PaymentLink string incorrect"
}
test "succeeds for Profile" {
Expect.equal (string Profile) "profile" "Profile string incorrect"
}
test "succeeds for VideoEpisode" {
Expect.equal (string VideoEpisode) "video.episode" "VideoEpisode string incorrect"
}
test "succeeds for VideoMovie" {
Expect.equal (string VideoMovie) "video.movie" "VideoMovie string incorrect"
}
test "succeeds for VideoOther" {
Expect.equal (string VideoOther) "video.other" "VideoOther string incorrect"
}
test "succeeds for VideoTvShow" {
Expect.equal (string VideoTvShow) "video.tv_show" "VideoTvShow string incorrect"
}
test "succeeds for Website" {
Expect.equal (string Website) "website" "Website string incorrect"
}
]
]
/// Unit tests for the OpenGraphProperties type
let openGraphPropertiesTests = testList "OpenGraphProperties" [
testList "Properties" [
test "succeeds with minimal values" {
let props =
{ OpenGraphProperties.Empty with
Image = { OpenGraphImage.Empty with Url = "http://this.aint.nothing" } }.Properties
|> Array.ofSeq
Expect.hasLength props 2 "There should have been two properties"
Expect.equal props[0] ("og:type", "article") "Type not written correctly"
Expect.equal props[1] ("og:image", "http://this.aint.nothing") "Image URL not written correctly"
}
test "succeeds with all values" {
let props =
{ Type = Book
Image = { OpenGraphImage.Empty with Url = "http://this.image.file" }
Audio = Some { OpenGraphAudio.Empty with Url = "http://this.audio.file" }
Description = Some "This is a unit test"
Determiner = Some "a"
Locale = Some "en_US"
LocaleAlternate = Some [ "en_UK"; "es_MX" ]
Video = Some { OpenGraphVideo.Empty with Url = "http://this.video.file" }
Other = Some [ { Name = "book.publisher"; Value = "Yep" } ] }.Properties
|> Array.ofSeq
Expect.hasLength props 10 "There should have been ten properties"
Expect.equal props[0] ("og:type", "book") "Type not written correctly"
Expect.equal props[1] ("og:image", "http://this.image.file") "Image URL not written correctly"
Expect.equal props[2] ("og:description", "This is a unit test") "Description not written correctly"
Expect.equal props[3] ("og:determiner", "a") "Determiner not written correctly"
Expect.equal props[4] ("og:locale", "en_US") "Locale not written correctly"
Expect.equal props[5] ("og:locale:alternate", "en_UK") "1st Alternate Locale not written correctly"
Expect.equal props[6] ("og:locale:alternate", "es_MX") "2nd Alternate Locale not written correctly"
Expect.equal props[7] ("og:audio", "http://this.audio.file") "Audio URL not written correctly"
Expect.equal props[8] ("og:video", "http://this.video.file") "Video URL not written correctly"
Expect.equal props[9] ("book.publisher", "Yep") "Other property not written correctly"
}
]
]
/// Unit tests for the PodcastMedium type /// Unit tests for the PodcastMedium type
let podcastMediumTests = testList "PodcastMedium" [ let podcastMediumTests = testList "PodcastMedium" [
testList "Parse" [ testList "Parse" [
@ -407,6 +747,11 @@ let all = testList "SupportTypes" [
explicitRatingTests explicitRatingTests
episodeTests episodeTests
markupTextTests markupTextTests
openGraphAudioTests
openGraphImageTests
openGraphVideoTests
openGraphTypeTests
openGraphPropertiesTests
podcastMediumTests podcastMediumTests
postStatusTests postStatusTests
customFeedSourceTests customFeedSourceTests

56
src/MyWebLog.Tests/Domain/ViewModelsTests.fs
View File

@ -233,7 +233,7 @@ let testFullPost =
ImageUrl = Some "uploads/podcast-cover.jpg" ImageUrl = Some "uploads/podcast-cover.jpg"
Subtitle = Some "Narration" Subtitle = Some "Narration"
Explicit = Some Clean Explicit = Some Clean
Chapters = None Chapters = None
ChapterFile = Some "uploads/1970/01/chapters.txt" ChapterFile = Some "uploads/1970/01/chapters.txt"
ChapterType = Some "chapters" ChapterType = Some "chapters"
ChapterWaypoints = Some true ChapterWaypoints = Some true
@ -666,7 +666,7 @@ let editPostModelTests = testList "EditPostModel" [
{ testFullPost.Episode.Value with { testFullPost.Episode.Value with
Chapters = Some [] Chapters = Some []
ChapterFile = None ChapterFile = None
ChapterType = None } } ChapterType = None } }
Expect.equal model.ChapterSource "internal" "ChapterSource not filled properly" Expect.equal model.ChapterSource "internal" "ChapterSource not filled properly"
} }
] ]
@ -677,7 +677,7 @@ let editPostModelTests = testList "EditPostModel" [
model.Source <- "HTML" model.Source <- "HTML"
model.Text <- "<p>An updated post!</p>" model.Text <- "<p>An updated post!</p>"
model.Tags <- "Zebras, Aardvarks, , Turkeys" model.Tags <- "Zebras, Aardvarks, , Turkeys"
model.Template <- "updated" model.Template <- "updated"
model.CategoryIds <- [| "cat-x"; "cat-y" |] model.CategoryIds <- [| "cat-x"; "cat-y" |]
model.MetaNames <- [| "Zed Meta"; "A Meta" |] model.MetaNames <- [| "Zed Meta"; "A Meta" |]
model.MetaValues <- [| "A Value"; "Zed Value" |] model.MetaValues <- [| "A Value"; "Zed Value" |]
@ -688,7 +688,7 @@ let editPostModelTests = testList "EditPostModel" [
model.ImageUrl <- "updated-cover.png" model.ImageUrl <- "updated-cover.png"
model.Subtitle <- "Talking" model.Subtitle <- "Talking"
model.Explicit <- "no" model.Explicit <- "no"
model.ChapterSource <- "external" model.ChapterSource <- "external"
model.ChapterFile <- "updated-chapters.txt" model.ChapterFile <- "updated-chapters.txt"
model.ChapterType <- "indexes" model.ChapterType <- "indexes"
model.TranscriptUrl <- "updated-transcript.txt" model.TranscriptUrl <- "updated-transcript.txt"
@ -696,7 +696,7 @@ let editPostModelTests = testList "EditPostModel" [
model.TranscriptLang <- "ES-mx" model.TranscriptLang <- "ES-mx"
model.SeasonNumber <- 4 model.SeasonNumber <- 4
model.SeasonDescription <- "Season Fo" model.SeasonDescription <- "Season Fo"
model.EpisodeNumber <- "432.1" model.EpisodeNumber <- "432.1"
model.EpisodeDescription <- "Four Three Two pt One" model.EpisodeDescription <- "Four Three Two pt One"
model model
testList "UpdatePost" [ testList "UpdatePost" [
@ -760,7 +760,7 @@ let editPostModelTests = testList "EditPostModel" [
minModel.SeasonNumber <- 0 minModel.SeasonNumber <- 0
minModel.SeasonDescription <- "" minModel.SeasonDescription <- ""
minModel.EpisodeNumber <- "" minModel.EpisodeNumber <- ""
minModel.EpisodeDescription <- "" minModel.EpisodeDescription <- ""
let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500) let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500)
Expect.isSome post.Episode "There should have been a podcast episode" Expect.isSome post.Episode "There should have been a podcast episode"
let ep = post.Episode.Value let ep = post.Episode.Value
@ -785,7 +785,7 @@ let editPostModelTests = testList "EditPostModel" [
} }
test "succeeds for a podcast episode with internal chapters" { test "succeeds for a podcast episode with internal chapters" {
let minModel = updatedModel () let minModel = updatedModel ()
minModel.ChapterSource <- "internal" minModel.ChapterSource <- "internal"
minModel.ChapterFile <- "" minModel.ChapterFile <- ""
minModel.ChapterType <- "" minModel.ChapterType <- ""
let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500) let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500)
@ -977,7 +977,7 @@ let editUserModelTests = testList "EditUserModel" [
let model = let model =
{ Id = "test-user" { Id = "test-user"
AccessLevel = "WebLogAdmin" AccessLevel = "WebLogAdmin"
Email = "again@example.com" Email = "again@example.com"
Url = "" Url = ""
FirstName = "Another" FirstName = "Another"
LastName = "One" LastName = "One"
@ -1115,10 +1115,10 @@ let postListItemTests = testList "PostListItem" [
{ Post.Empty with { Post.Empty with
Id = PostId "full-post" Id = PostId "full-post"
AuthorId = WebLogUserId "me" AuthorId = WebLogUserId "me"
Status = Published Status = Published
Title = "Finished Product" Title = "Finished Product"
Permalink = Permalink "2021/post.html" Permalink = Permalink "2021/post.html"
PublishedOn = Some (Noda.epoch + Duration.FromHours 12) PublishedOn = Some (Noda.epoch + Duration.FromHours 12)
UpdatedOn = Noda.epoch + Duration.FromHours 13 UpdatedOn = Noda.epoch + Duration.FromHours 13
Text = """<a href="/other-post.html">Click</a>""" Text = """<a href="/other-post.html">Click</a>"""
CategoryIds = [ CategoryId "z"; CategoryId "y" ] CategoryIds = [ CategoryId "z"; CategoryId "y" ]
@ -1157,13 +1157,14 @@ let settingsModelTests = testList "SettingsModel" [
let model = let model =
SettingsModel.FromWebLog SettingsModel.FromWebLog
{ WebLog.Empty with { WebLog.Empty with
Name = "The Web Log" Name = "The Web Log"
Slug = "the-web-log" Slug = "the-web-log"
DefaultPage = "this-one" DefaultPage = "this-one"
PostsPerPage = 18 PostsPerPage = 18
TimeZone = "America/Denver" TimeZone = "America/Denver"
ThemeId = ThemeId "my-theme" ThemeId = ThemeId "my-theme"
AutoHtmx = true } AutoHtmx = true
AutoOpenGraph = false }
Expect.equal model.Name "The Web Log" "Name not filled properly" Expect.equal model.Name "The Web Log" "Name not filled properly"
Expect.equal model.Slug "the-web-log" "Slug not filled properly" Expect.equal model.Slug "the-web-log" "Slug not filled properly"
Expect.equal model.Subtitle "" "Subtitle not filled properly" Expect.equal model.Subtitle "" "Subtitle not filled properly"
@ -1173,6 +1174,7 @@ let settingsModelTests = testList "SettingsModel" [
Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly" Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly"
Expect.isTrue model.AutoHtmx "AutoHtmx should have been set" Expect.isTrue model.AutoHtmx "AutoHtmx should have been set"
Expect.equal model.Uploads "Database" "Uploads not filled properly" Expect.equal model.Uploads "Database" "Uploads not filled properly"
Expect.isFalse model.AutoOpenGraph "AutoOpenGraph should have been unset"
} }
test "succeeds with a subtitle" { test "succeeds with a subtitle" {
let model = SettingsModel.FromWebLog { WebLog.Empty with Subtitle = Some "sub here!" } let model = SettingsModel.FromWebLog { WebLog.Empty with Subtitle = Some "sub here!" }
@ -1182,15 +1184,16 @@ let settingsModelTests = testList "SettingsModel" [
testList "Update" [ testList "Update" [
test "succeeds with no subtitle" { test "succeeds with no subtitle" {
let webLog = let webLog =
{ Name = "Interesting" { Name = "Interesting"
Slug = "some-stuff" Slug = "some-stuff"
Subtitle = "" Subtitle = ""
DefaultPage = "that-one" DefaultPage = "that-one"
PostsPerPage = 8 PostsPerPage = 8
TimeZone = "America/Chicago" TimeZone = "America/Chicago"
ThemeId = "test-theme" ThemeId = "test-theme"
AutoHtmx = true AutoHtmx = true
Uploads = "Disk" }.Update WebLog.Empty Uploads = "Disk"
AutoOpenGraph = false }.Update WebLog.Empty
Expect.equal webLog.Name "Interesting" "Name not filled properly" Expect.equal webLog.Name "Interesting" "Name not filled properly"
Expect.equal webLog.Slug "some-stuff" "Slug not filled properly" Expect.equal webLog.Slug "some-stuff" "Slug not filled properly"
Expect.isNone webLog.Subtitle "Subtitle should not have had a value" Expect.isNone webLog.Subtitle "Subtitle should not have had a value"
@ -1200,6 +1203,7 @@ let settingsModelTests = testList "SettingsModel" [
Expect.equal webLog.ThemeId (ThemeId "test-theme") "ThemeId not filled properly" Expect.equal webLog.ThemeId (ThemeId "test-theme") "ThemeId not filled properly"
Expect.isTrue webLog.AutoHtmx "AutoHtmx should have been set" Expect.isTrue webLog.AutoHtmx "AutoHtmx should have been set"
Expect.equal webLog.Uploads Disk "Uploads not filled properly" Expect.equal webLog.Uploads Disk "Uploads not filled properly"
Expect.isFalse webLog.AutoOpenGraph "AutoOpenGraph should have been unset"
} }
test "succeeds with a subtitle" { test "succeeds with a subtitle" {
let webLog = { SettingsModel.FromWebLog WebLog.Empty with Subtitle = "Sub" }.Update WebLog.Empty let webLog = { SettingsModel.FromWebLog WebLog.Empty with Subtitle = "Sub" }.Update WebLog.Empty

23
src/MyWebLog.Tests/Program.fs
View File

@ -10,20 +10,19 @@ let sqliteOnly = (RethinkDbDataTests.env "SQLITE_ONLY" "0") = "1"
let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1" let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1"
/// Whether any of the data tests are being isolated /// Whether any of the data tests are being isolated
let dbOnly = rethinkOnly || sqliteOnly || postgresOnly let allDatabases = not (rethinkOnly || sqliteOnly || postgresOnly)
/// Whether to only run the unit tests (skip database/integration tests)
let unitOnly = (RethinkDbDataTests.env "UNIT_ONLY" "0") = "1"
let allTests = testList "MyWebLog" [ let allTests = testList "MyWebLog" [
if not dbOnly then testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ] // Skip unit tests if running an isolated database test
if not unitOnly then if allDatabases then
testList "Data" [ testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ]
if not dbOnly then ConvertersTests.all testList "Data (Unit)" [ ConvertersTests.all; UtilsTests.all ]
if not dbOnly then UtilsTests.all // Whether to skip integration tests
if not dbOnly || (dbOnly && rethinkOnly) then RethinkDbDataTests.all if RethinkDbDataTests.env "UNIT_ONLY" "0" <> "1" then
if not dbOnly || (dbOnly && sqliteOnly) then SQLiteDataTests.all testList "Data (Integration)" [
if not dbOnly || (dbOnly && postgresOnly) then PostgresDataTests.all if allDatabases || rethinkOnly then RethinkDbDataTests.all
if allDatabases || sqliteOnly then SQLiteDataTests.all
if allDatabases || postgresOnly then PostgresDataTests.all
] ]
] ]

22
src/MyWebLog/Template.fs
View File

@ -192,7 +192,12 @@ let parser =
let attrEnc = System.Web.HttpUtility.HtmlAttributeEncode let attrEnc = System.Web.HttpUtility.HtmlAttributeEncode
// OpenGraph tags // OpenGraph tags
if app.IsPage || app.IsPost then let doOpenGraph =
(app.WebLog.AutoOpenGraph && (app.IsPage || app.IsPost))
|| (app.IsPage && Option.isSome app.Page.OpenGraph)
|| (app.IsPost && Option.isSome app.Posts.Posts[0].OpenGraph)
if doOpenGraph then
let writeOgProp (name, value) = let writeOgProp (name, value) =
writer.WriteLine $"""{s}<meta property=%s{name} content="{attrEnc value}">""" writer.WriteLine $"""{s}<meta property=%s{name} content="{attrEnc value}">"""
writeOgProp ("og:title", if app.IsPage then app.Page.Title else app.Posts.Posts[0].Title) writeOgProp ("og:title", if app.IsPage then app.Page.Title else app.Posts.Posts[0].Title)
@ -202,20 +207,7 @@ let parser =
|> app.WebLog.AbsoluteUrl |> app.WebLog.AbsoluteUrl
|> function url -> writeOgProp ("og:url", url) |> function url -> writeOgProp ("og:url", url)
match if app.IsPage then app.Page.OpenGraph else app.Posts.Posts[0].OpenGraph with match if app.IsPage then app.Page.OpenGraph else app.Posts.Posts[0].OpenGraph with
| Some props -> | Some props -> props.Properties |> Seq.iter writeOgProp
writeOgProp ("og:type", string props.Type)
props.Image.Properties |> Seq.iter writeOgProp
match props.Description with Some desc -> writeOgProp ("og:description", desc) | None -> ()
match props.Determiner with Some det -> writeOgProp ("og:determiner", det) | None -> ()
match props.Locale with Some loc -> writeOgProp ("og:locale", loc) | None -> ()
match props.LocaleAlternate with
| Some alt -> alt |> List.iter (fun it -> writeOgProp ("og:locale:alternate", it))
| None -> ()
match props.Audio with Some audio -> audio.Properties |> Seq.iter writeOgProp | None -> ()
match props.Video with Some video -> video.Properties |> Seq.iter writeOgProp | None -> ()
match props.Other with
| Some oth -> oth |> List.iter (fun it -> writeOgProp (it.Name, it.Value))
| None -> ()
| None -> () | None -> ()
writer.WriteLine $"""{s}<meta name=generator content="{app.Generator}">""" writer.WriteLine $"""{s}<meta name=generator content="{app.Generator}">"""

7
src/MyWebLog/Views/WebLog.fs
View File

@ -795,6 +795,13 @@ let webLogSettings
selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads
string string [] string string []
] ]
div [ _class "col-12 col-md-6 offset-md-3 col-xl-4 offset-xl-4" ] [
checkboxSwitch [] (nameof model.AutoOpenGraph) "Auto-Add OpenGraph Properties"
model.AutoOpenGraph []
span [ _class "form-text fst-italic" ] [
raw "Adds title, site name, and permalink to all pages and posts"
]
]
] ]
div [ _class "row pb-3" ] [ div [ _class "row pb-3" ] [
div [ _class "col text-center" ] [ div [ _class "col text-center" ] [