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

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

@ -224,6 +224,14 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
return! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
return! setDbVersion "v3"
}
/// Do required data migration between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -243,6 +251,10 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
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

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

@ -256,6 +256,18 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
do! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! rethink {
withTable Table.WebLog
update [ nameof WebLog.Empty.AutoOpenGraph, true :> obj ]
write; withRetryOnce; ignoreResult conn
}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data between versions
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -280,6 +292,10 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
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
@ -1234,8 +1250,15 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
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" |}

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

@ -452,6 +452,14 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
do! setDbVersion "v2.2"
}
/// Migrate from v2.2 to v3
let migrateV2point2ToV3 () = backgroundTask {
Utils.Migration.logStep log "v2.2 to v3" "Adding auto-OpenGraph flag to all web logs"
do! Patch.byFields Table.WebLog Any [ Field.Exists (nameof WebLog.Empty.Id) ] {| AutoOpenGraph = true |}
Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"
do! setDbVersion "v3"
}
/// Migrate data among versions (up only)
let migrate version = backgroundTask {
let mutable v = defaultArg version ""
@ -476,6 +484,10 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
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

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

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

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

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

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

@ -19,6 +19,17 @@ module private Helpers =
/// <summary>Pipeline with most extensions enabled</summary>
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>
module Noda =
@ -401,6 +412,15 @@ type OpenGraphAudio = {
SecureUrl = 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>
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 }
/// <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>
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 }
/// <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>
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 =
/// <summary>Properties for OpenGraph</summary>
[<CLIMutable>]
type OpenGraphProperties = {
/// <summary>The type of object represented</summary>
Type: OpenGraphType
@ -594,6 +639,33 @@ type OpenGraphProperties = {
/// <summary>Free-form items</summary>
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 -> ()
}

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

@ -1249,6 +1249,9 @@ type SettingsModel = {
/// <summary>The default location for uploads</summary>
Uploads: string
/// <summary>Whether to automatically apply OpenGraph properties to all pages and posts</summary>
AutoOpenGraph: bool
} with
/// <summary>Create a settings model from a web log</summary>
@ -1263,7 +1266,8 @@ type SettingsModel = {
TimeZone = webLog.TimeZone
ThemeId = string webLog.ThemeId
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>
/// <param name="webLog">The web log to be updated</param>
@ -1278,7 +1282,8 @@ type SettingsModel = {
TimeZone = this.TimeZone
ThemeId = ThemeId this.ThemeId
AutoHtmx = this.AutoHtmx
Uploads = UploadDestination.Parse this.Uploads }
Uploads = UploadDestination.Parse this.Uploads
AutoOpenGraph = this.AutoOpenGraph }
/// <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 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<OpenGraphType>("\"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<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<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<PageIdConverter>) "Page ID 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
explicitRatingConverterTests
markupTextConverterTests
openGraphTypeConverterTests
permalinkConverterTests
pageIdConverterTests
podcastMediumConverterTests

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

@ -35,7 +35,8 @@ let ``Add succeeds`` (data: IData) = task {
Text = "<h1>A new page</h1>"
Metadata = [ { Name = "Meta Item"; Value = "Meta Value" } ]
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>" } ]
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"
@ -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 {

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

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

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

@ -32,7 +32,8 @@ let ``Add succeeds`` (data: IData) = task {
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"

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

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

@ -1163,7 +1163,8 @@ let settingsModelTests = testList "SettingsModel" [
PostsPerPage = 18
TimeZone = "America/Denver"
ThemeId = ThemeId "my-theme"
AutoHtmx = true }
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!" }
@ -1190,7 +1192,8 @@ let settingsModelTests = testList "SettingsModel" [
TimeZone = "America/Chicago"
ThemeId = "test-theme"
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.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

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"
/// 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
]
]

22
src/MyWebLog/Template.fs
View File

@ -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}<meta property=%s{name} content="{attrEnc value}">"""
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}<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
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" ] [