diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 42b2f8b..e8469d3 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -65,6 +65,14 @@ module Json = override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) = (string >> MarkupText.Parse) reader.Value + /// Converter for the type + type OpenGraphTypeConverter() = + inherit JsonConverter() + override _.WriteJson(writer: JsonWriter, value: OpenGraphType, _: JsonSerializer) = + writer.WriteValue(string value) + override _.ReadJson(reader: JsonReader, _: Type, _: OpenGraphType, _: bool, _: JsonSerializer) = + (string >> OpenGraphType.Parse) reader.Value + /// Converter for the type type PermalinkConverter() = inherit JsonConverter() @@ -159,6 +167,7 @@ module Json = CustomFeedSourceConverter() ExplicitRatingConverter() MarkupTextConverter() + OpenGraphTypeConverter() PermalinkConverter() PageIdConverter() PodcastMediumConverter() diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 0bc1bd8..14b6f21 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -10,17 +10,17 @@ open Npgsql.FSharp /// Data implementation for PostgreSQL type PostgresData(log: ILogger, ser: JsonSerializer) = - + /// Create any needed tables let ensureTables () = backgroundTask { // Set up the PostgreSQL document store Configuration.useSerializer (Utils.createDocumentSerializer ser) - + let! tables = Custom.list "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename") let needsTable table = not (List.contains table tables) - + let sql = seq { // Theme tables if needsTable Table.Theme then @@ -33,25 +33,25 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = updated_on TIMESTAMPTZ NOT NULL, data BYTEA NOT NULL, PRIMARY KEY (theme_id, path))" - + // Web log table if needsTable Table.WebLog then Query.Definition.ensureTable Table.WebLog Query.Definition.ensureKey Table.WebLog PostgreSQL Query.Definition.ensureDocumentIndex Table.WebLog Optimized - + // Category table if needsTable Table.Category then Query.Definition.ensureTable Table.Category Query.Definition.ensureKey Table.Category PostgreSQL Query.Definition.ensureDocumentIndex Table.Category Optimized - + // Web log user table if needsTable Table.WebLogUser then Query.Definition.ensureTable Table.WebLogUser Query.Definition.ensureKey Table.WebLogUser PostgreSQL Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized - + // Page tables if needsTable Table.Page then Query.Definition.ensureTable Table.Page @@ -65,7 +65,7 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = as_of TIMESTAMPTZ NOT NULL, revision_text TEXT NOT NULL, PRIMARY KEY (page_id, as_of))" - + // Post tables if needsTable Table.Post then Query.Definition.ensureTable Table.Post @@ -90,13 +90,13 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = Query.Definition.ensureTable Table.PostComment Query.Definition.ensureKey Table.PostComment PostgreSQL Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL - + // Tag map table if needsTable Table.TagMap then Query.Definition.ensureTable Table.TagMap Query.Definition.ensureKey Table.TagMap PostgreSQL Query.Definition.ensureDocumentIndex Table.TagMap Optimized - + // Uploaded file table if needsTable Table.Upload then $"CREATE TABLE {Table.Upload} ( @@ -107,13 +107,13 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = data BYTEA NOT NULL)" $"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)" $"CREATE INDEX idx_upload_path ON {Table.Upload} (web_log_id, path)" - + // Database version table if needsTable Table.DbVersion then $"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)" $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" } - + Configuration.dataSource () |> Sql.fromDataSource |> Sql.executeTransactionAsync @@ -128,13 +128,13 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = |> Async.RunSynchronously |> ignore } - + /// Set a specific database version let setDbVersion version = backgroundTask { do! Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" [] return version } - + /// Migrate from v2-rc2 to v2 (manual migration required) let migrateV2Rc2ToV2 () = backgroundTask { let! webLogs = @@ -152,11 +152,11 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = let tables = [ Table.Category; Table.Page; Table.Post; Table.PostComment; Table.TagMap; Table.Theme; Table.WebLog Table.WebLogUser ] - + Utils.Migration.logStep log migration "Adding unique indexes on ID fields" do! Custom.nonQuery (tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") [] - + Utils.Migration.logStep log migration "Removing constraints" let fkToDrop = [ "page_revision", "page_revision_page_id_fkey" @@ -176,17 +176,17 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = |> List.map (fun (tbl, fk) -> $"ALTER TABLE {tbl} DROP CONSTRAINT {fk}") |> String.concat "; ") [] - + Utils.Migration.logStep log migration "Dropping old indexes" let toDrop = [ "idx_category"; "page_author_idx"; "page_permalink_idx"; "page_web_log_idx"; "post_author_idx" "post_category_idx"; "post_permalink_idx"; "post_status_idx"; "post_tag_idx"; "post_web_log_idx" "post_comment_post_idx"; "idx_tag_map"; "idx_web_log"; "idx_web_log_user" ] do! Custom.nonQuery (toDrop |> List.map (sprintf "DROP INDEX %s") |> String.concat "; ") [] - + Utils.Migration.logStep log migration "Dropping old ID columns" do! Custom.nonQuery (tables |> List.map (sprintf "ALTER TABLE %s DROP COLUMN id") |> String.concat "; ") [] - + Utils.Migration.logStep log migration "Adding new indexes" let newIdx = [ yield! tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) @@ -209,7 +209,7 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = $"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))" Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL ] do! Custom.nonQuery (newIdx |> String.concat "; ") [] - + Utils.Migration.logStep log migration "Setting database to version 2.1.1" return! setDbVersion "v2.1.1" } @@ -224,33 +224,45 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = return! setDbVersion "v2.2" } + /// Migrate from v2.2 to v3 + let migrateV2point2ToV3 () = backgroundTask { + Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs" + do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |} + Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3" + return! setDbVersion "v3" + } + /// Do required data migration between versions let migrate version = backgroundTask { let mutable v = defaultArg version "" - if v = "v2-rc2" then + if v = "v2-rc2" then let! webLogs = Custom.list $"SELECT url_base, slug FROM {Table.WebLog}" [] (fun row -> row.string "url_base", row.string "slug") Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs - + if v = "v2" then let! ver = migrateV2ToV2point1point1 () v <- ver - + if v = "v2.1.1" then let! ver = migrateV2point1point1ToV2point2 () v <- ver - + + if v = "v2.2" then + let! ver = migrateV2point2ToV3 () + v <- ver + if v <> Utils.Migration.currentDbVersion then log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" let! _ = setDbVersion Utils.Migration.currentDbVersion () } - + interface IData with - + member _.Category = PostgresCategoryData log member _.Page = PostgresPageData log member _.Post = PostgresPostData log @@ -260,13 +272,13 @@ type PostgresData(log: ILogger, ser: JsonSerializer) = member _.Upload = PostgresUploadData log member _.WebLog = PostgresWebLogData log member _.WebLogUser = PostgresWebLogUserData log - + member _.Serializer = ser - + member _.StartUp () = backgroundTask { log.LogTrace "PostgresData.StartUp" do! ensureTables () - + let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id") do! migrate version } diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 938ae32..18e0cf5 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -6,38 +6,38 @@ open RethinkDb.Driver /// Functions to assist with retrieving data module private RethinkHelpers = - + /// Table names [] module Table = - + /// The category table let Category = "Category" /// The comment table let Comment = "Comment" - + /// The database version table let DbVersion = "DbVersion" - + /// The page table let Page = "Page" - + /// The post table let Post = "Post" - + /// The tag map table let TagMap = "TagMap" - + /// The theme table let Theme = "Theme" - + /// The theme asset table let ThemeAsset = "ThemeAsset" - + /// The uploaded file table let Upload = "Upload" - + /// The web log table let WebLog = "WebLog" @@ -47,24 +47,24 @@ module private RethinkHelpers = /// A list of all tables let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ] - + /// Index names for indexes not on a data item's name [] module Index = - + /// An index by web log ID and e-mail address let LogOn = "LogOn" - + /// An index by web log ID and uploaded file path let WebLogAndPath = "WebLogAndPath" - + /// An index by web log ID and mapped tag let WebLogAndTag = "WebLogAndTag" - + /// An index by web log ID and tag URL value let WebLogAndUrl = "WebLogAndUrl" - + /// Shorthand for the ReQL starting point let r = RethinkDB.R @@ -73,14 +73,14 @@ module private RethinkHelpers = fun conn -> backgroundTask { match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None } - + /// Get the first item from a list, or None if the list is empty let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) = fun conn -> backgroundTask { let! results = f conn return results |> List.tryHead } - + /// Cast a strongly-typed list to an object list let objList<'T> (objects: 'T list) = objects |> List.map (fun it -> it :> obj) @@ -93,16 +93,16 @@ open RethinkHelpers /// RethinkDB implementation of data functions for myWebLog type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger) = - + /// Match theme asset IDs by their prefix (the theme ID) let matchAssetByThemeId themeId = let keyPrefix = $"^{themeId}/" fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj - + /// Function to exclude template text from themes let withoutTemplateText (row: Ast.ReqlExpr) : obj = {| Templates = row[nameof Theme.Empty.Templates].Merge(r.HashMap(nameof ThemeTemplate.Empty.Text, "")) |} - + /// Ensure field indexes exist, as well as special indexes for selected tables let ensureIndexes table fields = backgroundTask { let! indexes = rethink { withTable table; indexList; result; withRetryOnce conn } @@ -180,13 +180,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger()) - + /// Delete assets for the given theme ID let deleteAssetsByTheme themeId = rethink { withTable Table.ThemeAsset @@ -194,7 +194,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger obj ] write; withRetryOnce; ignoreResult conn } - + Utils.Migration.logStep log "v2 to v2.1" "Setting database version to v2.1" do! setDbVersion "v2.1" } - + /// Migrate from v2.1 to v2.1.1 let migrateV2point1ToV2point1point1 () = backgroundTask { Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required" @@ -256,10 +256,22 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger obj ] + write; withRetryOnce; ignoreResult conn + } + Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3" + do! setDbVersion "v3" + } + /// Migrate data between versions let migrate version = backgroundTask { let mutable v = defaultArg version "" - + if v = "v2-rc1" then do! migrateV2Rc1ToV2Rc2 () v <- "v2-rc2" @@ -267,38 +279,42 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger Utils.Migration.currentDbVersion then log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" do! setDbVersion Utils.Migration.currentDbVersion } - + /// The connection for this instance member _.Conn = conn - + interface IData with - + member _.Category = { new ICategoryData with - + member _.Add cat = rethink { withTable Table.Category insert cat write; withRetryDefault; ignoreResult conn } - + member _.CountAll webLogId = rethink { withTable Table.Category getAll [ webLogId ] (nameof Category.Empty.WebLogId) @@ -313,7 +329,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Category @@ -353,7 +369,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger Option.defaultValue 0 }) |> Array.ofSeq } - + member _.FindById catId webLogId = rethink { withTable Table.Category @@ -361,13 +377,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger verifyWebLog webLogId _.WebLogId <| conn - + member _.FindByWebLog webLogId = rethink { withTable Table.Category getAll [ webLogId ] (nameof Category.Empty.WebLogId) result; withRetryDefault conn } - + member this.Delete catId webLogId = backgroundTask { match! this.FindById catId webLogId with | Some cat -> @@ -394,7 +410,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger obj) - write; withRetryDefault; ignoreResult conn + write; withRetryDefault; ignoreResult conn } // Delete the category itself do! rethink { @@ -406,7 +422,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return CategoryNotFound } - + member _.Restore cats = backgroundTask { for batch in cats |> List.chunkBySize restoreBatchSize do do! rethink { @@ -415,7 +431,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger row[nameof Page.Empty.Title].Downcase() :> obj) result; withRetryDefault conn } - + member _.CountAll webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof Page.Empty.WebLogId) @@ -473,7 +489,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger 0UL } - + member _.FindById pageId webLogId = rethink { withTable Table.Page @@ -495,7 +511,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindCurrentPermalink permalinks webLogId = backgroundTask { let! result = (rethink { @@ -509,7 +525,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst) conn return result |> Option.map _.Permalink } - + member _.FindFullById pageId webLogId = rethink { withTable Table.Page @@ -517,13 +533,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger verifyWebLog webLogId _.WebLogId <| conn - + member _.FindFullByWebLog webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof Page.Empty.WebLogId) resultCursor; withRetryCursorDefault; toList conn } - + member _.FindListed webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof Page.Empty.WebLogId) @@ -546,7 +562,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger List.chunkBySize restoreBatchSize do do! rethink { @@ -555,7 +571,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger @@ -586,16 +602,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return false } } - + member _.Post = { new IPostData with - + member _.Add post = rethink { withTable Table.Post insert post write; withRetryDefault; ignoreResult conn } - + member _.CountByStatus status webLogId = rethink { withTable Table.Post getAll [ webLogId ] (nameof Post.Empty.WebLogId) @@ -614,7 +630,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger 0UL } - + member _.FindById postId webLogId = rethink { withTable Table.Post @@ -625,7 +641,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindByPermalink permalink webLogId = rethink { withTable Table.Post @@ -636,7 +652,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindFullById postId webLogId = rethink { withTable Table.Post @@ -658,13 +674,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst) conn return result |> Option.map _.Permalink } - + member _.FindFullByWebLog webLogId = rethink { withTable Table.Post getAll [ webLogId ] (nameof Post.Empty.WebLogId) resultCursor; withRetryCursorDefault; toList conn } - + member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { withTable Table.Post getAll (objList categoryIds) (nameof Post.Empty.CategoryIds) @@ -678,7 +694,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Post getAll [ webLogId ] (nameof Post.Empty.WebLogId) @@ -703,7 +719,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Post getAll [ tag ] (nameof Post.Empty.Tags) @@ -716,7 +732,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { @@ -744,7 +760,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn return older, newer } - + member _.Restore pages = backgroundTask { for batch in pages |> List.chunkBySize restoreBatchSize do do! rethink { @@ -753,7 +769,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger @@ -779,10 +795,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return false } } - + member _.TagMap = { new ITagMapData with - + member _.Delete tagMapId webLogId = backgroundTask { let! result = rethink { withTable Table.TagMap @@ -793,7 +809,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger 0UL } - + member _.FindById tagMapId webLogId = rethink { withTable Table.TagMap @@ -801,7 +817,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger verifyWebLog webLogId _.WebLogId <| conn - + member _.FindByUrlValue urlValue webLogId = rethink { withTable Table.TagMap @@ -810,7 +826,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindByWebLog webLogId = rethink { withTable Table.TagMap between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] @@ -818,13 +834,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.TagMap getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag result; withRetryDefault conn } - + member _.Restore tagMaps = backgroundTask { for batch in tagMaps |> List.chunkBySize restoreBatchSize do do! rethink { @@ -833,7 +849,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Theme filter (fun row -> row[nameof Theme.Empty.Id].Ne "admin" :> obj) @@ -852,7 +868,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Theme @@ -862,13 +878,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger 0 } - + member _.FindById themeId = rethink { withTable Table.Theme get themeId resultOption; withRetryOptionDefault conn } - + member _.FindByIdWithoutText themeId = rethink { withTable Table.Theme @@ -877,7 +893,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member this.Delete themeId = backgroundTask { match! this.FindByIdWithoutText themeId with | Some _ -> @@ -891,7 +907,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return false } - + member _.Save theme = rethink { withTable Table.Theme get theme.Id @@ -899,37 +915,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.ThemeAsset merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile)) result; withRetryDefault conn } - + member _.DeleteByTheme themeId = deleteAssetsByTheme themeId - + member _.FindById assetId = rethink { withTable Table.ThemeAsset get assetId resultOption; withRetryOptionDefault conn } - + member _.FindByTheme themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile)) result; withRetryDefault conn } - + member _.FindByThemeWithData themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) resultCursor; withRetryCursorDefault; toList conn } - + member _.Save asset = rethink { withTable Table.ThemeAsset get asset.Id @@ -937,16 +953,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { @@ -966,7 +982,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return Result.Error $"Upload ID {uploadId} not found" } - + member _.FindByPath path webLogId = rethink { withTable Table.Upload @@ -974,7 +990,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindByWebLog webLogId = rethink { withTable Table.Upload between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] @@ -982,14 +998,14 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.Upload between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] [ Index Index.WebLogAndPath ] resultCursor; withRetryCursorDefault; toList conn } - + member _.Restore uploads = backgroundTask { // Files can be large; we'll do 5 at a time for batch in uploads |> List.chunkBySize 5 do @@ -1000,21 +1016,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.WebLog result; withRetryDefault conn } - + member _.Delete webLogId = backgroundTask { // Comments should be deleted by post IDs let! thePostIds = rethink<{| Id: string |} list> { @@ -1061,7 +1077,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.WebLog @@ -1076,21 +1092,21 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger obj ] write; withRetryDefault; ignoreResult conn } - + member _.UpdateRssOptions webLog = rethink { withTable Table.WebLog get webLog.Id update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ] write; withRetryDefault; ignoreResult conn } - + member _.UpdateSettings webLog = rethink { withTable Table.WebLog get webLog.Id @@ -1108,16 +1124,16 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.WebLogUser @@ -1125,7 +1141,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger verifyWebLog webLogId _.WebLogId <| conn - + member this.Delete userId webLogId = backgroundTask { match! this.FindById userId webLogId with | Some _ -> @@ -1155,7 +1171,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger return Result.Error "User does not exist" } - + member _.FindByEmail email webLogId = rethink { withTable Table.WebLogUser @@ -1164,14 +1180,14 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger tryFirst <| conn - + member _.FindByWebLog webLogId = rethink { withTable Table.WebLogUser getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId) orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase()) result; withRetryDefault conn } - + member _.FindNames webLogId userIds = backgroundTask { let! users = rethink { withTable Table.WebLogUser @@ -1181,7 +1197,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) } - + member _.Restore users = backgroundTask { for batch in users |> List.chunkBySize restoreBatchSize do do! rethink { @@ -1190,7 +1206,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger @@ -1202,7 +1218,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger () } - + member _.Update user = rethink { withTable Table.WebLogUser get user.Id @@ -1218,30 +1234,37 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { dbList; result; withRetryOnce conn } if not (dbs |> List.contains config.Database) then log.LogInformation $"Creating database {config.Database}..." do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn } - + let! tables = rethink { tableList; result; withRetryOnce conn } for tbl in Table.all do if not (tables |> List.contains tbl) then log.LogInformation $"Creating table {tbl}..." do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn } - if not (List.contains Table.DbVersion tables) then - // Version table added in v2-rc2; this will flag that migration to be run + if List.isEmpty tables then + // New install; set version to current version + do! rethink { + withTable Table.DbVersion + insert {| Id = Utils.Migration.currentDbVersion |} + write; withRetryOnce; ignoreResult conn + } + elif not (List.contains Table.DbVersion tables) then + // Other tables, but not version, added in v2-rc2; this will flag that migration to be run do! rethink { withTable Table.DbVersion insert {| Id = "v2-rc1" |} write; withRetryOnce; ignoreResult conn } - + do! ensureIndexes Table.Category [ nameof Category.Empty.WebLogId ] do! ensureIndexes Table.Comment [ nameof Comment.Empty.PostId ] do! ensureIndexes Table.Page [ nameof Page.Empty.WebLogId; nameof Page.Empty.AuthorId ] @@ -1250,7 +1273,7 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger { withTable Table.DbVersion limit 1 diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index 1540808..685f14c 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -12,24 +12,24 @@ open NodaTime /// SQLite myWebLog data implementation type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSerializer) = - + /// Create tables (and their associated indexes) if they do not exist let ensureTables () = backgroundTask { - + Configuration.useSerializer (Utils.createDocumentSerializer ser) - + let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0) - + let needsTable table = not (List.contains table tables) - + let creatingTable = "Creating {Table} table..." - + // Theme tables if needsTable Table.Theme then log.LogInformation(creatingTable, Table.Theme) do! conn.ensureTable Table.Theme - + if needsTable Table.ThemeAsset then log.LogInformation(creatingTable, Table.ThemeAsset) do! conn.customNonQuery @@ -39,32 +39,32 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria updated_on TEXT NOT NULL, data BLOB NOT NULL, PRIMARY KEY (theme_id, path))" [] - + // Web log table if needsTable Table.WebLog then log.LogInformation(creatingTable, Table.WebLog) do! conn.ensureTable Table.WebLog - + // Category table if needsTable Table.Category then log.LogInformation(creatingTable, Table.Category) do! conn.ensureTable Table.Category do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ] - + // Web log user table if needsTable Table.WebLogUser then log.LogInformation(creatingTable, Table.WebLogUser) do! conn.ensureTable Table.WebLogUser do! conn.ensureFieldIndex Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ] - + // Page tables if needsTable Table.Page then log.LogInformation(creatingTable, Table.Page) do! conn.ensureTable Table.Page do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ] do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] - + if needsTable Table.PageRevision then log.LogInformation(creatingTable, Table.PageRevision) do! conn.customNonQuery @@ -73,7 +73,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria as_of TEXT NOT NULL, revision_text TEXT NOT NULL, PRIMARY KEY (page_id, as_of))" [] - + // Post tables if needsTable Table.Post then log.LogInformation(creatingTable, Table.Post) @@ -85,7 +85,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria "status" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ] // TODO: index categories by post? - + if needsTable Table.PostRevision then log.LogInformation(creatingTable, Table.PostRevision) do! conn.customNonQuery @@ -94,18 +94,18 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria as_of TEXT NOT NULL, revision_text TEXT NOT NULL, PRIMARY KEY (post_id, as_of))" [] - + if needsTable Table.PostComment then log.LogInformation(creatingTable, Table.PostComment) do! conn.ensureTable Table.PostComment do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ] - + // Tag map table if needsTable Table.TagMap then log.LogInformation(creatingTable, Table.TagMap) do! conn.ensureTable Table.TagMap do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ] - + // Uploaded file table if needsTable Table.Upload then log.LogInformation(creatingTable, Table.Upload) @@ -117,7 +117,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria updated_on TEXT NOT NULL, data BLOB NOT NULL); CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" [] - + // Database version table if needsTable Table.DbVersion then log.LogInformation(creatingTable, Table.DbVersion) @@ -125,11 +125,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria $"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY); INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" [] } - + /// Set the database version to the specified version let setDbVersion version = conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" [] - + /// Implement the changes between v2-rc1 and v2-rc2 let migrateV2Rc1ToV2Rc2 () = backgroundTask { let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2" @@ -223,7 +223,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria |> Option.map (Utils.deserialize ser) ChapterFile = Map.tryString "chapter_file" epRdr ChapterType = Map.tryString "chapter_type" epRdr - ChapterWaypoints = None + ChapterWaypoints = None TranscriptUrl = Map.tryString "transcript_url" epRdr TranscriptType = Map.tryString "transcript_type" epRdr TranscriptLang = Map.tryString "transcript_lang" epRdr @@ -241,7 +241,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria cmd.Parameters.AddWithValue("@id", string postId) ] |> ignore let _ = cmd.ExecuteNonQuery() cmd.Parameters.Clear()) - + logStep "Migrating dates/times" let inst (dt: DateTime) = DateTime(dt.Ticks, DateTimeKind.Utc) @@ -408,10 +408,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria let _ = cmd.ExecuteNonQuery() ()) cmd.Parameters.Clear() - + conn.Close() conn.Open() - + logStep "Dropping old tables and columns" cmd.CommandText <- "ALTER TABLE web_log_user DROP COLUMN salt; @@ -420,11 +420,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria DROP TABLE page_meta; DROP TABLE web_log_feed_podcast" do! write cmd - + logStep "Setting database version to v2-rc2" do! setDbVersion "v2-rc2" } - + /// Migrate from v2-rc2 to v2 let migrateV2Rc2ToV2 () = backgroundTask { Utils.Migration.logStep log "v2-rc2 to v2" "Setting database version; no migration required" @@ -443,7 +443,7 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required" do! setDbVersion "v2.1.1" } - + /// Migrate from v2.1.1 to v2.2 let migrateV2point1point1ToV2point2 () = backgroundTask { Utils.Migration.logStep log "v2.1.1 to v2.2" "Setting e-mail to lowercase" @@ -452,6 +452,14 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria do! setDbVersion "v2.2" } + /// Migrate from v2.2 to v3 + let migrateV2point2ToV3 () = backgroundTask { + Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs" + do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |} + Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3" + do! setDbVersion "v3" + } + /// Migrate data among versions (up only) let migrate version = backgroundTask { let mutable v = defaultArg version "" @@ -459,33 +467,37 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria if v = "v2-rc1" then do! migrateV2Rc1ToV2Rc2 () v <- "v2-rc2" - + if v = "v2-rc2" then do! migrateV2Rc2ToV2 () v <- "v2" - + if v = "v2" then do! migrateV2ToV2point1 () v <- "v2.1" - + if v = "v2.1" then do! migrateV2point1ToV2point1point1 () v <- "v2.1.1" - + if v = "v2.1.1" then do! migrateV2point1point1ToV2point2 () v <- "v2.2" - + + if v = "v2.2" then + do! migrateV2point2ToV3 () + v <- "v3" + if v <> Utils.Migration.currentDbVersion then log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}" do! setDbVersion Utils.Migration.currentDbVersion } - + /// The connection for this instance member _.Conn = conn - + interface IData with - + member _.Category = SQLiteCategoryData (conn, ser, log) member _.Page = SQLitePageData (conn, log) member _.Post = SQLitePostData (conn, log) @@ -495,9 +507,9 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria member _.Upload = SQLiteUploadData (conn, log) member _.WebLog = SQLiteWebLogData (conn, log) member _.WebLogUser = SQLiteWebLogUserData (conn, log) - + member _.Serializer = ser - + member _.StartUp () = backgroundTask { do! ensureTables () let! version = conn.customSingle $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0) diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index b22d563..131353e 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -79,7 +79,7 @@ module Migration = open Microsoft.Extensions.Logging /// The current database version - let currentDbVersion = "v2.2" + let currentDbVersion = "v3" /// Log a migration step /// The logger to which the message should be logged diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 37abd69..ddd805b 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -348,6 +348,9 @@ type WebLog = { /// Redirect rules for this weblog RedirectRules: RedirectRule list + + /// Whether to automatically apply OpenGraph properties to all pages / posts + AutoOpenGraph: bool } with /// An empty web log @@ -364,7 +367,8 @@ type WebLog = { Rss = RssOptions.Empty AutoHtmx = false Uploads = Database - RedirectRules = [] } + RedirectRules = [] + AutoOpenGraph = true } /// /// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain) diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index b39d4ff..9fe14d2 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -19,6 +19,17 @@ module private Helpers = /// Pipeline with most extensions enabled let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build() + /// Derive a MIME type from the given URL and candidates + /// The URL from which the MIME type should be derived + /// The candidates for the MIME type derivation + /// Some with the type if it was derived, None otherwise + let deriveMimeType (url: string) (candidates: System.Collections.Generic.IDictionary) = + match url.LastIndexOf '.' with + | extIdx when extIdx >= 0 -> + let ext = url[extIdx + 1..] + if candidates.ContainsKey ext then Some candidates[ext] else None + | _ -> None + /// Functions to support NodaTime manipulation module Noda = @@ -401,6 +412,15 @@ type OpenGraphAudio = { SecureUrl = None Type = None } + /// MIME types we can derive from the file extension + static member private DeriveTypes = + [ "aac", "audio/aac" + "mp3", "audio/mpeg" + "oga", "audio/ogg" + "wav", "audio/wav" + "weba", "audio/webm" ] + |> dict + /// The meta properties for this image member this.Properties = seq { yield ("og:audio", this.Url) @@ -411,8 +431,9 @@ type OpenGraphAudio = { match this.Type with | Some typ -> yield ("og:audio:type", typ) | 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 Alt = None } + /// MIME types we can derive from the file extension + 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 + /// The meta properties for this image member this.Properties = seq { - yield ("og:image", this.Url) + yield "og:image", this.Url match this.SecureUrl with - | Some url -> yield ("og:image:secure_url", url) - | None when this.Url.StartsWith "https:" -> yield ("og:image:secure_url", this.Url) + | Some url -> yield "og:image:secure_url", url + | None when this.Url.StartsWith "https:" -> yield "og:image:secure_url", this.Url | None -> () match this.Type with - | Some typ -> yield ("og:image:type", typ) + | Some typ -> yield "og:image:type", typ | None -> - // TODO: derive mime type based on common image extensions - () - match this.Width with Some width -> yield ("og:image:width", string width) | 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 -> () + match deriveMimeType this.Url OpenGraphImage.DeriveTypes with + | Some it -> yield "og:image:type", it + | None -> () + match this.Width with Some width -> yield "og:image:width", string width | 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 Height = None } + /// MIME types we can derive from the file extension + static member private DeriveTypes = + [ "avi", "video/x-msvideo" + "mp4", "video/mp4" + "mpeg", "video/mpeg" + "ogv", "video/ogg" + "webm", "video/webm" ] + |> dict + /// The meta properties for this video member this.Properties = seq { - yield ("og:video", this.Url) + yield "og:video", this.Url match this.SecureUrl with - | Some url -> yield ("og:video:secure_url", url) - | None when this.Url.StartsWith "https:" -> yield ("og:video:secure_url", this.Url) + | Some url -> yield "og:video:secure_url", url + | None when this.Url.StartsWith "https:" -> yield "og:video:secure_url", this.Url | None -> () match this.Type with - | Some typ -> yield ("og:video:type", typ) + | Some typ -> yield "og:video:type", typ | None -> - // TODO: derive mime type based on common video extensions - () - 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 -> () + match deriveMimeType this.Url OpenGraphVideo.DeriveTypes with + | Some it -> yield "og:video:type", it + | 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 = /// Properties for OpenGraph [] type OpenGraphProperties = { - /// The type of object represented Type: OpenGraphType @@ -594,7 +639,34 @@ type OpenGraphProperties = { /// Free-form items Other: MetaItem list option -} +} with + + /// An empty set of OpenGraph properties + static member Empty = + { Type = Article + Image = OpenGraphImage.Empty + Audio = None + Description = None + Determiner = None + Locale = None + LocaleAlternate = None + Video = None + Other = None } + + /// The meta properties for this page or post + 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 -> () + } /// A permanent link diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 9d81220..776f801 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -1249,36 +1249,41 @@ type SettingsModel = { /// The default location for uploads Uploads: string + + /// Whether to automatically apply OpenGraph properties to all pages and posts + AutoOpenGraph: bool } with /// Create a settings model from a web log /// The web log from which this model should be created /// A populated SettingsModel instance static member FromWebLog(webLog: WebLog) = - { Name = webLog.Name - Slug = webLog.Slug - Subtitle = defaultArg webLog.Subtitle "" - DefaultPage = webLog.DefaultPage - PostsPerPage = webLog.PostsPerPage - TimeZone = webLog.TimeZone - ThemeId = string webLog.ThemeId - AutoHtmx = webLog.AutoHtmx - Uploads = string webLog.Uploads } + { Name = webLog.Name + Slug = webLog.Slug + Subtitle = defaultArg webLog.Subtitle "" + DefaultPage = webLog.DefaultPage + PostsPerPage = webLog.PostsPerPage + TimeZone = webLog.TimeZone + ThemeId = string webLog.ThemeId + AutoHtmx = webLog.AutoHtmx + Uploads = string webLog.Uploads + AutoOpenGraph = webLog.AutoOpenGraph } /// Update a web log with settings from the form /// The web log to be updated /// The web log, updated with the value from this model member this.Update(webLog: WebLog) = { webLog with - Name = this.Name - Slug = this.Slug - Subtitle = if this.Subtitle = "" then None else Some this.Subtitle - DefaultPage = this.DefaultPage - PostsPerPage = this.PostsPerPage - TimeZone = this.TimeZone - ThemeId = ThemeId this.ThemeId - AutoHtmx = this.AutoHtmx - Uploads = UploadDestination.Parse this.Uploads } + Name = this.Name + Slug = this.Slug + Subtitle = if this.Subtitle = "" then None else Some this.Subtitle + DefaultPage = this.DefaultPage + PostsPerPage = this.PostsPerPage + TimeZone = this.TimeZone + ThemeId = ThemeId this.ThemeId + AutoHtmx = this.AutoHtmx + Uploads = UploadDestination.Parse this.Uploads + AutoOpenGraph = this.AutoOpenGraph } /// View model for uploading a file diff --git a/src/MyWebLog.Tests/Data/ConvertersTests.fs b/src/MyWebLog.Tests/Data/ConvertersTests.fs index 3f9f053..215f4ff 100644 --- a/src/MyWebLog.Tests/Data/ConvertersTests.fs +++ b/src/MyWebLog.Tests/Data/ConvertersTests.fs @@ -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 opts = JsonSerializerSettings() 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("\"book\"", opts) + Expect.equal after Book "OpenGraph type deserialized incorrectly" + } +] + /// Unit tests for the PermalinkConverter type let permalinkConverterTests = testList "PermalinkConverter" [ let opts = JsonSerializerSettings() @@ -257,6 +271,7 @@ let configureTests = test "Json.configure succeeds" { Expect.hasCountOf ser.Converters 1u (has typeof) "Custom feed source converter not found" Expect.hasCountOf ser.Converters 1u (has typeof) "Explicit rating converter not found" Expect.hasCountOf ser.Converters 1u (has typeof) "Markup text converter not found" + Expect.hasCountOf ser.Converters 1u (has typeof) "OpenGraph type converter not found" Expect.hasCountOf ser.Converters 1u (has typeof) "Permalink converter not found" Expect.hasCountOf ser.Converters 1u (has typeof) "Page ID converter not found" Expect.hasCountOf ser.Converters 1u (has typeof) "Podcast medium converter not found" @@ -282,6 +297,7 @@ let all = testList "Converters" [ customFeedSourceConverterTests explicitRatingConverterTests markupTextConverterTests + openGraphTypeConverterTests permalinkConverterTests pageIdConverterTests podcastMediumConverterTests diff --git a/src/MyWebLog.Tests/Data/PageDataTests.fs b/src/MyWebLog.Tests/Data/PageDataTests.fs index 4d71130..fc23a59 100644 --- a/src/MyWebLog.Tests/Data/PageDataTests.fs +++ b/src/MyWebLog.Tests/Data/PageDataTests.fs @@ -1,6 +1,6 @@ /// /// Integration tests for implementations -/// +/// module PageDataTests open System @@ -35,8 +35,9 @@ let ``Add succeeds`` (data: IData) = task { Text = "

A new page

" Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ] PriorPermalinks = [ Permalink "2024/the-new-page.htm" ] - Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "

A new page

" } ] } - do! data.Page.Add page + Revisions = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "

A new page

" } ] + OpenGraph = Some { OpenGraphProperties.Empty with Type = Book } } + do! data.Page.Add page let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test") Expect.isSome stored "The page should have been added" 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.PriorPermalinks page.PriorPermalinks "Prior permalinks 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 { diff --git a/src/MyWebLog.Tests/Data/PostDataTests.fs b/src/MyWebLog.Tests/Data/PostDataTests.fs index 8fdffdb..20f23ed 100644 --- a/src/MyWebLog.Tests/Data/PostDataTests.fs +++ b/src/MyWebLog.Tests/Data/PostDataTests.fs @@ -1,6 +1,6 @@ /// /// Integration tests for implementations -/// +/// module PostDataTests open System @@ -54,7 +54,7 @@ let ``Add succeeds`` (data: IData) = task { { Id = PostId "a-new-post" WebLogId = WebLogId "test" AuthorId = WebLogUserId "test-author" - Status = Published + Status = Published Title = "A New Test Post" Permalink = Permalink "2020/test-post.html" 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" } Metadata = [ { Name = "Meta"; Value = "Data" } ] PriorPermalinks = [ Permalink "2020/test-post-a.html" ] - Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "

Test text here" } ] } + Revisions = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "

Test text here" } ] + OpenGraph = Some { OpenGraphProperties.Empty with Type = VideoMovie } } do! data.Post.Add post let! stored = data.Post.FindFullById post.Id post.WebLogId 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.PriorPermalinks post.PriorPermalinks "Prior permalinks 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 { diff --git a/src/MyWebLog.Tests/Data/WebLogDataTests.fs b/src/MyWebLog.Tests/Data/WebLogDataTests.fs index f87a486..5e197b3 100644 --- a/src/MyWebLog.Tests/Data/WebLogDataTests.fs +++ b/src/MyWebLog.Tests/Data/WebLogDataTests.fs @@ -1,6 +1,6 @@ ///

/// Integration tests for implementations -/// +/// module WebLogDataTests open System @@ -25,14 +25,15 @@ let ``Add succeeds`` (data: IData) = task { Rss = { IsFeedEnabled = true FeedName = "my-feed.xml" - ItemsInFeed = None + ItemsInFeed = None IsCategoryEnabled = false IsTagEnabled = false Copyright = Some "go for it" CustomFeeds = [] } AutoHtmx = true 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") Expect.isSome webLog "The web log should have been returned" let it = webLog.Value @@ -48,6 +49,7 @@ let ``Add succeeds`` (data: IData) = task { Expect.isTrue it.AutoHtmx "Auto htmx flag 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.isFalse it.AutoOpenGraph "Auto OpenGraph flag is incorrect" let rss = it.Rss Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect" Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect" diff --git a/src/MyWebLog.Tests/Domain/SupportTypesTests.fs b/src/MyWebLog.Tests/Domain/SupportTypesTests.fs index b68494b..e215441 100644 --- a/src/MyWebLog.Tests/Domain/SupportTypesTests.fs +++ b/src/MyWebLog.Tests/Domain/SupportTypesTests.fs @@ -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 + (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 let podcastMediumTests = testList "PodcastMedium" [ testList "Parse" [ @@ -407,6 +747,11 @@ let all = testList "SupportTypes" [ explicitRatingTests episodeTests markupTextTests + openGraphAudioTests + openGraphImageTests + openGraphVideoTests + openGraphTypeTests + openGraphPropertiesTests podcastMediumTests postStatusTests customFeedSourceTests diff --git a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs index 67bc0d4..0de011b 100644 --- a/src/MyWebLog.Tests/Domain/ViewModelsTests.fs +++ b/src/MyWebLog.Tests/Domain/ViewModelsTests.fs @@ -233,7 +233,7 @@ let testFullPost = ImageUrl = Some "uploads/podcast-cover.jpg" Subtitle = Some "Narration" Explicit = Some Clean - Chapters = None + Chapters = None ChapterFile = Some "uploads/1970/01/chapters.txt" ChapterType = Some "chapters" ChapterWaypoints = Some true @@ -666,7 +666,7 @@ let editPostModelTests = testList "EditPostModel" [ { testFullPost.Episode.Value with Chapters = Some [] ChapterFile = None - ChapterType = None } } + ChapterType = None } } Expect.equal model.ChapterSource "internal" "ChapterSource not filled properly" } ] @@ -677,7 +677,7 @@ let editPostModelTests = testList "EditPostModel" [ model.Source <- "HTML" model.Text <- "

An updated post!

" model.Tags <- "Zebras, Aardvarks, , Turkeys" - model.Template <- "updated" + model.Template <- "updated" model.CategoryIds <- [| "cat-x"; "cat-y" |] model.MetaNames <- [| "Zed Meta"; "A Meta" |] model.MetaValues <- [| "A Value"; "Zed Value" |] @@ -688,7 +688,7 @@ let editPostModelTests = testList "EditPostModel" [ model.ImageUrl <- "updated-cover.png" model.Subtitle <- "Talking" model.Explicit <- "no" - model.ChapterSource <- "external" + model.ChapterSource <- "external" model.ChapterFile <- "updated-chapters.txt" model.ChapterType <- "indexes" model.TranscriptUrl <- "updated-transcript.txt" @@ -696,7 +696,7 @@ let editPostModelTests = testList "EditPostModel" [ model.TranscriptLang <- "ES-mx" model.SeasonNumber <- 4 model.SeasonDescription <- "Season Fo" - model.EpisodeNumber <- "432.1" + model.EpisodeNumber <- "432.1" model.EpisodeDescription <- "Four Three Two pt One" model testList "UpdatePost" [ @@ -760,7 +760,7 @@ let editPostModelTests = testList "EditPostModel" [ minModel.SeasonNumber <- 0 minModel.SeasonDescription <- "" minModel.EpisodeNumber <- "" - minModel.EpisodeDescription <- "" + minModel.EpisodeDescription <- "" let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500) Expect.isSome post.Episode "There should have been a podcast episode" let ep = post.Episode.Value @@ -785,7 +785,7 @@ let editPostModelTests = testList "EditPostModel" [ } test "succeeds for a podcast episode with internal chapters" { let minModel = updatedModel () - minModel.ChapterSource <- "internal" + minModel.ChapterSource <- "internal" minModel.ChapterFile <- "" minModel.ChapterType <- "" let post = minModel.UpdatePost testFullPost (Noda.epoch + Duration.FromDays 500) @@ -977,7 +977,7 @@ let editUserModelTests = testList "EditUserModel" [ let model = { Id = "test-user" AccessLevel = "WebLogAdmin" - Email = "again@example.com" + Email = "again@example.com" Url = "" FirstName = "Another" LastName = "One" @@ -1115,10 +1115,10 @@ let postListItemTests = testList "PostListItem" [ { Post.Empty with Id = PostId "full-post" AuthorId = WebLogUserId "me" - Status = Published + Status = Published Title = "Finished Product" 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 Text = """Click""" CategoryIds = [ CategoryId "z"; CategoryId "y" ] @@ -1157,13 +1157,14 @@ let settingsModelTests = testList "SettingsModel" [ let model = SettingsModel.FromWebLog { WebLog.Empty with - Name = "The Web Log" - Slug = "the-web-log" - DefaultPage = "this-one" - PostsPerPage = 18 - TimeZone = "America/Denver" - ThemeId = ThemeId "my-theme" - AutoHtmx = true } + Name = "The Web Log" + Slug = "the-web-log" + DefaultPage = "this-one" + PostsPerPage = 18 + TimeZone = "America/Denver" + ThemeId = ThemeId "my-theme" + AutoHtmx = true + AutoOpenGraph = false } 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.Subtitle "" "Subtitle not filled properly" @@ -1173,6 +1174,7 @@ let settingsModelTests = testList "SettingsModel" [ Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly" Expect.isTrue model.AutoHtmx "AutoHtmx should have been set" Expect.equal model.Uploads "Database" "Uploads not filled properly" + Expect.isFalse model.AutoOpenGraph "AutoOpenGraph should have been unset" } test "succeeds with a subtitle" { let model = SettingsModel.FromWebLog { WebLog.Empty with Subtitle = Some "sub here!" } @@ -1182,15 +1184,16 @@ let settingsModelTests = testList "SettingsModel" [ testList "Update" [ test "succeeds with no subtitle" { let webLog = - { Name = "Interesting" - Slug = "some-stuff" - Subtitle = "" - DefaultPage = "that-one" - PostsPerPage = 8 - TimeZone = "America/Chicago" - ThemeId = "test-theme" - AutoHtmx = true - Uploads = "Disk" }.Update WebLog.Empty + { Name = "Interesting" + Slug = "some-stuff" + Subtitle = "" + DefaultPage = "that-one" + PostsPerPage = 8 + TimeZone = "America/Chicago" + ThemeId = "test-theme" + AutoHtmx = true + Uploads = "Disk" + AutoOpenGraph = false }.Update WebLog.Empty Expect.equal webLog.Name "Interesting" "Name not filled properly" Expect.equal webLog.Slug "some-stuff" "Slug not filled properly" 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.isTrue webLog.AutoHtmx "AutoHtmx should have been set" Expect.equal webLog.Uploads Disk "Uploads not filled properly" + Expect.isFalse webLog.AutoOpenGraph "AutoOpenGraph should have been unset" } test "succeeds with a subtitle" { let webLog = { SettingsModel.FromWebLog WebLog.Empty with Subtitle = "Sub" }.Update WebLog.Empty diff --git a/src/MyWebLog.Tests/Program.fs b/src/MyWebLog.Tests/Program.fs index b2ed6a9..2804126 100644 --- a/src/MyWebLog.Tests/Program.fs +++ b/src/MyWebLog.Tests/Program.fs @@ -10,20 +10,19 @@ let sqliteOnly = (RethinkDbDataTests.env "SQLITE_ONLY" "0") = "1" let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1" /// Whether any of the data tests are being isolated -let dbOnly = rethinkOnly || sqliteOnly || postgresOnly - -/// Whether to only run the unit tests (skip database/integration tests) -let unitOnly = (RethinkDbDataTests.env "UNIT_ONLY" "0") = "1" +let allDatabases = not (rethinkOnly || sqliteOnly || postgresOnly) let allTests = testList "MyWebLog" [ - if not dbOnly then testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ] - if not unitOnly then - testList "Data" [ - if not dbOnly then ConvertersTests.all - if not dbOnly then UtilsTests.all - if not dbOnly || (dbOnly && rethinkOnly) then RethinkDbDataTests.all - if not dbOnly || (dbOnly && sqliteOnly) then SQLiteDataTests.all - if not dbOnly || (dbOnly && postgresOnly) then PostgresDataTests.all + // Skip unit tests if running an isolated database test + if allDatabases then + testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ] + testList "Data (Unit)" [ ConvertersTests.all; UtilsTests.all ] + // Whether to skip integration tests + if RethinkDbDataTests.env "UNIT_ONLY" "0" <> "1" then + testList "Data (Integration)" [ + if allDatabases || rethinkOnly then RethinkDbDataTests.all + if allDatabases || sqliteOnly then SQLiteDataTests.all + if allDatabases || postgresOnly then PostgresDataTests.all ] ] diff --git a/src/MyWebLog/Template.fs b/src/MyWebLog/Template.fs index 5529b39..39c567d 100644 --- a/src/MyWebLog/Template.fs +++ b/src/MyWebLog/Template.fs @@ -192,7 +192,12 @@ let parser = let attrEnc = System.Web.HttpUtility.HtmlAttributeEncode // 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) = writer.WriteLine $"""{s}""" 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 |> function url -> writeOgProp ("og:url", url) match if app.IsPage then app.Page.OpenGraph else app.Posts.Posts[0].OpenGraph with - | Some props -> - 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 -> () + | Some props -> props.Properties |> Seq.iter writeOgProp | None -> () writer.WriteLine $"""{s}""" diff --git a/src/MyWebLog/Views/WebLog.fs b/src/MyWebLog/Views/WebLog.fs index 7af2c73..24c87d3 100644 --- a/src/MyWebLog/Views/WebLog.fs +++ b/src/MyWebLog/Views/WebLog.fs @@ -795,6 +795,13 @@ let webLogSettings selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads 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 "col text-center" ] [