From 7eaad4a076669e797734531aab086b2ebe1c454e Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 18 Jul 2022 20:05:10 -0400 Subject: [PATCH] Clean up database names (#21) - Moved user edit to "my info" (#19) --- rethink-case-fix.js | 171 ++++++ src/MyWebLog.Data/Converters.fs | 42 +- src/MyWebLog.Data/MyWebLog.Data.fsproj | 2 +- src/MyWebLog.Data/RethinkDbData.fs | 399 +++++++------ src/MyWebLog.Data/SQLite/Helpers.fs | 271 +++++---- .../SQLite/SQLiteCategoryData.fs | 16 +- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 90 +-- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 110 ++-- src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs | 14 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 42 +- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 14 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 166 +++--- .../SQLite/SQLiteWebLogUserData.fs | 42 +- src/MyWebLog.Data/SQLiteData.fs | 100 ++-- src/MyWebLog.Data/Utils.fs | 12 +- src/MyWebLog.Domain/DataTypes.fs | 352 +++++------ src/MyWebLog.Domain/SupportTypes.fs | 176 +++--- src/MyWebLog.Domain/ViewModels.fs | 550 +++++++++--------- src/MyWebLog/Caches.fs | 32 +- src/MyWebLog/DotLiquidBespoke.fs | 52 +- src/MyWebLog/Handlers/Admin.fs | 97 +-- src/MyWebLog/Handlers/Feed.fs | 212 +++---- src/MyWebLog/Handlers/Helpers.fs | 36 +- src/MyWebLog/Handlers/Page.fs | 104 ++-- src/MyWebLog/Handlers/Post.fs | 152 ++--- src/MyWebLog/Handlers/Routes.fs | 36 +- src/MyWebLog/Handlers/Upload.fs | 36 +- src/MyWebLog/Handlers/User.fs | 81 +-- src/MyWebLog/Maintenance.fs | 274 +++++---- src/MyWebLog/Program.fs | 2 +- src/admin-theme/_layout.liquid | 2 +- src/admin-theme/custom-feed-edit.liquid | 12 +- .../{user-edit.liquid => my-info.liquid} | 19 +- src/admin-theme/page-list.liquid | 2 +- src/admin-theme/settings.liquid | 6 +- src/admin-theme/wwwroot/admin.js | 14 +- 36 files changed, 1993 insertions(+), 1745 deletions(-) create mode 100644 rethink-case-fix.js rename src/admin-theme/{user-edit.liquid => my-info.liquid} (74%) diff --git a/rethink-case-fix.js b/rethink-case-fix.js new file mode 100644 index 0000000..7c62dac --- /dev/null +++ b/rethink-case-fix.js @@ -0,0 +1,171 @@ + +// Category +r.db('myWebLog').table('Category').map({ + Description: r.row('description'), + Id: r.row('id'), + Name: r.row('name'), + ParentId: r.row('parentId'), + Slug: r.row('slug'), + WebLogId: r.row('webLogId') +}) + +// Page +r.db('myWebLog').table('Page').map({ + AuthorId: r.row('authorId'), + Id: r.row('id'), + Metadata: r.row('metadata').map(function (meta) { + return { Name: meta('name'), Value: meta('value') } + }), + Permalink: r.row('permalink'), + PriorPermalinks: r.row('priorPermalinks'), + PublishedOn: r.row('publishedOn'), + Revisions: r.row('revisions').map(function (rev) { + return { + AsOf: rev('asOf'), + Text: rev('text') + } + }), + IsInPageList: r.row('showInPageList'), + Template: r.row('template'), + Text: r.row('text'), + Title: r.row('title'), + UpdatedOn: r.row('updatedOn'), + WebLogId: r.row('webLogId') +}) + +// Post +r.db('myWebLog').table('Post').map({ + AuthorId: r.row('authorId'), + CategoryIds: r.row('categoryIds'), + Episode: r.branch(r.row.hasFields('episode'), { + Duration: r.row('episode')('duration'), + Length: r.row('episode')('length'), + Media: r.row('episode')('media'), + MediaType: r.row('episode')('mediaType').default(null), + ImageUrl: r.row('episode')('imageUrl').default(null), + Subtitle: r.row('episode')('subtitle').default(null), + Explicit: r.row('episode')('explicit').default(null), + ChapterFile: r.row('episode')('chapterFile').default(null), + ChapterType: r.row('episode')('chapterType').default(null), + TranscriptUrl: r.row('episode')('transcriptUrl').default(null), + TranscriptType: r.row('episode')('transcriptType').default(null), + TranscriptLang: r.row('episode')('transcriptLang').default(null), + TranscriptCaptions: r.row('episode')('transcriptCaptions').default(null), + SeasonNumber: r.row('episode')('seasonNumber').default(null), + SeasonDescription: r.row('episode')('seasonDescription').default(null), + EpisodeNumber: r.row('episode')('episodeNumber').default(null), + EpisodeDescription: r.row('episode')('episodeDescription').default(null) + }, null), + Id: r.row('id'), + Metadata: r.row('metadata').map(function (meta) { + return { Name: meta('name'), Value: meta('value') } + }), + Permalink: r.row('permalink'), + PriorPermalinks: r.row('priorPermalinks'), + PublishedOn: r.row('publishedOn'), + Revisions: r.row('revisions').map(function (rev) { + return { + AsOf: rev('asOf'), + Text: rev('text') + } + }), + Status: r.row('status'), + Tags: r.row('tags'), + Template: r.row('template').default(null), + Text: r.row('text'), + Title: r.row('title'), + UpdatedOn: r.row('updatedOn'), + WebLogId: r.row('webLogId') +}) + +// TagMap +r.db('myWebLog').table('TagMap').map({ + Id: r.row('id'), + Tag: r.row('tag'), + UrlValue: r.row('urlValue'), + WebLogId: r.row('webLogId') +}) + +// Theme +r.db('myWebLog').table('Theme').map({ + Id: r.row('id'), + Name: r.row('name'), + Templates: r.row('templates').map(function (tmpl) { + return { + Name: tmpl('name'), + Text: tmpl('text') + } + }), + Version: r.row('version') +}) + +// ThemeAsset +r.db('myWebLog').table('ThemeAsset').map({ + Data: r.row('data'), + Id: r.row('id'), + UpdatedOn: r.row('updatedOn') +}) + +// WebLog +r.db('myWebLog').table('WebLog').map( + { AutoHtmx: r.row('autoHtmx'), + DefaultPage: r.row('defaultPage'), + Id: r.row('id'), + Name: r.row('name'), + PostsPerPage: r.row('postsPerPage'), + Rss: { + IsCategoryEnabled: r.row('rss')('categoryEnabled'), + Copyright: r.row('rss')('copyright'), + CustomFeeds: r.row('rss')('customFeeds').map(function (feed) { + return { + Id: feed('id'), + Path: feed('path'), + Podcast: { + DefaultMediaType: feed('podcast')('defaultMediaType'), + DisplayedAuthor: feed('podcast')('displayedAuthor'), + Email: feed('podcast')('email'), + Explicit: feed('podcast')('explicit'), + FundingText: feed('podcast')('fundingText'), + FundingUrl: feed('podcast')('fundingUrl'), + PodcastGuid: feed('podcast')('guid'), + AppleCategory: feed('podcast')('iTunesCategory'), + AppleSubcategory: feed('podcast')('iTunesSubcategory'), + ImageUrl: feed('podcast')('imageUrl'), + ItemsInFeed: feed('podcast')('itemsInFeed'), + MediaBaseUrl: feed('podcast')('mediaBaseUrl'), + Medium: feed('podcast')('medium'), + Subtitle: feed('podcast')('subtitle'), + Summary: feed('podcast')('summary'), + Title: feed('podcast')('title') + }, + Source: feed('source') + } + }), + IsFeedEnabled: r.row('rss')('feedEnabled'), + FeedName: r.row('rss')('feedName'), + ItemsInFeed: r.row('rss')('itemsInFeed'), + IsTagEnabled: r.row('rss')('tagEnabled') + }, + Slug: r.row('slug'), + Subtitle: r.row('subtitle'), + ThemeId: r.row('themePath'), + TimeZone: r.row('timeZone'), + Uploads: r.row('uploads'), + UrlBase: r.row('urlBase') + }) + +// WebLogUser +r.db('myWebLog').table('WebLogUser').map({ + AccessLevel: r.row('authorizationLevel'), + FirstName: r.row('firstName'), + Id: r.row('id'), + LastName: r.row('lastName'), + PasswordHash: r.row('passwordHash'), + PreferredName: r.row('preferredName'), + Salt: r.row('salt'), + Url: r.row('url'), + Email: r.row('userName'), + WebLogId: r.row('webLogId'), + CreatedOn: r.branch(r.row.hasFields('createdOn'), r.row('createdOn'), r.expr(new Date(0))), + LastSeenOn: r.row('lastSeenOn').default(null) +}) diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index cdbb807..b17d587 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -100,13 +100,6 @@ module Json = override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) = (string >> ThemeId) reader.Value - type UploadDestinationConverter () = - inherit JsonConverter () - override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) = - writer.WriteValue (UploadDestination.toString value) - override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) = - (string >> UploadDestination.parse) reader.Value - type UploadIdConverter () = inherit JsonConverter () override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) = @@ -134,23 +127,22 @@ module Json = let all () : JsonConverter seq = seq { // Our converters - CategoryIdConverter () - CommentIdConverter () - CustomFeedIdConverter () - CustomFeedSourceConverter () - ExplicitRatingConverter () - MarkupTextConverter () - PermalinkConverter () - PageIdConverter () - PodcastMediumConverter () - PostIdConverter () - TagMapIdConverter () - ThemeAssetIdConverter () - ThemeIdConverter () - UploadDestinationConverter () - UploadIdConverter () - WebLogIdConverter () - WebLogUserIdConverter () + CategoryIdConverter () + CommentIdConverter () + CustomFeedIdConverter () + CustomFeedSourceConverter () + ExplicitRatingConverter () + MarkupTextConverter () + PermalinkConverter () + PageIdConverter () + PodcastMediumConverter () + PostIdConverter () + TagMapIdConverter () + ThemeAssetIdConverter () + ThemeIdConverter () + UploadIdConverter () + WebLogIdConverter () + WebLogUserIdConverter () // Handles DUs with no associated data, as well as option fields - CompactUnionJsonConverter () + CompactUnionJsonConverter () } diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 53fccf5..f6d5557 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -16,7 +16,7 @@ - + diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 54541d1..bf3b2da 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -45,7 +45,24 @@ module private RethinkHelpers = /// A list of all tables let all = [ Category; Comment; 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 @@ -77,7 +94,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger row["id"].Match keyPrefix :> obj + fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj /// Ensure field indexes exist, as well as special indexes for selected tables let ensureIndexes table fields = backgroundTask { @@ -88,24 +105,27 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.contains table then - if not (indexes |> List.contains "permalink") then - log.LogInformation $"Creating index {table}.permalink..." + let permalinkIdx = nameof Page.empty.Permalink + if not (indexes |> List.contains permalinkIdx) then + log.LogInformation $"Creating index {table}.{permalinkIdx}..." do! rethink { withTable table - indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj) + indexCreate permalinkIdx + (fun row -> r.Array (row[nameof Page.empty.WebLogId], row[permalinkIdx].Downcase ()) :> obj) write; withRetryOnce; ignoreResult conn } // Prior permalinks are searched when a post or page permalink do not match the current URL - if not (indexes |> List.contains "priorPermalinks") then - log.LogInformation $"Creating index {table}.priorPermalinks..." + let priorIdx = nameof Post.empty.PriorPermalinks + if not (indexes |> List.contains priorIdx) then + log.LogInformation $"Creating index {table}.{priorIdx}..." do! rethink { withTable table - indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ] + indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ] write; withRetryOnce; ignoreResult conn } // Post needs indexes by category and tag (used for counting and retrieving posts) if Table.Post = table then - for idx in [ "categoryIds"; "tags" ] do + for idx in [ nameof Post.empty.CategoryIds; nameof Post.empty.Tags ] do if not (List.contains idx indexes) then log.LogInformation $"Creating index {table}.{idx}..." do! rethink { @@ -115,37 +135,42 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.contains "webLogAndTag") then - log.LogInformation $"Creating index {table}.webLogAndTag..." + if not (indexes |> List.contains Index.WebLogAndTag) then + log.LogInformation $"Creating index {table}.{Index.WebLogAndTag}..." do! rethink { withTable table - indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj) + indexCreate Index.WebLogAndTag (fun row -> + [| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.Tag] |] :> obj) write; withRetryOnce; ignoreResult conn } - if not (indexes |> List.contains "webLogAndUrl") then - log.LogInformation $"Creating index {table}.webLogAndUrl..." + if not (indexes |> List.contains Index.WebLogAndUrl) then + log.LogInformation $"Creating index {table}.{Index.WebLogAndUrl}..." do! rethink { withTable table - indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj) + indexCreate Index.WebLogAndUrl (fun row -> + [| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.UrlValue] |] :> obj) write; withRetryOnce; ignoreResult conn } // Uploaded files need an index by web log ID and path, as that is how they are retrieved if Table.Upload = table then - if not (indexes |> List.contains "webLogAndPath") then - log.LogInformation $"Creating index {table}.webLogAndPath..." + if not (indexes |> List.contains Index.WebLogAndPath) then + log.LogInformation $"Creating index {table}.{Index.WebLogAndPath}..." do! rethink { withTable table - indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj) + indexCreate Index.WebLogAndPath (fun row -> + [| row[nameof Upload.empty.WebLogId]; row[nameof Upload.empty.Path] |] :> obj) write; withRetryOnce; ignoreResult conn } // Users log on with e-mail - if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then - log.LogInformation $"Creating index {table}.logOn..." - do! rethink { - withTable table - indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj) - write; withRetryOnce; ignoreResult conn - } + if Table.WebLogUser = table then + if not (indexes |> List.contains Index.LogOn) then + log.LogInformation $"Creating index {table}.{Index.LogOn}..." + do! rethink { + withTable table + indexCreate Index.LogOn (fun row -> + [| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj) + write; withRetryOnce; ignoreResult conn + } } /// The batch size for restoration methods @@ -167,15 +192,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Category - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Category.empty.WebLogId) count result; withRetryDefault conn } member _.CountTopLevel webLogId = rethink { withTable Table.Category - getAll [ webLogId ] (nameof webLogId) - filter "parentId" None + getAll [ webLogId ] (nameof Category.empty.WebLogId) + filter (nameof Category.empty.ParentId) None count result; withRetryDefault conn } @@ -183,8 +208,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Category - getAll [ webLogId ] (nameof webLogId) - orderByFunc (fun it -> it["name"].Downcase () :> obj) + getAll [ webLogId ] (nameof Category.empty.WebLogId) + orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj) result; withRetryDefault conn } let ordered = Utils.orderByHierarchy cats None None [] @@ -200,8 +225,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.ofSeq let! count = rethink { withTable Table.Post - getAll catIds "categoryIds" - filter "status" Published + getAll catIds (nameof Post.empty.CategoryIds) + filter (nameof Post.empty.Status) Published distinct count result; withRetryDefault conn @@ -227,11 +252,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun c -> c.webLogId) <| conn + |> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn member _.FindByWebLog webLogId = rethink { withTable Table.Category - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Category.empty.WebLogId) result; withRetryDefault conn } @@ -241,9 +266,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger row["categoryIds"].Contains catId :> obj) - update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj) + getAll [ webLogId ] (nameof Post.empty.WebLogId) + filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj) + update (fun row -> + {| CategoryIds = r.Array(row[nameof Post.empty.CategoryIds]).Remove catId |} :> obj) write; withRetryDefault; ignoreResult conn } // Delete the category itself @@ -268,11 +294,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj - "slug", cat.slug - "description", cat.description - "parentId", cat.parentId + get cat.Id + update [ nameof cat.Name, cat.Name :> obj + nameof cat.Slug, cat.Slug + nameof cat.Description, cat.Description + nameof cat.ParentId, cat.ParentId ] write; withRetryDefault; ignoreResult conn } @@ -289,23 +315,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) - without [ "text"; "metadata"; "revisions"; "priorPermalinks" ] - orderByFunc (fun row -> row["title"].Downcase () :> obj) + getAll [ webLogId ] (nameof Page.empty.WebLogId) + without [ nameof Page.empty.Text + nameof Page.empty.Metadata + nameof Page.empty.Revisions + nameof Page.empty.PriorPermalinks ] + orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase () :> obj) result; withRetryDefault conn } member _.CountAll webLogId = rethink { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Page.empty.WebLogId) count result; withRetryDefault conn } member _.CountListed webLogId = rethink { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) - filter "showInPageList" true + getAll [ webLogId ] (nameof Page.empty.WebLogId) + filter (nameof Page.empty.IsInPageList) true count result; withRetryDefault conn } @@ -314,7 +343,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Page getAll [ pageId ] - filter (fun row -> row["webLogId"].Eq webLogId :> obj) + filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj) delete write; withRetryDefault conn } @@ -325,16 +354,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Page get pageId - without [ "priorPermalinks"; "revisions" ] + without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] resultOption; withRetryOptionDefault } - |> verifyWebLog webLogId (fun it -> it.webLogId) <| conn + |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn member _.FindByPermalink permalink webLogId = rethink { withTable Table.Page - getAll [ r.Array (webLogId, permalink) ] (nameof permalink) - without [ "priorPermalinks"; "revisions" ] + getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink) + without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] limit 1 result; withRetryDefault } @@ -344,14 +373,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Page - getAll (objList permalinks) "priorPermalinks" - filter "webLogId" webLogId - without [ "revisions"; "text" ] + getAll (objList permalinks) (nameof Page.empty.PriorPermalinks) + filter (nameof Page.empty.WebLogId) webLogId + without [ nameof Page.empty.Revisions; nameof Page.empty.Text ] limit 1 result; withRetryDefault } |> tryFirst) conn - return result |> Option.map (fun pg -> pg.permalink) + return result |> Option.map (fun pg -> pg.Permalink) } member _.FindFullById pageId webLogId = @@ -360,28 +389,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun it -> it.webLogId) <| conn + |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn member _.FindFullByWebLog webLogId = rethink { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Page.empty.WebLogId) resultCursor; withRetryCursorDefault; toList conn } member _.FindListed webLogId = rethink { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) - filter [ "showInPageList", true :> obj ] - without [ "text"; "priorPermalinks"; "revisions" ] + getAll [ webLogId ] (nameof Page.empty.WebLogId) + filter [ nameof Page.empty.IsInPageList, true :> obj ] + without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ] orderBy "title" result; withRetryDefault conn } member _.FindPageOfPages webLogId pageNbr = rethink { withTable Table.Page - getAll [ webLogId ] (nameof webLogId) - without [ "metadata"; "priorPermalinks"; "revisions" ] - orderByFunc (fun row -> row["title"].Downcase ()) + getAll [ webLogId ] (nameof Page.empty.WebLogId) + without [ nameof Page.empty.Metadata + nameof Page.empty.PriorPermalinks + nameof Page.empty.Revisions ] + orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ()) skip ((pageNbr - 1) * 25) limit 25 result; withRetryDefault conn @@ -398,17 +429,17 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj - "permalink", page.permalink - "updatedOn", page.updatedOn - "showInPageList", page.showInPageList - "template", page.template - "text", page.text - "priorPermalinks", page.priorPermalinks - "metadata", page.metadata - "revisions", page.revisions + nameof page.Title, page.Title :> obj + nameof page.Permalink, page.Permalink + nameof page.UpdatedOn, page.UpdatedOn + nameof page.IsInPageList, page.IsInPageList + nameof page.Template, page.Template + nameof page.Text, page.Text + nameof page.PriorPermalinks, page.PriorPermalinks + nameof page.Metadata, page.Metadata + nameof page.Revisions, page.Revisions ] write; withRetryDefault; ignoreResult conn } @@ -419,7 +450,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj ] + update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ] write; withRetryDefault; ignoreResult conn } return true @@ -438,8 +469,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - filter "status" status + getAll [ webLogId ] (nameof Post.empty.WebLogId) + filter (nameof Post.empty.Status) status count result; withRetryDefault conn } @@ -448,7 +479,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post getAll [ postId ] - filter (fun row -> row["webLogId"].Eq webLogId :> obj) + filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj) delete write; withRetryDefault conn } @@ -459,16 +490,16 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post get postId - without [ "priorPermalinks"; "revisions" ] + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] resultOption; withRetryOptionDefault } - |> verifyWebLog webLogId (fun p -> p.webLogId) <| conn + |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn member _.FindByPermalink permalink webLogId = rethink { withTable Table.Post - getAll [ r.Array (webLogId, permalink) ] (nameof permalink) - without [ "priorPermalinks"; "revisions" ] + getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink) + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] limit 1 result; withRetryDefault } @@ -480,36 +511,36 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun p -> p.webLogId) <| conn + |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn member _.FindCurrentPermalink permalinks webLogId = backgroundTask { let! result = (rethink { withTable Table.Post - getAll (objList permalinks) "priorPermalinks" - filter "webLogId" webLogId - without [ "revisions"; "text" ] + getAll (objList permalinks) (nameof Post.empty.PriorPermalinks) + filter (nameof Post.empty.WebLogId) webLogId + without [ nameof Post.empty.Revisions; nameof Post.empty.Text ] limit 1 result; withRetryDefault } |> tryFirst) conn - return result |> Option.map (fun post -> post.permalink) + return result |> Option.map (fun post -> post.Permalink) } member _.FindFullByWebLog webLogId = rethink { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Post.empty.WebLogId) resultCursor; withRetryCursorDefault; toList conn } member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { withTable Table.Post - getAll (objList categoryIds) "categoryIds" - filter "webLogId" webLogId - filter "status" Published - without [ "priorPermalinks"; "revisions" ] + getAll (objList categoryIds) (nameof Post.empty.CategoryIds) + filter [ nameof Post.empty.WebLogId, webLogId :> obj + nameof Post.empty.Status, Published ] + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] distinct - orderByDescending "publishedOn" + orderByDescending (nameof Post.empty.PublishedOn) skip ((pageNbr - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault conn @@ -517,9 +548,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - without [ "priorPermalinks"; "revisions" ] - orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj) + getAll [ webLogId ] (nameof Post.empty.WebLogId) + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] + orderByFuncDescending (fun row -> + row[nameof Post.empty.PublishedOn].Default_ (nameof Post.empty.UpdatedOn) :> obj) skip ((pageNbr - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault conn @@ -527,10 +559,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - filter "status" Published - without [ "priorPermalinks"; "revisions" ] - orderByDescending "publishedOn" + getAll [ webLogId ] (nameof Post.empty.WebLogId) + filter (nameof Post.empty.Status) Published + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] + orderByDescending (nameof Post.empty.PublishedOn) skip ((pageNbr - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault conn @@ -538,11 +570,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ tag ] "tags" - filter "webLogId" webLogId - filter "status" Published - without [ "priorPermalinks"; "revisions" ] - orderByDescending "publishedOn" + getAll [ tag ] (nameof Post.empty.Tags) + filter [ nameof Post.empty.WebLogId, webLogId :> obj + nameof Post.empty.Status, Published ] + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] + orderByDescending (nameof Post.empty.PublishedOn) skip ((pageNbr - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault conn @@ -552,10 +584,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - filter (fun row -> row["publishedOn"].Lt publishedOn :> obj) - without [ "priorPermalinks"; "revisions" ] - orderByDescending "publishedOn" + getAll [ webLogId ] (nameof Post.empty.WebLogId) + filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj) + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] + orderByDescending (nameof Post.empty.PublishedOn) limit 1 result; withRetryDefault } @@ -563,10 +595,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - filter (fun row -> row["publishedOn"].Gt publishedOn :> obj) - without [ "priorPermalinks"; "revisions" ] - orderBy "publishedOn" + getAll [ webLogId ] (nameof Post.empty.WebLogId) + filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj) + without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ] + orderBy (nameof Post.empty.PublishedOn) limit 1 result; withRetryDefault } @@ -585,7 +617,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post get postId - without [ "revisions"; "priorPermalinks" ] + without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ] resultOption; withRetryOptionDefault } - |> verifyWebLog webLogId (fun p -> p.webLogId)) conn with + |> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with | Some _ -> do! rethink { withTable Table.Post get postId - update [ "priorPermalinks", permalinks :> obj ] + update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ] write; withRetryDefault; ignoreResult conn } return true @@ -618,7 +650,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.TagMap getAll [ tagMapId ] - filter (fun row -> row["webLogId"].Eq webLogId :> obj) + filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj) delete write; withRetryDefault conn } @@ -631,12 +663,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn + |> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn member _.FindByUrlValue urlValue webLogId = rethink { withTable Table.TagMap - getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl" + getAll [ [| webLogId :> obj; urlValue |] ] Index.WebLogAndUrl limit 1 result; withRetryDefault } @@ -644,14 +676,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.TagMap - between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ] - orderBy "tag" + between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj, r.Maxval () |] + [ Index Index.WebLogAndTag ] + orderBy (nameof TagMap.empty.Tag) result; withRetryDefault conn } member _.FindMappingForTags tags webLogId = rethink { withTable Table.TagMap - getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag" + getAll (tags |> List.map (fun tag -> [| webLogId :> obj; tag |] :> obj)) Index.WebLogAndTag result; withRetryDefault conn } @@ -666,7 +699,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Theme - filter (fun row -> row["id"].Ne "admin" :> obj) - without [ "templates" ] - orderBy "id" + filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj) + without [ nameof Theme.empty.Templates ] + orderBy (nameof Theme.empty.Id) result; withRetryDefault conn } @@ -692,13 +725,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Theme get themeId - merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |])) + merge (fun row -> {| Templates = row[nameof Theme.empty.Templates].Without [| "Text" |] |}) resultOption; withRetryOptionDefault conn } member _.Save theme = rethink { withTable Table.Theme - get theme.id + get theme.Id replace theme write; withRetryDefault; ignoreResult conn } @@ -709,7 +742,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.ThemeAsset - without [ "data" ] + without [ nameof ThemeAsset.empty.Data ] result; withRetryDefault conn } @@ -729,7 +762,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) - without [ "data" ] + without [ nameof ThemeAsset.empty.Data ] result; withRetryDefault conn } @@ -741,7 +774,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun u -> u.webLogId) <| conn + |> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn match upload with | Some up -> do! rethink { @@ -772,30 +805,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger return Result.Error $"Upload ID {UploadId.toString uploadId} not found" } member _.FindByPath path webLogId = rethink { withTable Table.Upload - getAll [ r.Array (webLogId, path) ] "webLogAndPath" + getAll [ [| webLogId :> obj; path |] ] Index.WebLogAndPath resultCursor; withRetryCursorDefault; toList } |> tryFirst <| conn member _.FindByWebLog webLogId = rethink { withTable Table.Upload - between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) - [ Index "webLogAndPath" ] - without [ "data" ] + between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] + [ Index Index.WebLogAndPath ] + without [ nameof Upload.empty.Data ] resultCursor; withRetryCursorDefault; toList conn } member _.FindByWebLogWithData webLogId = rethink { withTable Table.Upload - between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) - [ Index "webLogAndPath" ] + between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] + [ Index Index.WebLogAndPath ] resultCursor; withRetryCursorDefault; toList conn } @@ -826,40 +859,40 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + let! thePostIds = rethink<{| Id : string |} list> { withTable Table.Post - getAll [ webLogId ] (nameof webLogId) - pluck [ "id" ] + getAll [ webLogId ] (nameof Post.empty.WebLogId) + pluck [ nameof Post.empty.Id ] result; withRetryOnce conn } if not (List.isEmpty thePostIds) then - let postIds = thePostIds |> List.map (fun it -> it.id :> obj) + let postIds = thePostIds |> List.map (fun it -> it.Id :> obj) do! rethink { withTable Table.Comment - getAll postIds "postId" + getAll postIds (nameof Comment.empty.PostId) delete write; withRetryOnce; ignoreResult conn } // Tag mappings do not have a straightforward webLogId index do! rethink { withTable Table.TagMap - between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) - [ Index "webLogAndTag" ] + between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] + [ Index Index.WebLogAndTag ] delete write; withRetryOnce; ignoreResult conn } // Uploaded files do not have a straightforward webLogId index do! rethink { withTable Table.Upload - between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) - [ Index "webLogAndPath" ] + between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] + [ Index Index.WebLogAndPath ] delete write; withRetryOnce; ignoreResult conn } for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do do! rethink { withTable table - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof Post.empty.WebLogId) delete write; withRetryOnce; ignoreResult conn } @@ -874,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLog - getAll [ url ] "urlBase" + getAll [ url ] (nameof WebLog.empty.UrlBase) limit 1 result; withRetryDefault } @@ -888,24 +921,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj ] + 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 + get webLog.Id update [ - "name", webLog.name :> obj - "slug", webLog.slug - "subtitle", webLog.subtitle - "defaultPage", webLog.defaultPage - "postsPerPage", webLog.postsPerPage - "timeZone", webLog.timeZone - "themePath", webLog.themePath - "autoHtmx", webLog.autoHtmx - "uploads", webLog.uploads + nameof webLog.Name, webLog.Name :> obj + nameof webLog.Slug, webLog.Slug + nameof webLog.Subtitle, webLog.Subtitle + nameof webLog.DefaultPage, webLog.DefaultPage + nameof webLog.PostsPerPage, webLog.PostsPerPage + nameof webLog.TimeZone, webLog.TimeZone + nameof webLog.ThemeId, webLog.ThemeId + nameof webLog.AutoHtmx, webLog.AutoHtmx + nameof webLog.Uploads, webLog.Uploads ] write; withRetryDefault; ignoreResult conn } @@ -923,7 +956,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLogUser - getAll [ r.Array (webLogId, email) ] "logOn" + getAll [ [| webLogId :> obj; email |] ] Index.LogOn limit 1 result; withRetryDefault } @@ -935,11 +968,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun u -> u.webLogId) <| conn + |> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn member _.FindByWebLog webLogId = rethink { withTable Table.WebLogUser - getAll [ webLogId ] (nameof webLogId) + getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId) result; withRetryDefault conn } @@ -947,12 +980,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLogUser getAll (objList userIds) - filter "webLogId" webLogId + filter (nameof WebLogUser.empty.WebLogId) webLogId result; withRetryDefault conn } return users - |> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) + |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) } member _.Restore users = backgroundTask { @@ -970,7 +1003,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj ] + update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ] write; withRetryOnce; ignoreResult conn } | None -> () @@ -978,14 +1011,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj - "lastName", user.lastName - "preferredName", user.preferredName - "passwordHash", user.passwordHash - "salt", user.salt - "accessLevel", user.accessLevel + nameof user.FirstName, user.FirstName :> obj + nameof user.LastName, user.LastName + nameof user.PreferredName, user.PreferredName + nameof user.PasswordHash, user.PasswordHash + nameof user.Salt, user.Salt + nameof user.AccessLevel, user.AccessLevel ] write; withRetryDefault; ignoreResult conn } @@ -1001,14 +1034,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.contains tbl) then log.LogInformation $"Creating table {tbl}..." - do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn } + do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn } - do! ensureIndexes Table.Category [ "webLogId" ] - do! ensureIndexes Table.Comment [ "postId" ] - do! ensureIndexes Table.Page [ "webLogId"; "authorId" ] - do! ensureIndexes Table.Post [ "webLogId"; "authorId" ] + 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 ] + do! ensureIndexes Table.Post [ nameof Post.empty.WebLogId; nameof Post.empty.AuthorId ] do! ensureIndexes Table.TagMap [] do! ensureIndexes Table.Upload [] - do! ensureIndexes Table.WebLog [ "urlBase" ] - do! ensureIndexes Table.WebLogUser [ "webLogId" ] + do! ensureIndexes Table.WebLog [ nameof WebLog.empty.UrlBase ] + do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ] } diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 03f0067..6cf0619 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -19,7 +19,7 @@ let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) = /// Find meta items added and removed let diffMetaItems (oldItems : MetaItem list) newItems = - diffLists oldItems newItems (fun item -> $"{item.name}|{item.value}") + diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}") /// Find the permalinks added and removed let diffPermalinks oldLinks newLinks = @@ -27,7 +27,7 @@ let diffPermalinks oldLinks newLinks = /// Find the revisions added and removed let diffRevisions oldRevs newRevs = - diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.asOf.Ticks}|{MarkupText.toString rev.text}") + diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}") /// Create a list of items from the given data reader let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) = @@ -39,8 +39,7 @@ let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader -> if rdr.Read () then let item = it rdr if prop item = webLogId then Some item else None - else - None + else None /// Execute a command that returns no data let write (cmd : SqliteCommand) = backgroundTask { @@ -101,134 +100,134 @@ module Map = let tryTimeSpan col (rdr : SqliteDataReader) = if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) - /// Create a category ID from the current row in the given data reader - let toCategoryId = getString "id" >> CategoryId + /// Map an id field to a category ID + let toCategoryId rdr = getString "id" rdr |> CategoryId /// Create a category from the current row in the given data reader - let toCategory (rdr : SqliteDataReader) : Category = - { id = toCategoryId rdr - webLogId = WebLogId (getString "web_log_id" rdr) - name = getString "name" rdr - slug = getString "slug" rdr - description = tryString "description" rdr - parentId = tryString "parent_id" rdr |> Option.map CategoryId + let toCategory rdr : Category = + { Id = toCategoryId rdr + WebLogId = getString "web_log_id" rdr |> WebLogId + Name = getString "name" rdr + Slug = getString "slug" rdr + Description = tryString "description" rdr + ParentId = tryString "parent_id" rdr |> Option.map CategoryId } /// Create a custom feed from the current row in the given data reader - let toCustomFeed (rdr : SqliteDataReader) : CustomFeed = - { id = CustomFeedId (getString "id" rdr) - source = CustomFeedSource.parse (getString "source" rdr) - path = Permalink (getString "path" rdr) - podcast = + let toCustomFeed rdr : CustomFeed = + { Id = getString "id" rdr |> CustomFeedId + Source = getString "source" rdr |> CustomFeedSource.parse + Path = getString "path" rdr |> Permalink + Podcast = if rdr.IsDBNull (rdr.GetOrdinal "title") then None else Some { - title = getString "title" rdr - subtitle = tryString "subtitle" rdr - itemsInFeed = getInt "items_in_feed" rdr - summary = getString "summary" rdr - displayedAuthor = getString "displayed_author" rdr - email = getString "email" rdr - imageUrl = Permalink (getString "image_url" rdr) - iTunesCategory = getString "itunes_category" rdr - iTunesSubcategory = tryString "itunes_subcategory" rdr - explicit = ExplicitRating.parse (getString "explicit" rdr) - defaultMediaType = tryString "default_media_type" rdr - mediaBaseUrl = tryString "media_base_url" rdr - guid = tryGuid "guid" rdr - fundingUrl = tryString "funding_url" rdr - fundingText = tryString "funding_text" rdr - medium = tryString "medium" rdr |> Option.map PodcastMedium.parse + Title = getString "title" rdr + Subtitle = tryString "subtitle" rdr + ItemsInFeed = getInt "items_in_feed" rdr + Summary = getString "summary" rdr + DisplayedAuthor = getString "displayed_author" rdr + Email = getString "email" rdr + ImageUrl = getString "image_url" rdr |> Permalink + AppleCategory = getString "apple_category" rdr + AppleSubcategory = tryString "apple_subcategory" rdr + Explicit = getString "explicit" rdr |> ExplicitRating.parse + DefaultMediaType = tryString "default_media_type" rdr + MediaBaseUrl = tryString "media_base_url" rdr + PodcastGuid = tryGuid "podcast_guid" rdr + FundingUrl = tryString "funding_url" rdr + FundingText = tryString "funding_text" rdr + Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse } } /// Create a meta item from the current row in the given data reader - let toMetaItem (rdr : SqliteDataReader) : MetaItem = - { name = getString "name" rdr - value = getString "value" rdr + let toMetaItem rdr : MetaItem = + { Name = getString "name" rdr + Value = getString "value" rdr } /// Create a permalink from the current row in the given data reader - let toPermalink = getString "permalink" >> Permalink + let toPermalink rdr = getString "permalink" rdr |> Permalink /// Create a page from the current row in the given data reader - let toPage (rdr : SqliteDataReader) : Page = + let toPage rdr : Page = { Page.empty with - id = PageId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - authorId = WebLogUserId (getString "author_id" rdr) - title = getString "title" rdr - permalink = toPermalink rdr - publishedOn = getDateTime "published_on" rdr - updatedOn = getDateTime "updated_on" rdr - showInPageList = getBoolean "show_in_page_list" rdr - template = tryString "template" rdr - text = getString "page_text" rdr + Id = getString "id" rdr |> PageId + WebLogId = getString "web_log_id" rdr |> WebLogId + AuthorId = getString "author_id" rdr |> WebLogUserId + Title = getString "title" rdr + Permalink = toPermalink rdr + PublishedOn = getDateTime "published_on" rdr + UpdatedOn = getDateTime "updated_on" rdr + IsInPageList = getBoolean "is_in_page_list" rdr + Template = tryString "template" rdr + Text = getString "page_text" rdr } /// Create a post from the current row in the given data reader - let toPost (rdr : SqliteDataReader) : Post = + let toPost rdr : Post = { Post.empty with - id = PostId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - authorId = WebLogUserId (getString "author_id" rdr) - status = PostStatus.parse (getString "status" rdr) - title = getString "title" rdr - permalink = toPermalink rdr - publishedOn = tryDateTime "published_on" rdr - updatedOn = getDateTime "updated_on" rdr - template = tryString "template" rdr - text = getString "post_text" rdr - episode = + Id = getString "id" rdr |> PostId + WebLogId = getString "web_log_id" rdr |> WebLogId + AuthorId = getString "author_id" rdr |> WebLogUserId + Status = getString "status" rdr |> PostStatus.parse + Title = getString "title" rdr + Permalink = toPermalink rdr + PublishedOn = tryDateTime "published_on" rdr + UpdatedOn = getDateTime "updated_on" rdr + Template = tryString "template" rdr + Text = getString "post_text" rdr + Episode = match tryString "media" rdr with | Some media -> Some { - media = media - length = getLong "length" rdr - duration = tryTimeSpan "duration" rdr - mediaType = tryString "media_type" rdr - imageUrl = tryString "image_url" rdr - subtitle = tryString "subtitle" rdr - explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse - chapterFile = tryString "chapter_file" rdr - chapterType = tryString "chapter_type" rdr - transcriptUrl = tryString "transcript_url" rdr - transcriptType = tryString "transcript_type" rdr - transcriptLang = tryString "transcript_lang" rdr - transcriptCaptions = tryBoolean "transcript_captions" rdr - seasonNumber = tryInt "season_number" rdr - seasonDescription = tryString "season_description" rdr - episodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse - episodeDescription = tryString "episode_description" rdr + Media = media + Length = getLong "length" rdr + Duration = tryTimeSpan "duration" rdr + MediaType = tryString "media_type" rdr + ImageUrl = tryString "image_url" rdr + Subtitle = tryString "subtitle" rdr + Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse + ChapterFile = tryString "chapter_file" rdr + ChapterType = tryString "chapter_type" rdr + TranscriptUrl = tryString "transcript_url" rdr + TranscriptType = tryString "transcript_type" rdr + TranscriptLang = tryString "transcript_lang" rdr + TranscriptCaptions = tryBoolean "transcript_captions" rdr + SeasonNumber = tryInt "season_number" rdr + SeasonDescription = tryString "season_description" rdr + EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse + EpisodeDescription = tryString "episode_description" rdr } | None -> None } /// Create a revision from the current row in the given data reader - let toRevision (rdr : SqliteDataReader) : Revision = - { asOf = getDateTime "as_of" rdr - text = MarkupText.parse (getString "revision_text" rdr) + let toRevision rdr : Revision = + { AsOf = getDateTime "as_of" rdr + Text = getString "revision_text" rdr |> MarkupText.parse } /// Create a tag mapping from the current row in the given data reader - let toTagMap (rdr : SqliteDataReader) : TagMap = - { id = TagMapId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - tag = getString "tag" rdr - urlValue = getString "url_value" rdr + let toTagMap rdr : TagMap = + { Id = getString "id" rdr |> TagMapId + WebLogId = getString "web_log_id" rdr |> WebLogId + Tag = getString "tag" rdr + UrlValue = getString "url_value" rdr } /// Create a theme from the current row in the given data reader (excludes templates) - let toTheme (rdr : SqliteDataReader) : Theme = + let toTheme rdr : Theme = { Theme.empty with - id = ThemeId (getString "id" rdr) - name = getString "name" rdr - version = getString "version" rdr + Id = getString "id" rdr |> ThemeId + Name = getString "name" rdr + Version = getString "version" rdr } /// Create a theme asset from the current row in the given data reader - let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset = + let toThemeAsset includeData rdr : ThemeAsset = let assetData = if includeData then use dataStream = new MemoryStream () @@ -237,19 +236,19 @@ module Map = dataStream.ToArray () else [||] - { id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) - updatedOn = getDateTime "updated_on" rdr - data = assetData + { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) + UpdatedOn = getDateTime "updated_on" rdr + Data = assetData } /// Create a theme template from the current row in the given data reader - let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate = - { name = getString "name" rdr - text = getString "template" rdr + let toThemeTemplate rdr : ThemeTemplate = + { Name = getString "name" rdr + Text = getString "template" rdr } /// Create an uploaded file from the current row in the given data reader - let toUpload includeData (rdr : SqliteDataReader) : Upload = + let toUpload includeData rdr : Upload = let data = if includeData then use dataStream = new MemoryStream () @@ -258,51 +257,51 @@ module Map = dataStream.ToArray () else [||] - { id = UploadId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - path = Permalink (getString "path" rdr) - updatedOn = getDateTime "updated_on" rdr - data = data + { Id = getString "id" rdr |> UploadId + WebLogId = getString "web_log_id" rdr |> WebLogId + Path = getString "path" rdr |> Permalink + UpdatedOn = getDateTime "updated_on" rdr + Data = data } /// Create a web log from the current row in the given data reader - let toWebLog (rdr : SqliteDataReader) : WebLog = - { id = WebLogId (getString "id" rdr) - name = getString "name" rdr - slug = getString "slug" rdr - subtitle = tryString "subtitle" rdr - defaultPage = getString "default_page" rdr - postsPerPage = getInt "posts_per_page" rdr - themePath = getString "theme_id" rdr - urlBase = getString "url_base" rdr - timeZone = getString "time_zone" rdr - autoHtmx = getBoolean "auto_htmx" rdr - uploads = UploadDestination.parse (getString "uploads" rdr) - rss = { - feedEnabled = getBoolean "feed_enabled" rdr - feedName = getString "feed_name" rdr - itemsInFeed = tryInt "items_in_feed" rdr - categoryEnabled = getBoolean "category_enabled" rdr - tagEnabled = getBoolean "tag_enabled" rdr - copyright = tryString "copyright" rdr - customFeeds = [] + let toWebLog rdr : WebLog = + { Id = getString "id" rdr |> WebLogId + Name = getString "name" rdr + Slug = getString "slug" rdr + Subtitle = tryString "subtitle" rdr + DefaultPage = getString "default_page" rdr + PostsPerPage = getInt "posts_per_page" rdr + ThemeId = getString "theme_id" rdr |> ThemeId + UrlBase = getString "url_base" rdr + TimeZone = getString "time_zone" rdr + AutoHtmx = getBoolean "auto_htmx" rdr + Uploads = getString "uploads" rdr |> UploadDestination.parse + Rss = { + IsFeedEnabled = getBoolean "is_feed_enabled" rdr + FeedName = getString "feed_name" rdr + ItemsInFeed = tryInt "items_in_feed" rdr + IsCategoryEnabled = getBoolean "is_category_enabled" rdr + IsTagEnabled = getBoolean "is_tag_enabled" rdr + Copyright = tryString "copyright" rdr + CustomFeeds = [] } } /// Create a web log user from the current row in the given data reader - let toWebLogUser (rdr : SqliteDataReader) : WebLogUser = - { id = WebLogUserId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - userName = getString "user_name" rdr - firstName = getString "first_name" rdr - lastName = getString "last_name" rdr - preferredName = getString "preferred_name" rdr - passwordHash = getString "password_hash" rdr - salt = getGuid "salt" rdr - url = tryString "url" rdr - accessLevel = AccessLevel.parse (getString "access_level" rdr) - createdOn = getDateTime "created_on" rdr - lastSeenOn = tryDateTime "last_seen_on" rdr + let toWebLogUser rdr : WebLogUser = + { Id = getString "id" rdr |> WebLogUserId + WebLogId = getString "web_log_id" rdr |> WebLogId + Email = getString "email" rdr + FirstName = getString "first_name" rdr + LastName = getString "last_name" rdr + PreferredName = getString "preferred_name" rdr + PasswordHash = getString "password_hash" rdr + Salt = getGuid "salt" rdr + Url = tryString "url" rdr + AccessLevel = getString "access_level" rdr |> AccessLevel.parse + CreatedOn = getDateTime "created_on" rdr + LastSeenOn = tryDateTime "last_seen_on" rdr } /// Add a possibly-missing parameter, substituting null for None diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index 3418348..1da225c 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -10,12 +10,12 @@ type SQLiteCategoryData (conn : SqliteConnection) = /// Add parameters for category INSERT or UPDATE statements let addCategoryParameters (cmd : SqliteCommand) (cat : Category) = - [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId) - cmd.Parameters.AddWithValue ("@name", cat.name) - cmd.Parameters.AddWithValue ("@slug", cat.slug) - cmd.Parameters.AddWithValue ("@description", maybe cat.description) - cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString)) + [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId) + cmd.Parameters.AddWithValue ("@name", cat.Name) + cmd.Parameters.AddWithValue ("@slug", cat.Slug) + cmd.Parameters.AddWithValue ("@description", maybe cat.Description) + cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString)) ] |> ignore /// Add a category @@ -60,7 +60,7 @@ type SQLiteCategoryData (conn : SqliteConnection) = while rdr.Read () do Map.toCategory rdr } - |> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ()) + |> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ()) |> List.ofSeq do! rdr.CloseAsync () let ordered = Utils.orderByHierarchy cats None None [] @@ -107,7 +107,7 @@ type SQLiteCategoryData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM category WHERE id = @id" cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return Helpers.verifyWebLog webLogId (fun c -> c.webLogId) Map.toCategory rdr + return Helpers.verifyWebLog webLogId (fun c -> c.WebLogId) Map.toCategory rdr } /// Find all categories for the given web log diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 98a7324..0dac7bb 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -12,45 +12,45 @@ type SQLitePageData (conn : SqliteConnection) = /// Add parameters for page INSERT or UPDATE statements let addPageParameters (cmd : SqliteCommand) (page : Page) = - [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId) - cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId) - cmd.Parameters.AddWithValue ("@title", page.title) - cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink) - cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn) - cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList) - cmd.Parameters.AddWithValue ("@template", maybe page.template) - cmd.Parameters.AddWithValue ("@text", page.text) + [ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId) + cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) + cmd.Parameters.AddWithValue ("@title", page.Title) + cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink) + cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn) + cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn) + cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) + cmd.Parameters.AddWithValue ("@template", maybe page.Template) + cmd.Parameters.AddWithValue ("@text", page.Text) ] |> ignore /// Append meta items to a page let appendPageMeta (page : Page) = backgroundTask { use cmd = conn.CreateCommand () cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id" - cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) |> ignore + cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return { page with metadata = toList Map.toMetaItem rdr } + return { page with Metadata = toList Map.toMetaItem rdr } } /// Append revisions and permalinks to a page let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore + cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId" use! rdr = cmd.ExecuteReaderAsync () - let page = { page with priorPermalinks = toList Map.toPermalink rdr } + let page = { page with PriorPermalinks = toList Map.toPermalink rdr } do! rdr.CloseAsync () cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC" use! rdr = cmd.ExecuteReaderAsync () - return { page with revisions = toList Map.toRevision rdr } + return { page with Revisions = toList Map.toRevision rdr } } /// Return a page with no text (or meta items, prior permalinks, or revisions) let pageWithoutTextOrMeta rdr = - { Map.toPage rdr with text = "" } + { Map.toPage rdr with Text = "" } /// Update a page's metadata items let updatePageMeta pageId oldItems newItems = backgroundTask { @@ -64,8 +64,8 @@ type SQLitePageData (conn : SqliteConnection) = cmd.Parameters.Add ("@value", SqliteType.Text) ] |> ignore let runCmd (item : MetaItem) = backgroundTask { - cmd.Parameters["@name" ].Value <- item.name - cmd.Parameters["@value"].Value <- item.value + cmd.Parameters["@name" ].Value <- item.Name + cmd.Parameters["@value"].Value <- item.Value do! write cmd } cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value" @@ -116,9 +116,9 @@ type SQLitePageData (conn : SqliteConnection) = let runCmd withText rev = backgroundTask { cmd.Parameters.Clear () [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) - cmd.Parameters.AddWithValue ("@asOf", rev.asOf) + cmd.Parameters.AddWithValue ("@asOf", rev.AsOf) ] |> ignore - if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore + if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore do! write cmd } cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" @@ -141,17 +141,17 @@ type SQLitePageData (conn : SqliteConnection) = // The page itself cmd.CommandText <- """ INSERT INTO page ( - id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template, + id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template, page_text ) VALUES ( - @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template, + @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template, @text )""" addPageParameters cmd page do! write cmd - do! updatePageMeta page.id [] page.metadata - do! updatePagePermalinks page.id [] page.priorPermalinks - do! updatePageRevisions page.id [] page.revisions + do! updatePageMeta page.Id [] page.Metadata + do! updatePagePermalinks page.Id [] page.PriorPermalinks + do! updatePageRevisions page.Id [] page.Revisions } /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) @@ -177,10 +177,10 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- """ SELECT COUNT(id) FROM page - WHERE web_log_id = @webLogId - AND show_in_page_list = @showInPageList""" + WHERE web_log_id = @webLogId + AND is_in_page_list = @isInPageList""" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore + cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore return! count cmd } @@ -190,7 +190,7 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM page WHERE id = @id" cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - match Helpers.verifyWebLog webLogId (fun it -> it.webLogId) Map.toPage rdr with + match Helpers.verifyWebLog webLogId (fun it -> it.WebLogId) Map.toPage rdr with | Some page -> let! page = appendPageMeta page return Some page @@ -277,11 +277,11 @@ type SQLitePageData (conn : SqliteConnection) = cmd.CommandText <- """ SELECT * FROM page - WHERE web_log_id = @webLogId - AND show_in_page_list = @showInPageList + WHERE web_log_id = @webLogId + AND is_in_page_list = @isInPageList ORDER BY LOWER(title)""" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore + cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore use! rdr = cmd.ExecuteReaderAsync () let! pages = toList pageWithoutTextOrMeta rdr @@ -315,26 +315,26 @@ type SQLitePageData (conn : SqliteConnection) = /// Update a page let update (page : Page) = backgroundTask { - match! findFullById page.id page.webLogId with + match! findFullById page.Id page.WebLogId with | Some oldPage -> use cmd = conn.CreateCommand () cmd.CommandText <- """ UPDATE page - SET author_id = @authorId, - title = @title, - permalink = @permalink, - published_on = @publishedOn, - updated_on = @updatedOn, - show_in_page_list = @showInPageList, - template = @template, - page_text = @text + SET author_id = @authorId, + title = @title, + permalink = @permalink, + published_on = @publishedOn, + updated_on = @updatedOn, + is_in_page_list = @isInPageList, + template = @template, + page_text = @text WHERE id = @pageId AND web_log_id = @webLogId""" addPageParameters cmd page do! write cmd - do! updatePageMeta page.id oldPage.metadata page.metadata - do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks - do! updatePageRevisions page.id oldPage.revisions page.revisions + do! updatePageMeta page.Id oldPage.Metadata page.Metadata + do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks + do! updatePageRevisions page.Id oldPage.Revisions page.Revisions return () | None -> return () } @@ -343,7 +343,7 @@ type SQLitePageData (conn : SqliteConnection) = let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { match! findFullById pageId webLogId with | Some page -> - do! updatePagePermalinks pageId page.priorPermalinks permalinks + do! updatePagePermalinks pageId page.PriorPermalinks permalinks return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index afeae82..fb4b7ff 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -13,72 +13,72 @@ type SQLitePostData (conn : SqliteConnection) = /// Add parameters for post INSERT or UPDATE statements let addPostParameters (cmd : SqliteCommand) (post : Post) = - [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId) - cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId) - cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status) - cmd.Parameters.AddWithValue ("@title", post.title) - cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink) - cmd.Parameters.AddWithValue ("@publishedOn", maybe post.publishedOn) - cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn) - cmd.Parameters.AddWithValue ("@template", maybe post.template) - cmd.Parameters.AddWithValue ("@text", post.text) + [ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId) + cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId) + cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status) + cmd.Parameters.AddWithValue ("@title", post.Title) + cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink) + cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn) + cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn) + cmd.Parameters.AddWithValue ("@template", maybe post.Template) + cmd.Parameters.AddWithValue ("@text", post.Text) ] |> ignore /// Add parameters for episode INSERT or UPDATE statements let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) = - [ cmd.Parameters.AddWithValue ("@media", ep.media) - cmd.Parameters.AddWithValue ("@length", ep.length) - cmd.Parameters.AddWithValue ("@duration", maybe ep.duration) - cmd.Parameters.AddWithValue ("@mediaType", maybe ep.mediaType) - cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.imageUrl) - cmd.Parameters.AddWithValue ("@subtitle", maybe ep.subtitle) - cmd.Parameters.AddWithValue ("@explicit", maybe (ep.explicit |> Option.map ExplicitRating.toString)) - cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.chapterFile) - cmd.Parameters.AddWithValue ("@chapterType", maybe ep.chapterType) - cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.transcriptUrl) - cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.transcriptType) - cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.transcriptLang) - cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.transcriptCaptions) - cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.seasonNumber) - cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.seasonDescription) - cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.episodeNumber |> Option.map string)) - cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.episodeDescription) + [ cmd.Parameters.AddWithValue ("@media", ep.Media) + cmd.Parameters.AddWithValue ("@length", ep.Length) + cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration) + cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType) + cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl) + cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle) + cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString)) + cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile) + cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType) + cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl) + cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType) + cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang) + cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions) + cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber) + cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription) + cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string)) + cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription) ] |> ignore /// Append category IDs, tags, and meta items to a post let appendPostCategoryTagAndMeta (post : Post) = backgroundTask { use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore + cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id" use! rdr = cmd.ExecuteReaderAsync () - let post = { post with categoryIds = toList Map.toCategoryId rdr } + let post = { post with CategoryIds = toList Map.toCategoryId rdr } do! rdr.CloseAsync () cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id" use! rdr = cmd.ExecuteReaderAsync () - let post = { post with tags = toList (Map.getString "tag") rdr } + let post = { post with Tags = toList (Map.getString "tag") rdr } do! rdr.CloseAsync () cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id" use! rdr = cmd.ExecuteReaderAsync () - return { post with metadata = toList Map.toMetaItem rdr } + return { post with Metadata = toList Map.toMetaItem rdr } } /// Append revisions and permalinks to a post let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask { use cmd = conn.CreateCommand () - cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore + cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId" use! rdr = cmd.ExecuteReaderAsync () - let post = { post with priorPermalinks = toList Map.toPermalink rdr } + let post = { post with PriorPermalinks = toList Map.toPermalink rdr } do! rdr.CloseAsync () cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC" use! rdr = cmd.ExecuteReaderAsync () - return { post with revisions = toList Map.toRevision rdr } + return { post with Revisions = toList Map.toRevision rdr } } /// The SELECT statement for a post that will include episode data, if it exists @@ -90,12 +90,12 @@ type SQLitePostData (conn : SqliteConnection) = cmd.CommandText <- $"{selectPost} WHERE p.id = @id" cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return Helpers.verifyWebLog webLogId (fun p -> p.webLogId) Map.toPost rdr + return Helpers.verifyWebLog webLogId (fun p -> p.WebLogId) Map.toPost rdr } /// Return a post with no revisions, prior permalinks, or text let postWithoutText rdr = - { Map.toPost rdr with text = "" } + { Map.toPost rdr with Text = "" } /// Update a post's assigned categories let updatePostCategories postId oldCats newCats = backgroundTask { @@ -153,10 +153,10 @@ type SQLitePostData (conn : SqliteConnection) = let updatePostEpisode (post : Post) = backgroundTask { use cmd = conn.CreateCommand () cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId" - cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore + cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore let! count = count cmd if count = 1 then - match post.episode with + match post.Episode with | Some ep -> cmd.CommandText <- """ UPDATE post_episode @@ -184,7 +184,7 @@ type SQLitePostData (conn : SqliteConnection) = cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId" do! write cmd else - match post.episode with + match post.Episode with | Some ep -> cmd.CommandText <- """ INSERT INTO post_episode ( @@ -213,8 +213,8 @@ type SQLitePostData (conn : SqliteConnection) = cmd.Parameters.Add ("@value", SqliteType.Text) ] |> ignore let runCmd (item : MetaItem) = backgroundTask { - cmd.Parameters["@name" ].Value <- item.name - cmd.Parameters["@value"].Value <- item.value + cmd.Parameters["@name" ].Value <- item.Name + cmd.Parameters["@value"].Value <- item.Value do! write cmd } cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value" @@ -265,9 +265,9 @@ type SQLitePostData (conn : SqliteConnection) = let runCmd withText rev = backgroundTask { cmd.Parameters.Clear () [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) - cmd.Parameters.AddWithValue ("@asOf", rev.asOf) + cmd.Parameters.AddWithValue ("@asOf", rev.AsOf) ] |> ignore - if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore + if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore do! write cmd } cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" @@ -295,12 +295,12 @@ type SQLitePostData (conn : SqliteConnection) = )""" addPostParameters cmd post do! write cmd - do! updatePostCategories post.id [] post.categoryIds - do! updatePostTags post.id [] post.tags + do! updatePostCategories post.Id [] post.CategoryIds + do! updatePostTags post.Id [] post.Tags do! updatePostEpisode post - do! updatePostMeta post.id [] post.metadata - do! updatePostPermalinks post.id [] post.priorPermalinks - do! updatePostRevisions post.id [] post.revisions + do! updatePostMeta post.Id [] post.Metadata + do! updatePostPermalinks post.Id [] post.PriorPermalinks + do! updatePostRevisions post.Id [] post.Revisions } /// Count posts in a status for the given web log @@ -535,7 +535,7 @@ type SQLitePostData (conn : SqliteConnection) = /// Update a post let update (post : Post) = backgroundTask { - match! findFullById post.id post.webLogId with + match! findFullById post.Id post.WebLogId with | Some oldPost -> use cmd = conn.CreateCommand () cmd.CommandText <- """ @@ -552,12 +552,12 @@ type SQLitePostData (conn : SqliteConnection) = AND web_log_id = @webLogId""" addPostParameters cmd post do! write cmd - do! updatePostCategories post.id oldPost.categoryIds post.categoryIds - do! updatePostTags post.id oldPost.tags post.tags + do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds + do! updatePostTags post.Id oldPost.Tags post.Tags do! updatePostEpisode post - do! updatePostMeta post.id oldPost.metadata post.metadata - do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks - do! updatePostRevisions post.id oldPost.revisions post.revisions + do! updatePostMeta post.Id oldPost.Metadata post.Metadata + do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks + do! updatePostRevisions post.Id oldPost.Revisions post.Revisions | None -> return () } @@ -565,7 +565,7 @@ type SQLitePostData (conn : SqliteConnection) = let updatePriorPermalinks postId webLogId permalinks = backgroundTask { match! findFullById postId webLogId with | Some post -> - do! updatePostPermalinks postId post.priorPermalinks permalinks + do! updatePostPermalinks postId post.PriorPermalinks permalinks return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index 0950fd3..12f53a5 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -13,7 +13,7 @@ type SQLiteTagMapData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id" cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return Helpers.verifyWebLog webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr + return Helpers.verifyWebLog webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr } /// Delete a tag mapping for the given web log @@ -69,7 +69,7 @@ type SQLiteTagMapData (conn : SqliteConnection) = /// Save a tag mapping let save (tagMap : TagMap) = backgroundTask { use cmd = conn.CreateCommand () - match! findById tagMap.id tagMap.webLogId with + match! findById tagMap.Id tagMap.WebLogId with | Some _ -> cmd.CommandText <- """ UPDATE tag_map @@ -84,10 +84,10 @@ type SQLiteTagMapData (conn : SqliteConnection) = ) VALUES ( @id, @webLogId, @tag, @urlValue )""" - addWebLogId cmd tagMap.webLogId - [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id) - cmd.Parameters.AddWithValue ("@tag", tagMap.tag) - cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue) + addWebLogId cmd tagMap.WebLogId + [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id) + cmd.Parameters.AddWithValue ("@tag", tagMap.Tag) + cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue) ] |> ignore do! write cmd } @@ -105,4 +105,4 @@ type SQLiteTagMapData (conn : SqliteConnection) = member _.FindByWebLog webLogId = findByWebLog webLogId member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId member _.Save tagMap = save tagMap - member this.Restore tagMaps = restore tagMaps + member _.Restore tagMaps = restore tagMaps diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 85ff0c0..f7d6a56 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -28,7 +28,7 @@ type SQLiteThemeData (conn : SqliteConnection) = templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id" templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore use! templateRdr = templateCmd.ExecuteReaderAsync () - return Some { theme with templates = toList Map.toThemeTemplate templateRdr } + return Some { theme with Templates = toList Map.toThemeTemplate templateRdr } else return None } @@ -38,7 +38,7 @@ type SQLiteThemeData (conn : SqliteConnection) = match! findById themeId with | Some theme -> return Some { - theme with templates = theme.templates |> List.map (fun t -> { t with text = "" }) + theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" }) } | None -> return None } @@ -46,36 +46,36 @@ type SQLiteThemeData (conn : SqliteConnection) = /// Save a theme let save (theme : Theme) = backgroundTask { use cmd = conn.CreateCommand () - let! oldTheme = findById theme.id + let! oldTheme = findById theme.Id cmd.CommandText <- match oldTheme with | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" | None -> "INSERT INTO theme VALUES (@id, @name, @version)" - [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id) - cmd.Parameters.AddWithValue ("@name", theme.name) - cmd.Parameters.AddWithValue ("@version", theme.version) + [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id) + cmd.Parameters.AddWithValue ("@name", theme.Name) + cmd.Parameters.AddWithValue ("@version", theme.Version) ] |> ignore do! write cmd let toDelete, toAdd = - diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue []) - theme.templates (fun t -> t.name) + diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue []) + theme.Templates (fun t -> t.Name) let toUpdate = - theme.templates + theme.Templates |> List.filter (fun t -> - not (toDelete |> List.exists (fun d -> d.name = t.name)) - && not (toAdd |> List.exists (fun a -> a.name = t.name))) + not (toDelete |> List.exists (fun d -> d.Name = t.Name)) + && not (toAdd |> List.exists (fun a -> a.Name = t.Name))) cmd.CommandText <- "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name" cmd.Parameters.Clear () - [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id) + [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id) cmd.Parameters.Add ("@name", SqliteType.Text) cmd.Parameters.Add ("@template", SqliteType.Text) ] |> ignore toUpdate |> List.map (fun template -> backgroundTask { - cmd.Parameters["@name" ].Value <- template.name - cmd.Parameters["@template"].Value <- template.text + cmd.Parameters["@name" ].Value <- template.Name + cmd.Parameters["@template"].Value <- template.Text do! write cmd }) |> Task.WhenAll @@ -83,8 +83,8 @@ type SQLiteThemeData (conn : SqliteConnection) = cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)" toAdd |> List.map (fun template -> backgroundTask { - cmd.Parameters["@name" ].Value <- template.name - cmd.Parameters["@template"].Value <- template.text + cmd.Parameters["@name" ].Value <- template.Name + cmd.Parameters["@template"].Value <- template.Text do! write cmd }) |> Task.WhenAll @@ -93,7 +93,7 @@ type SQLiteThemeData (conn : SqliteConnection) = cmd.Parameters.Remove cmd.Parameters["@template"] toDelete |> List.map (fun template -> backgroundTask { - cmd.Parameters["@name"].Value <- template.name + cmd.Parameters["@name"].Value <- template.Name do! write cmd }) |> Task.WhenAll @@ -163,7 +163,7 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = use sideCmd = conn.CreateCommand () sideCmd.CommandText <- "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" - let (ThemeAssetId (ThemeId themeId, path)) = asset.id + let (ThemeAssetId (ThemeId themeId, path)) = asset.Id [ sideCmd.Parameters.AddWithValue ("@themeId", themeId) sideCmd.Parameters.AddWithValue ("@path", path) ] |> ignore @@ -185,15 +185,15 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = )""" [ cmd.Parameters.AddWithValue ("@themeId", themeId) cmd.Parameters.AddWithValue ("@path", path) - cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn) - cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length) + cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn) + cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) ] |> ignore do! write cmd sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" let! rowId = sideCmd.ExecuteScalarAsync () - use dataStream = new MemoryStream (asset.data) + use dataStream = new MemoryStream (asset.Data) use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64) do! dataStream.CopyToAsync blobStream } diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index c21c717..4f20366 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -10,11 +10,11 @@ type SQLiteUploadData (conn : SqliteConnection) = /// Add parameters for uploaded file INSERT and UPDATE statements let addUploadParameters (cmd : SqliteCommand) (upload : Upload) = - [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.webLogId) - cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.path) - cmd.Parameters.AddWithValue ("@updatedOn", upload.updatedOn) - cmd.Parameters.AddWithValue ("@dataLength", upload.data.Length) + [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) + cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path) + cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn) + cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) ] |> ignore /// Save an uploaded file @@ -32,7 +32,7 @@ type SQLiteUploadData (conn : SqliteConnection) = cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id" let! rowId = cmd.ExecuteScalarAsync () - use dataStream = new MemoryStream (upload.data) + use dataStream = new MemoryStream (upload.Data) use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64) do! dataStream.CopyToAsync blobStream } @@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) = do! rdr.CloseAsync () cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" do! write cmd - return Ok (Permalink.toString upload.path) + return Ok (Permalink.toString upload.Path) else return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" } diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 60bb69d..5762c7c 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -15,57 +15,57 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Add parameters for web log INSERT or web log/RSS options UPDATE statements let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled) - cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName) - cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed) - cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled) - cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled) - cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright) + [ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled) + cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName) + cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed) + cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled) + cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled) + cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright) ] |> ignore /// Add parameters for web log INSERT or UPDATE statements let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id) - cmd.Parameters.AddWithValue ("@name", webLog.name) - cmd.Parameters.AddWithValue ("@slug", webLog.slug) - cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle) - cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage) - cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage) - cmd.Parameters.AddWithValue ("@themeId", webLog.themePath) - cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase) - cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone) - cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx) - cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.uploads) + [ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) + cmd.Parameters.AddWithValue ("@name", webLog.Name) + cmd.Parameters.AddWithValue ("@slug", webLog.Slug) + cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle) + cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage) + cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage) + cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId) + cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase) + cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone) + cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx) + cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads) ] |> ignore addWebLogRssParameters cmd webLog /// Add parameters for custom feed INSERT or UPDATE statements let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) = - [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id) + [ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) - cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source) - cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path) + cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) + cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path) ] |> ignore /// Add parameters for podcast INSERT or UPDATE statements let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) = [ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId) - cmd.Parameters.AddWithValue ("@title", podcast.title) - cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.subtitle) - cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.itemsInFeed) - cmd.Parameters.AddWithValue ("@summary", podcast.summary) - cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.displayedAuthor) - cmd.Parameters.AddWithValue ("@email", podcast.email) - cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.imageUrl) - cmd.Parameters.AddWithValue ("@iTunesCategory", podcast.iTunesCategory) - cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory) - cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.explicit) - cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.defaultMediaType) - cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.mediaBaseUrl) - cmd.Parameters.AddWithValue ("@guid", maybe podcast.guid) - cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.fundingUrl) - cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.fundingText) - cmd.Parameters.AddWithValue ("@medium", maybe (podcast.medium |> Option.map PodcastMedium.toString)) + cmd.Parameters.AddWithValue ("@title", podcast.Title) + cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle) + cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed) + cmd.Parameters.AddWithValue ("@summary", podcast.Summary) + cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor) + cmd.Parameters.AddWithValue ("@email", podcast.Email) + cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl) + cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory) + cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory) + cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit) + cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType) + cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl) + cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid) + cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl) + cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText) + cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString)) ] |> ignore /// Get the current custom feeds for a web log @@ -76,7 +76,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = FROM web_log_feed f LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id WHERE f.web_log_id = @webLogId""" - addWebLogId cmd webLog.id + addWebLogId cmd webLog.Id use! rdr = cmd.ExecuteReaderAsync () return toList Map.toCustomFeed rdr } @@ -84,7 +84,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Append custom feeds to a web log let appendCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog - return { webLog with rss = { webLog.rss with customFeeds = feeds } } + return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } } /// Add a podcast to a custom feed @@ -93,12 +93,12 @@ type SQLiteWebLogData (conn : SqliteConnection) = cmd.CommandText <- """ INSERT INTO web_log_feed_podcast ( feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, - itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url, - funding_text, medium + apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid, + funding_url, funding_text, medium ) VALUES ( @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, - @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl, - @fundingText, @medium + @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, + @fundingUrl, @fundingText, @medium )""" addPodcastParameters cmd feedId podcast do! write cmd @@ -107,12 +107,12 @@ type SQLiteWebLogData (conn : SqliteConnection) = /// Update the custom feeds for a web log let updateCustomFeeds (webLog : WebLog) = backgroundTask { let! feeds = getCustomFeeds webLog - let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}") - let toId (feed : CustomFeed) = feed.id + let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}") + let toId (feed : CustomFeed) = feed.Id let toUpdate = - webLog.rss.customFeeds + webLog.Rss.CustomFeeds |> List.filter (fun f -> - not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id)) + not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id)) use cmd = conn.CreateCommand () cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore toDelete @@ -120,7 +120,7 @@ type SQLiteWebLogData (conn : SqliteConnection) = cmd.CommandText <- """ DELETE FROM web_log_feed_podcast WHERE feed_id = @id; DELETE FROM web_log_feed WHERE id = @id""" - cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id + cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id do! write cmd }) |> Task.WhenAll @@ -135,10 +135,10 @@ type SQLiteWebLogData (conn : SqliteConnection) = @id, @webLogId, @source, @path )""" cmd.Parameters.Clear () - addCustomFeedParameters cmd webLog.id it + addCustomFeedParameters cmd webLog.Id it do! write cmd - match it.podcast with - | Some podcast -> do! addPodcast it.id podcast + match it.Podcast with + | Some podcast -> do! addPodcast it.Id podcast | None -> () }) |> Task.WhenAll @@ -152,10 +152,10 @@ type SQLiteWebLogData (conn : SqliteConnection) = WHERE id = @id AND web_log_id = @webLogId""" cmd.Parameters.Clear () - addCustomFeedParameters cmd webLog.id it + addCustomFeedParameters cmd webLog.Id it do! write cmd - let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast - match it.podcast with + let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast + match it.Podcast with | Some podcast -> if hadPodcast then cmd.CommandText <- """ @@ -167,26 +167,26 @@ type SQLiteWebLogData (conn : SqliteConnection) = displayed_author = @displayedAuthor, email = @email, image_url = @imageUrl, - itunes_category = @iTunesCategory, - itunes_subcategory = @iTunesSubcategory, + apple_category = @appleCategory, + apple_subcategory = @appleSubcategory, explicit = @explicit, default_media_type = @defaultMediaType, media_base_url = @mediaBaseUrl, - guid = @guid, + podcast_guid = @podcastGuid, funding_url = @fundingUrl, funding_text = @fundingText, medium = @medium WHERE feed_id = @feedId""" cmd.Parameters.Clear () - addPodcastParameters cmd it.id podcast + addPodcastParameters cmd it.Id podcast do! write cmd else - do! addPodcast it.id podcast + do! addPodcast it.Id podcast | None -> if hadPodcast then cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id" cmd.Parameters.Clear () - cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.id) |> ignore + cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore do! write cmd else () @@ -203,10 +203,10 @@ type SQLiteWebLogData (conn : SqliteConnection) = cmd.CommandText <- """ INSERT INTO web_log ( id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, - uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright + uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright ) VALUES ( @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx, - @uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright + @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright )""" addWebLogParameters cmd webLog do! write cmd @@ -286,22 +286,22 @@ type SQLiteWebLogData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- """ UPDATE web_log - SET name = @name, - slug = @slug, - subtitle = @subtitle, - default_page = @defaultPage, - posts_per_page = @postsPerPage, - theme_id = @themeId, - url_base = @urlBase, - time_zone = @timeZone, - auto_htmx = @autoHtmx, - uploads = @uploads, - feed_enabled = @feedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - category_enabled = @categoryEnabled, - tag_enabled = @tagEnabled, - copyright = @copyright + SET name = @name, + slug = @slug, + subtitle = @subtitle, + default_page = @defaultPage, + posts_per_page = @postsPerPage, + theme_id = @themeId, + url_base = @urlBase, + time_zone = @timeZone, + auto_htmx = @autoHtmx, + uploads = @uploads, + is_feed_enabled = @isFeedEnabled, + feed_name = @feedName, + items_in_feed = @itemsInFeed, + is_category_enabled = @isCategoryEnabled, + is_tag_enabled = @isTagEnabled, + copyright = @copyright WHERE id = @id""" addWebLogParameters cmd webLog do! write cmd @@ -312,12 +312,12 @@ type SQLiteWebLogData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- """ UPDATE web_log - SET feed_enabled = @feedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - category_enabled = @categoryEnabled, - tag_enabled = @tagEnabled, - copyright = @copyright + SET is_feed_enabled = @isFeedEnabled, + feed_name = @feedName, + items_in_feed = @itemsInFeed, + is_category_enabled = @isCategoryEnabled, + is_tag_enabled = @isTagEnabled, + copyright = @copyright WHERE id = @id""" addWebLogRssParameters cmd webLog do! write cmd diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index b36032f..b2b7918 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -12,18 +12,18 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Add parameters for web log user INSERT or UPDATE statements let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) = - [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id) - cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId) - cmd.Parameters.AddWithValue ("@userName", user.userName) - cmd.Parameters.AddWithValue ("@firstName", user.firstName) - cmd.Parameters.AddWithValue ("@lastName", user.lastName) - cmd.Parameters.AddWithValue ("@preferredName", user.preferredName) - cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash) - cmd.Parameters.AddWithValue ("@salt", user.salt) - cmd.Parameters.AddWithValue ("@url", maybe user.url) - cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.accessLevel) - cmd.Parameters.AddWithValue ("@createdOn", user.createdOn) - cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.lastSeenOn) + [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId) + cmd.Parameters.AddWithValue ("@email", user.Email) + cmd.Parameters.AddWithValue ("@firstName", user.FirstName) + cmd.Parameters.AddWithValue ("@lastName", user.LastName) + cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) + cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) + cmd.Parameters.AddWithValue ("@salt", user.Salt) + cmd.Parameters.AddWithValue ("@url", maybe user.Url) + cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel) + cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn) + cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn) ] |> ignore // IMPLEMENTATION FUNCTIONS @@ -33,11 +33,11 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- """ INSERT INTO web_log_user ( - id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url, - access_level, created_on, last_seen_on + id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level, + created_on, last_seen_on ) VALUES ( - @id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, - @accessLevel, @createdOn, @lastSeenOn + @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel, + @createdOn, @lastSeenOn )""" addWebLogUserParameters cmd user do! write cmd @@ -46,9 +46,9 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = /// Find a user by their e-mail address for the given web log let findByEmail (email : string) webLogId = backgroundTask { use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName" + cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@userName", email) |> ignore + cmd.Parameters.AddWithValue ("@email", email) |> ignore use! rdr = cmd.ExecuteReaderAsync () return if rdr.Read () then Some (Map.toWebLogUser rdr) else None } @@ -59,7 +59,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id" cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore use! rdr = cmd.ExecuteReaderAsync () - return Helpers.verifyWebLog webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr + return Helpers.verifyWebLog webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr } /// Get all users for the given web log @@ -85,7 +85,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use! rdr = cmd.ExecuteReaderAsync () return toList Map.toWebLogUser rdr - |> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) + |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) } /// Restore users from a backup @@ -115,7 +115,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- """ UPDATE web_log_user - SET user_name = @userName, + SET email = @email, first_name = @firstName, last_name = @lastName, preferred_name = @preferredName, diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index a30b4e6..3d356f4 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -86,23 +86,23 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = log.LogInformation "Creating web_log table..." cmd.CommandText <- """ CREATE TABLE web_log ( - id TEXT PRIMARY KEY, - name TEXT NOT NULL, - slug TEXT NOT NULL, - subtitle TEXT, - default_page TEXT NOT NULL, - posts_per_page INTEGER NOT NULL, - theme_id TEXT NOT NULL REFERENCES theme (id), - url_base TEXT NOT NULL, - time_zone TEXT NOT NULL, - auto_htmx INTEGER NOT NULL DEFAULT 0, - uploads TEXT NOT NULL, - feed_enabled INTEGER NOT NULL DEFAULT 0, - feed_name TEXT NOT NULL, - items_in_feed INTEGER, - category_enabled INTEGER NOT NULL DEFAULT 0, - tag_enabled INTEGER NOT NULL DEFAULT 0, - copyright TEXT); + id TEXT PRIMARY KEY, + name TEXT NOT NULL, + slug TEXT NOT NULL, + subtitle TEXT, + default_page TEXT NOT NULL, + posts_per_page INTEGER NOT NULL, + theme_id TEXT NOT NULL REFERENCES theme (id), + url_base TEXT NOT NULL, + time_zone TEXT NOT NULL, + auto_htmx INTEGER NOT NULL DEFAULT 0, + uploads TEXT NOT NULL, + is_feed_enabled INTEGER NOT NULL DEFAULT 0, + feed_name TEXT NOT NULL, + items_in_feed INTEGER, + is_category_enabled INTEGER NOT NULL DEFAULT 0, + is_tag_enabled INTEGER NOT NULL DEFAULT 0, + copyright TEXT); CREATE INDEX web_log_theme_idx ON web_log (theme_id)""" do! write cmd match! tableExists "web_log_feed" with @@ -131,12 +131,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = displayed_author TEXT NOT NULL, email TEXT NOT NULL, image_url TEXT NOT NULL, - itunes_category TEXT NOT NULL, - itunes_subcategory TEXT, + apple_category TEXT NOT NULL, + apple_subcategory TEXT, explicit TEXT NOT NULL, default_media_type TEXT, media_base_url TEXT, - guid TEXT, + podcast_guid TEXT, funding_url TEXT, funding_text TEXT, medium TEXT)""" @@ -149,12 +149,12 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = log.LogInformation "Creating category table..." cmd.CommandText <- """ CREATE TABLE category ( - id TEXT PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - name TEXT NOT NULL, - slug TEXT NOT NULL, - description TEXT, - parent_id TEXT); + id TEXT PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + name TEXT NOT NULL, + slug TEXT NOT NULL, + description TEXT, + parent_id TEXT); CREATE INDEX category_web_log_idx ON category (web_log_id)""" do! write cmd @@ -165,20 +165,20 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = log.LogInformation "Creating web_log_user table..." cmd.CommandText <- """ CREATE TABLE web_log_user ( - id TEXT PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - user_name TEXT NOT NULL, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL, - preferred_name TEXT NOT NULL, - password_hash TEXT NOT NULL, - salt TEXT NOT NULL, - url TEXT, - access_level TEXT NOT NULL, - created_on TEXT NOT NULL, - last_seen_on TEXT NOT NULL); - CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); - CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)""" + id TEXT PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + email TEXT NOT NULL, + first_name TEXT NOT NULL, + last_name TEXT NOT NULL, + preferred_name TEXT NOT NULL, + password_hash TEXT NOT NULL, + salt TEXT NOT NULL, + url TEXT, + access_level TEXT NOT NULL, + created_on TEXT NOT NULL, + last_seen_on TEXT); + CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); + CREATE INDEX web_log_user_email_idx ON web_log_user (web_log_id, email)""" do! write cmd // Page tables @@ -188,16 +188,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = log.LogInformation "Creating page table..." cmd.CommandText <- """ CREATE TABLE page ( - id TEXT PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - author_id TEXT NOT NULL REFERENCES web_log_user (id), - title TEXT NOT NULL, - permalink TEXT NOT NULL, - published_on TEXT NOT NULL, - updated_on TEXT NOT NULL, - show_in_page_list INTEGER NOT NULL DEFAULT 0, - template TEXT, - page_text TEXT NOT NULL); + id TEXT PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + author_id TEXT NOT NULL REFERENCES web_log_user (id), + title TEXT NOT NULL, + permalink TEXT NOT NULL, + published_on TEXT NOT NULL, + updated_on TEXT NOT NULL, + is_in_page_list INTEGER NOT NULL DEFAULT 0, + template TEXT, + page_text TEXT NOT NULL); CREATE INDEX page_web_log_idx ON page (web_log_id); CREATE INDEX page_author_idx ON page (author_id); CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)""" diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index 80aebec..f225a49 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -7,16 +7,16 @@ open MyWebLog.ViewModels /// Create a category hierarchy from the given list of categories let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { - for cat in cats |> List.filter (fun c -> c.parentId = parentId) do - let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug - { Id = CategoryId.toString cat.id + for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do + let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug + { Id = CategoryId.toString cat.Id Slug = fullSlug - Name = cat.name - Description = cat.description + Name = cat.Name + Description = cat.Description ParentNames = Array.ofList parentNames // Post counts are filled on a second pass PostCount = 0 } - yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames) + yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames) } diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 28b252b..5427993 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -7,22 +7,22 @@ open MyWebLog [] type Category = { /// The ID of the category - id : CategoryId + Id : CategoryId /// The ID of the web log to which the category belongs - webLogId : WebLogId + WebLogId : WebLogId /// The displayed name - name : string + Name : string /// The slug (used in category URLs) - slug : string + Slug : string /// A longer description of the category - description : string option + Description : string option /// The parent ID of this category (if a subcategory) - parentId : CategoryId option + ParentId : CategoryId option } /// Functions to support categories @@ -30,12 +30,12 @@ module Category = /// An empty category let empty = - { id = CategoryId.empty - webLogId = WebLogId.empty - name = "" - slug = "" - description = None - parentId = None + { Id = CategoryId.empty + WebLogId = WebLogId.empty + Name = "" + Slug = "" + Description = None + ParentId = None } @@ -43,31 +43,31 @@ module Category = [] type Comment = { /// The ID of the comment - id : CommentId + Id : CommentId /// The ID of the post to which this comment applies - postId : PostId + PostId : PostId /// The ID of the comment to which this comment is a reply - inReplyToId : CommentId option + InReplyToId : CommentId option /// The name of the commentor - name : string + Name : string /// The e-mail address of the commentor - email : string + Email : string /// The URL of the commentor's personal website - url : string option + Url : string option /// The status of the comment - status : CommentStatus + Status : CommentStatus /// When the comment was posted - postedOn : DateTime + PostedOn : DateTime /// The text of the comment - text : string + Text : string } /// Functions to support comments @@ -75,15 +75,15 @@ module Comment = /// An empty comment let empty = - { id = CommentId.empty - postId = PostId.empty - inReplyToId = None - name = "" - email = "" - url = None - status = Pending - postedOn = DateTime.UtcNow - text = "" + { Id = CommentId.empty + PostId = PostId.empty + InReplyToId = None + Name = "" + Email = "" + Url = None + Status = Pending + PostedOn = DateTime.UtcNow + Text = "" } @@ -91,43 +91,43 @@ module Comment = [] type Page = { /// The ID of this page - id : PageId + Id : PageId /// The ID of the web log to which this page belongs - webLogId : WebLogId + WebLogId : WebLogId /// The ID of the author of this page - authorId : WebLogUserId + AuthorId : WebLogUserId /// The title of the page - title : string + Title : string /// The link at which this page is displayed - permalink : Permalink + Permalink : Permalink /// When this page was published - publishedOn : DateTime + PublishedOn : DateTime /// When this page was last updated - updatedOn : DateTime + UpdatedOn : DateTime /// Whether this page shows as part of the web log's navigation - showInPageList : bool + IsInPageList : bool /// The template to use when rendering this page - template : string option + Template : string option /// The current text of the page - text : string + Text : string /// Metadata for this page - metadata : MetaItem list + Metadata : MetaItem list /// Permalinks at which this page may have been previously served (useful for migrated content) - priorPermalinks : Permalink list + PriorPermalinks : Permalink list /// Revisions of this page - revisions : Revision list + Revisions : Revision list } /// Functions to support pages @@ -135,19 +135,19 @@ module Page = /// An empty page let empty = - { id = PageId.empty - webLogId = WebLogId.empty - authorId = WebLogUserId.empty - title = "" - permalink = Permalink.empty - publishedOn = DateTime.MinValue - updatedOn = DateTime.MinValue - showInPageList = false - template = None - text = "" - metadata = [] - priorPermalinks = [] - revisions = [] + { Id = PageId.empty + WebLogId = WebLogId.empty + AuthorId = WebLogUserId.empty + Title = "" + Permalink = Permalink.empty + PublishedOn = DateTime.MinValue + UpdatedOn = DateTime.MinValue + IsInPageList = false + Template = None + Text = "" + Metadata = [] + PriorPermalinks = [] + Revisions = [] } @@ -155,52 +155,52 @@ module Page = [] type Post = { /// The ID of this post - id : PostId + Id : PostId /// The ID of the web log to which this post belongs - webLogId : WebLogId + WebLogId : WebLogId /// The ID of the author of this post - authorId : WebLogUserId + AuthorId : WebLogUserId /// The status - status : PostStatus + Status : PostStatus /// The title - title : string + Title : string /// The link at which the post resides - permalink : Permalink + Permalink : Permalink /// The instant on which the post was originally published - publishedOn : DateTime option + PublishedOn : DateTime option /// The instant on which the post was last updated - updatedOn : DateTime + UpdatedOn : DateTime /// The template to use in displaying the post - template : string option + Template : string option /// The text of the post in HTML (ready to display) format - text : string + Text : string /// The Ids of the categories to which this is assigned - categoryIds : CategoryId list + CategoryIds : CategoryId list /// The tags for the post - tags : string list + Tags : string list /// Podcast episode information for this post - episode : Episode option + Episode : Episode option /// Metadata for the post - metadata : MetaItem list + Metadata : MetaItem list /// Permalinks at which this post may have been previously served (useful for migrated content) - priorPermalinks : Permalink list + PriorPermalinks : Permalink list /// The revisions for this post - revisions : Revision list + Revisions : Revision list } /// Functions to support posts @@ -208,38 +208,38 @@ module Post = /// An empty post let empty = - { id = PostId.empty - webLogId = WebLogId.empty - authorId = WebLogUserId.empty - status = Draft - title = "" - permalink = Permalink.empty - publishedOn = None - updatedOn = DateTime.MinValue - text = "" - template = None - categoryIds = [] - tags = [] - episode = None - metadata = [] - priorPermalinks = [] - revisions = [] + { Id = PostId.empty + WebLogId = WebLogId.empty + AuthorId = WebLogUserId.empty + Status = Draft + Title = "" + Permalink = Permalink.empty + PublishedOn = None + UpdatedOn = DateTime.MinValue + Text = "" + Template = None + CategoryIds = [] + Tags = [] + Episode = None + Metadata = [] + PriorPermalinks = [] + Revisions = [] } /// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1") type TagMap = { /// The ID of this tag mapping - id : TagMapId + Id : TagMapId /// The ID of the web log to which this tag mapping belongs - webLogId : WebLogId + WebLogId : WebLogId /// The tag which should be mapped to a different value in links - tag : string + Tag : string /// The value by which the tag should be linked - urlValue : string + UrlValue : string } /// Functions to support tag mappings @@ -247,26 +247,26 @@ module TagMap = /// An empty tag mapping let empty = - { id = TagMapId.empty - webLogId = WebLogId.empty - tag = "" - urlValue = "" + { Id = TagMapId.empty + WebLogId = WebLogId.empty + Tag = "" + UrlValue = "" } /// A theme type Theme = { /// The ID / path of the theme - id : ThemeId + Id : ThemeId /// A long name of the theme - name : string + Name : string /// The version of the theme - version : string + Version : string /// The templates for this theme - templates: ThemeTemplate list + Templates: ThemeTemplate list } /// Functions to support themes @@ -274,10 +274,10 @@ module Theme = /// An empty theme let empty = - { id = ThemeId "" - name = "" - version = "" - templates = [] + { Id = ThemeId "" + Name = "" + Version = "" + Templates = [] } @@ -285,32 +285,42 @@ module Theme = type ThemeAsset = { /// The ID of the asset (consists of theme and path) - id : ThemeAssetId + Id : ThemeAssetId /// The updated date (set from the file date from the ZIP archive) - updatedOn : DateTime + UpdatedOn : DateTime /// The data for the asset - data : byte[] + Data : byte[] } +/// Functions to support theme assets +module ThemeAsset = + + /// An empty theme asset + let empty = + { Id = ThemeAssetId (ThemeId "", "") + UpdatedOn = DateTime.MinValue + Data = [||] + } + /// An uploaded file type Upload = { /// The ID of the upload - id : UploadId + Id : UploadId /// The ID of the web log to which this upload belongs - webLogId : WebLogId + WebLogId : WebLogId /// The link at which this upload is served - path : Permalink + Path : Permalink /// The updated date/time for this upload - updatedOn : DateTime + UpdatedOn : DateTime /// The data for the upload - data : byte[] + Data : byte[] } /// Functions to support uploaded files @@ -318,11 +328,11 @@ module Upload = /// An empty upload let empty = { - id = UploadId.empty - webLogId = WebLogId.empty - path = Permalink.empty - updatedOn = DateTime.MinValue - data = [||] + Id = UploadId.empty + WebLogId = WebLogId.empty + Path = Permalink.empty + UpdatedOn = DateTime.MinValue + Data = [||] } @@ -330,40 +340,40 @@ module Upload = [] type WebLog = { /// The ID of the web log - id : WebLogId + Id : WebLogId /// The name of the web log - name : string + Name : string /// The slug of the web log - slug : string + Slug : string /// A subtitle for the web log - subtitle : string option + Subtitle : string option /// The default page ("posts" or a page Id) - defaultPage : string + DefaultPage : string /// The number of posts to display on pages of posts - postsPerPage : int + PostsPerPage : int - /// The path of the theme (within /themes) - themePath : string + /// The ID of the theme (also the path within /themes) + ThemeId : ThemeId /// The URL base - urlBase : string + UrlBase : string /// The time zone in which dates/times should be displayed - timeZone : string + TimeZone : string /// The RSS options for this web log - rss : RssOptions + Rss : RssOptions /// Whether to automatically load htmx - autoHtmx : bool + AutoHtmx : bool /// Where uploads are placed - uploads : UploadDestination + Uploads : UploadDestination } /// Functions to support web logs @@ -371,29 +381,29 @@ module WebLog = /// An empty web log let empty = - { id = WebLogId.empty - name = "" - slug = "" - subtitle = None - defaultPage = "" - postsPerPage = 10 - themePath = "default" - urlBase = "" - timeZone = "" - rss = RssOptions.empty - autoHtmx = false - uploads = Database + { Id = WebLogId.empty + Name = "" + Slug = "" + Subtitle = None + DefaultPage = "" + PostsPerPage = 10 + ThemeId = ThemeId "default" + UrlBase = "" + TimeZone = "" + Rss = RssOptions.empty + AutoHtmx = false + Uploads = Database } /// Get the host (including scheme) and extra path from the URL base let hostAndPath webLog = - let scheme = webLog.urlBase.Split "://" + let scheme = webLog.UrlBase.Split "://" let host = scheme[1].Split "/" $"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else "" /// Generate an absolute URL for the given link let absoluteUrl webLog permalink = - $"{webLog.urlBase}/{Permalink.toString permalink}" + $"{webLog.UrlBase}/{Permalink.toString permalink}" /// Generate a relative URL for the given link let relativeUrl webLog permalink = @@ -403,47 +413,47 @@ module WebLog = /// Convert a UTC date/time to the web log's local date/time let localTime webLog (date : DateTime) = TimeZoneInfo.ConvertTimeFromUtc - (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.timeZone) + (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone) /// A user of the web log [] type WebLogUser = { /// The ID of the user - id : WebLogUserId + Id : WebLogUserId /// The ID of the web log to which this user belongs - webLogId : WebLogId + WebLogId : WebLogId /// The user name (e-mail address) - userName : string + Email : string /// The user's first name - firstName : string + FirstName : string /// The user's last name - lastName : string + LastName : string /// The user's preferred name - preferredName : string + PreferredName : string /// The hash of the user's password - passwordHash : string + PasswordHash : string /// Salt used to calculate the user's password hash - salt : Guid + Salt : Guid /// The URL of the user's personal site - url : string option + Url : string option /// The user's access level - accessLevel : AccessLevel + AccessLevel : AccessLevel /// When the user was created - createdOn : DateTime + CreatedOn : DateTime /// When the user last logged on - lastSeenOn : DateTime option + LastSeenOn : DateTime option } /// Functions to support web log users @@ -451,27 +461,27 @@ module WebLogUser = /// An empty web log user let empty = - { id = WebLogUserId.empty - webLogId = WebLogId.empty - userName = "" - firstName = "" - lastName = "" - preferredName = "" - passwordHash = "" - salt = Guid.Empty - url = None - accessLevel = Author - createdOn = DateTime.UnixEpoch - lastSeenOn = None + { Id = WebLogUserId.empty + WebLogId = WebLogId.empty + Email = "" + FirstName = "" + LastName = "" + PreferredName = "" + PasswordHash = "" + Salt = Guid.Empty + Url = None + AccessLevel = Author + CreatedOn = DateTime.UnixEpoch + LastSeenOn = None } /// Get the user's displayed name let displayName user = let name = - seq { match user.preferredName with "" -> user.firstName | n -> n; " "; user.lastName } + seq { match user.PreferredName with "" -> user.FirstName | n -> n; " "; user.LastName } |> Seq.reduce (+) name.Trim () /// Does a user have the required access level? let hasAccess level user = - AccessLevel.hasAccess level user.accessLevel + AccessLevel.hasAccess level user.AccessLevel diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 379128b..ef11552 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -8,8 +8,8 @@ module private Helpers = /// Create a new ID (short GUID) // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID - let newId() = - Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-').Substring (0, 22) + let newId () = + Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22) /// A user's access level @@ -140,55 +140,55 @@ module ExplicitRating = /// A podcast episode type Episode = { /// The URL to the media file for the episode (may be permalink) - media : string + Media : string /// The length of the media file, in bytes - length : int64 + Length : int64 /// The duration of the episode - duration : TimeSpan option + Duration : TimeSpan option /// The media type of the file (overrides podcast default if present) - mediaType : string option + MediaType : string option /// The URL to the image file for this episode (overrides podcast image if present, may be permalink) - imageUrl : string option + ImageUrl : string option /// A subtitle for this episode - subtitle : string option + Subtitle : string option /// This episode's explicit rating (overrides podcast rating if present) - explicit : ExplicitRating option + Explicit : ExplicitRating option /// A link to a chapter file - chapterFile : string option + ChapterFile : string option /// The MIME type for the chapter file - chapterType : string option + ChapterType : string option /// The URL for the transcript of the episode (may be permalink) - transcriptUrl : string option + TranscriptUrl : string option /// The MIME type of the transcript - transcriptType : string option + TranscriptType : string option /// The language in which the transcript is written - transcriptLang : string option + TranscriptLang : string option /// If true, the transcript will be declared (in the feed) to be a captions file - transcriptCaptions : bool option + TranscriptCaptions : bool option /// The season number (for serialized podcasts) - seasonNumber : int option + SeasonNumber : int option /// A description of the season - seasonDescription : string option + SeasonDescription : string option /// The episode number - episodeNumber : double option + EpisodeNumber : double option /// A description of the episode - episodeDescription : string option + EpisodeDescription : string option } /// Functions to support episodes @@ -196,23 +196,23 @@ module Episode = /// An empty episode let empty = { - media = "" - length = 0L - duration = None - mediaType = None - imageUrl = None - subtitle = None - explicit = None - chapterFile = None - chapterType = None - transcriptUrl = None - transcriptType = None - transcriptLang = None - transcriptCaptions = None - seasonNumber = None - seasonDescription = None - episodeNumber = None - episodeDescription = None + Media = "" + Length = 0L + Duration = None + MediaType = None + ImageUrl = None + Subtitle = None + Explicit = None + ChapterFile = None + ChapterType = None + TranscriptUrl = None + TranscriptType = None + TranscriptLang = None + TranscriptCaptions = None + SeasonNumber = None + SeasonDescription = None + EpisodeNumber = None + EpisodeDescription = None } @@ -256,10 +256,10 @@ module MarkupText = [] type MetaItem = { /// The name of the metadata value - name : string + Name : string /// The metadata value - value : string + Value : string } /// Functions to support metadata items @@ -267,17 +267,17 @@ module MetaItem = /// An empty metadata item let empty = - { name = ""; value = "" } + { Name = ""; Value = "" } /// A revision of a page or post [] type Revision = { /// When this revision was saved - asOf : DateTime + AsOf : DateTime /// The text of the revision - text : MarkupText + Text : MarkupText } /// Functions to support revisions @@ -285,8 +285,8 @@ module Revision = /// An empty revision let empty = - { asOf = DateTime.UtcNow - text = Html "" + { AsOf = DateTime.UtcNow + Text = Html "" } @@ -436,68 +436,68 @@ module CustomFeedSource = /// Options for a feed that describes a podcast type PodcastOptions = { /// The title of the podcast - title : string + Title : string /// A subtitle for the podcast - subtitle : string option + Subtitle : string option /// The number of items in the podcast feed - itemsInFeed : int + ItemsInFeed : int /// A summary of the podcast (iTunes field) - summary : string + Summary : string /// The display name of the podcast author (iTunes field) - displayedAuthor : string + DisplayedAuthor : string /// The e-mail address of the user who registered the podcast at iTunes - email : string + Email : string /// The link to the image for the podcast - imageUrl : Permalink + ImageUrl : Permalink - /// The category from iTunes under which this podcast is categorized - iTunesCategory : string + /// The category from Apple Podcasts (iTunes) under which this podcast is categorized + AppleCategory : string - /// A further refinement of the categorization of this podcast (iTunes field / values) - iTunesSubcategory : string option + /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values) + AppleSubcategory : string option /// The explictness rating (iTunes field) - explicit : ExplicitRating + Explicit : ExplicitRating /// The default media type for files in this podcast - defaultMediaType : string option + DefaultMediaType : string option /// The base URL for relative URL media files for this podcast (optional; defaults to web log base) - mediaBaseUrl : string option + MediaBaseUrl : string option /// A GUID for this podcast - guid : Guid option + PodcastGuid : Guid option /// A URL at which information on supporting the podcast may be found (supports permalinks) - fundingUrl : string option + FundingUrl : string option /// The text to be displayed in the funding item within the feed - fundingText : string option + FundingText : string option /// The medium (what the podcast IS, not what it is ABOUT) - medium : PodcastMedium option + Medium : PodcastMedium option } /// A custom feed type CustomFeed = { /// The ID of the custom feed - id : CustomFeedId + Id : CustomFeedId /// The source for the custom feed - source : CustomFeedSource + Source : CustomFeedSource /// The path for the custom feed - path : Permalink + Path : Permalink /// Podcast options, if the feed defines a podcast - podcast : PodcastOptions option + Podcast : PodcastOptions option } /// Functions to support custom feeds @@ -505,10 +505,10 @@ module CustomFeed = /// An empty custom feed let empty = - { id = CustomFeedId "" - source = Category (CategoryId "") - path = Permalink "" - podcast = None + { Id = CustomFeedId "" + Source = Category (CategoryId "") + Path = Permalink "" + Podcast = None } @@ -516,25 +516,25 @@ module CustomFeed = [] type RssOptions = { /// Whether the site feed of posts is enabled - feedEnabled : bool + IsFeedEnabled : bool /// The name of the file generated for the site feed - feedName : string + FeedName : string /// Override the "posts per page" setting for the site feed - itemsInFeed : int option + ItemsInFeed : int option /// Whether feeds are enabled for all categories - categoryEnabled : bool + IsCategoryEnabled : bool /// Whether feeds are enabled for all tags - tagEnabled : bool + IsTagEnabled : bool /// A copyright string to be placed in all feeds - copyright : string option + Copyright : string option /// Custom feeds for this web log - customFeeds: CustomFeed list + CustomFeeds: CustomFeed list } /// Functions to support RSS options @@ -542,13 +542,13 @@ module RssOptions = /// An empty set of RSS options let empty = - { feedEnabled = true - feedName = "feed.xml" - itemsInFeed = None - categoryEnabled = true - tagEnabled = true - copyright = None - customFeeds = [] + { IsFeedEnabled = true + FeedName = "feed.xml" + ItemsInFeed = None + IsCategoryEnabled = true + IsTagEnabled = true + Copyright = None + CustomFeeds = [] } @@ -594,10 +594,10 @@ module ThemeAssetId = /// A template for a theme type ThemeTemplate = { /// The name of the template - name : string + Name : string /// The text of the template - text : string + Text : string } @@ -610,13 +610,13 @@ type UploadDestination = module UploadDestination = /// Convert an upload destination to its string representation - let toString = function Database -> "database" | Disk -> "disk" + let toString = function Database -> "Database" | Disk -> "Disk" /// Parse an upload destination from its string representation let parse value = match value with - | "database" -> Database - | "disk" -> Disk + | "Database" -> Database + | "Disk" -> Disk | it -> invalidOp $"{it} is not a valid upload destination" diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index f0b6fc1..fbf2583 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -76,13 +76,13 @@ type DisplayCustomFeed = /// Create a display version from a custom feed static member fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed = let source = - match feed.source with + match feed.Source with | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}" | Tag tag -> $"Tag: {tag}" - { Id = CustomFeedId.toString feed.id + { Id = CustomFeedId.toString feed.Id Source = source - Path = Permalink.toString feed.path - IsPodcast = Option.isSome feed.podcast + Path = Permalink.toString feed.Path + IsPodcast = Option.isSome feed.Podcast } @@ -108,7 +108,7 @@ type DisplayPage = UpdatedOn : DateTime /// Whether this page shows as part of the web log's navigation - ShowInPageList : bool + IsInPageList : bool /// Is this the default page? IsDefault : bool @@ -122,33 +122,33 @@ type DisplayPage = /// Create a minimal display page (no text or metadata) from a database page static member fromPageMinimal webLog (page : Page) = - let pageId = PageId.toString page.id - { Id = pageId - AuthorId = WebLogUserId.toString page.authorId - Title = page.title - Permalink = Permalink.toString page.permalink - PublishedOn = page.publishedOn - UpdatedOn = page.updatedOn - ShowInPageList = page.showInPageList - IsDefault = pageId = webLog.defaultPage - Text = "" - Metadata = [] + let pageId = PageId.toString page.Id + { Id = pageId + AuthorId = WebLogUserId.toString page.AuthorId + Title = page.Title + Permalink = Permalink.toString page.Permalink + PublishedOn = page.PublishedOn + UpdatedOn = page.UpdatedOn + IsInPageList = page.IsInPageList + IsDefault = pageId = webLog.DefaultPage + Text = "" + Metadata = [] } /// Create a display page from a database page static member fromPage webLog (page : Page) = let _, extra = WebLog.hostAndPath webLog - let pageId = PageId.toString page.id - { Id = pageId - AuthorId = WebLogUserId.toString page.authorId - Title = page.title - Permalink = Permalink.toString page.permalink - PublishedOn = page.publishedOn - UpdatedOn = page.updatedOn - ShowInPageList = page.showInPageList - IsDefault = pageId = webLog.defaultPage - Text = if extra = "" then page.text else page.text.Replace ("href=\"/", $"href=\"{extra}/") - Metadata = page.metadata + let pageId = PageId.toString page.Id + { Id = pageId + AuthorId = WebLogUserId.toString page.AuthorId + Title = page.Title + Permalink = Permalink.toString page.Permalink + PublishedOn = page.PublishedOn + UpdatedOn = page.UpdatedOn + IsInPageList = page.IsInPageList + IsDefault = pageId = webLog.DefaultPage + Text = if extra = "" then page.Text else page.Text.Replace ("href=\"/", $"href=\"{extra}/") + Metadata = page.Metadata } @@ -168,9 +168,9 @@ with /// Create a display revision from an actual revision static member fromRevision webLog (rev : Revision) = - { AsOf = rev.asOf - AsOfLocal = WebLog.localTime webLog rev.asOf - Format = MarkupText.sourceType rev.text + { AsOf = rev.AsOf + AsOfLocal = WebLog.localTime webLog rev.AsOf + Format = MarkupText.sourceType rev.Text } @@ -197,12 +197,12 @@ type DisplayUpload = /// Create a display uploaded file static member fromUpload webLog source (upload : Upload) = - let path = Permalink.toString upload.path + let path = Permalink.toString upload.Path let name = Path.GetFileName path - { Id = UploadId.toString upload.id + { Id = UploadId.toString upload.Id Name = name Path = path.Replace (name, "") - UpdatedOn = Some (WebLog.localTime webLog upload.updatedOn) + UpdatedOn = Some (WebLog.localTime webLog upload.UpdatedOn) Source = UploadDestination.toString source } @@ -228,11 +228,11 @@ type EditCategoryModel = /// Create an edit model from an existing category static member fromCategory (cat : Category) = - { CategoryId = CategoryId.toString cat.id - Name = cat.name - Slug = cat.slug - Description = defaultArg cat.description "" - ParentId = cat.parentId |> Option.map CategoryId.toString |> Option.defaultValue "" + { CategoryId = CategoryId.toString cat.Id + Name = cat.Name + Slug = cat.Slug + Description = defaultArg cat.Description "" + ParentId = cat.ParentId |> Option.map CategoryId.toString |> Option.defaultValue "" } @@ -275,11 +275,11 @@ type EditCustomFeedModel = /// The link to the image for the podcast ImageUrl : string - /// The category from iTunes under which this podcast is categorized - iTunesCategory : string + /// The category from Apple Podcasts (iTunes) under which this podcast is categorized + AppleCategory : string - /// A further refinement of the categorization of this podcast (iTunes field / values) - iTunesSubcategory : string + /// A further refinement of the categorization of this podcast (Apple Podcasts/iTunes field / values) + AppleSubcategory : string /// The explictness rating (iTunes field) Explicit : string @@ -305,92 +305,122 @@ type EditCustomFeedModel = /// An empty custom feed model static member empty = - { Id = "" - SourceType = "category" - SourceValue = "" - Path = "" - IsPodcast = false - Title = "" - Subtitle = "" - ItemsInFeed = 25 - Summary = "" - DisplayedAuthor = "" - Email = "" - ImageUrl = "" - iTunesCategory = "" - iTunesSubcategory = "" - Explicit = "no" - DefaultMediaType = "audio/mpeg" - MediaBaseUrl = "" - FundingUrl = "" - FundingText = "" - PodcastGuid = "" - Medium = "" + { Id = "" + SourceType = "category" + SourceValue = "" + Path = "" + IsPodcast = false + Title = "" + Subtitle = "" + ItemsInFeed = 25 + Summary = "" + DisplayedAuthor = "" + Email = "" + ImageUrl = "" + AppleCategory = "" + AppleSubcategory = "" + Explicit = "no" + DefaultMediaType = "audio/mpeg" + MediaBaseUrl = "" + FundingUrl = "" + FundingText = "" + PodcastGuid = "" + Medium = "" } /// Create a model from a custom feed static member fromFeed (feed : CustomFeed) = let rss = { EditCustomFeedModel.empty with - Id = CustomFeedId.toString feed.id - SourceType = match feed.source with Category _ -> "category" | Tag _ -> "tag" - SourceValue = match feed.source with Category (CategoryId catId) -> catId | Tag tag -> tag - Path = Permalink.toString feed.path + Id = CustomFeedId.toString feed.Id + SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag" + SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag + Path = Permalink.toString feed.Path } - match feed.podcast with + match feed.Podcast with | Some p -> { rss with - IsPodcast = true - Title = p.title - Subtitle = defaultArg p.subtitle "" - ItemsInFeed = p.itemsInFeed - Summary = p.summary - DisplayedAuthor = p.displayedAuthor - Email = p.email - ImageUrl = Permalink.toString p.imageUrl - iTunesCategory = p.iTunesCategory - iTunesSubcategory = defaultArg p.iTunesSubcategory "" - Explicit = ExplicitRating.toString p.explicit - DefaultMediaType = defaultArg p.defaultMediaType "" - MediaBaseUrl = defaultArg p.mediaBaseUrl "" - FundingUrl = defaultArg p.fundingUrl "" - FundingText = defaultArg p.fundingText "" - PodcastGuid = p.guid - |> Option.map (fun it -> it.ToString().ToLowerInvariant ()) - |> Option.defaultValue "" - Medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue "" + IsPodcast = true + Title = p.Title + Subtitle = defaultArg p.Subtitle "" + ItemsInFeed = p.ItemsInFeed + Summary = p.Summary + DisplayedAuthor = p.DisplayedAuthor + Email = p.Email + ImageUrl = Permalink.toString p.ImageUrl + AppleCategory = p.AppleCategory + AppleSubcategory = defaultArg p.AppleSubcategory "" + Explicit = ExplicitRating.toString p.Explicit + DefaultMediaType = defaultArg p.DefaultMediaType "" + MediaBaseUrl = defaultArg p.MediaBaseUrl "" + FundingUrl = defaultArg p.FundingUrl "" + FundingText = defaultArg p.FundingText "" + PodcastGuid = p.PodcastGuid + |> Option.map (fun it -> it.ToString().ToLowerInvariant ()) + |> Option.defaultValue "" + Medium = p.Medium |> Option.map PodcastMedium.toString |> Option.defaultValue "" } | None -> rss /// Update a feed with values from this model - member this.updateFeed (feed : CustomFeed) = + member this.UpdateFeed (feed : CustomFeed) = { feed with - source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue) - path = Permalink this.Path - podcast = + Source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue) + Path = Permalink this.Path + Podcast = if this.IsPodcast then Some { - title = this.Title - subtitle = noneIfBlank this.Subtitle - itemsInFeed = this.ItemsInFeed - summary = this.Summary - displayedAuthor = this.DisplayedAuthor - email = this.Email - imageUrl = Permalink this.ImageUrl - iTunesCategory = this.iTunesCategory - iTunesSubcategory = noneIfBlank this.iTunesSubcategory - explicit = ExplicitRating.parse this.Explicit - defaultMediaType = noneIfBlank this.DefaultMediaType - mediaBaseUrl = noneIfBlank this.MediaBaseUrl - guid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse - fundingUrl = noneIfBlank this.FundingUrl - fundingText = noneIfBlank this.FundingText - medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse + Title = this.Title + Subtitle = noneIfBlank this.Subtitle + ItemsInFeed = this.ItemsInFeed + Summary = this.Summary + DisplayedAuthor = this.DisplayedAuthor + Email = this.Email + ImageUrl = Permalink this.ImageUrl + AppleCategory = this.AppleCategory + AppleSubcategory = noneIfBlank this.AppleSubcategory + Explicit = ExplicitRating.parse this.Explicit + DefaultMediaType = noneIfBlank this.DefaultMediaType + MediaBaseUrl = noneIfBlank this.MediaBaseUrl + PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse + FundingUrl = noneIfBlank this.FundingUrl + FundingText = noneIfBlank this.FundingText + Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse } else None } + +/// View model for a user to edit their own information +[] +type EditMyInfoModel = + { /// The user's first name + FirstName : string + + /// The user's last name + LastName : string + + /// The user's preferred name + PreferredName : string + + /// A new password for the user + NewPassword : string + + /// A new password for the user, confirmed + NewPasswordConfirm : string + } + + /// Create an edit model from a user + static member fromUser (user : WebLogUser) = + { FirstName = user.FirstName + LastName = user.LastName + PreferredName = user.PreferredName + NewPassword = "" + NewPasswordConfirm = "" + } + + /// View model to edit a page [] type EditPageModel = @@ -425,19 +455,19 @@ type EditPageModel = /// Create an edit model from an existing page static member fromPage (page : Page) = let latest = - match page.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with + match page.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with | Some rev -> rev | None -> Revision.empty - let page = if page.metadata |> List.isEmpty then { page with metadata = [ MetaItem.empty ] } else page - { PageId = PageId.toString page.id - Title = page.title - Permalink = Permalink.toString page.permalink - Template = defaultArg page.template "" - IsShownInPageList = page.showInPageList - Source = MarkupText.sourceType latest.text - Text = MarkupText.text latest.text - MetaNames = page.metadata |> List.map (fun m -> m.name) |> Array.ofList - MetaValues = page.metadata |> List.map (fun m -> m.value) |> Array.ofList + let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.empty ] } else page + { PageId = PageId.toString page.Id + Title = page.Title + Permalink = Permalink.toString page.Permalink + Template = defaultArg page.Template "" + IsShownInPageList = page.IsInPageList + Source = MarkupText.sourceType latest.Text + Text = MarkupText.text latest.Text + MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList + MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> Array.ofList } @@ -547,94 +577,94 @@ type EditPostModel = /// Create an edit model from an existing past static member fromPost webLog (post : Post) = let latest = - match post.revisions |> List.sortByDescending (fun r -> r.asOf) |> List.tryHead with + match post.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with | Some rev -> rev | None -> Revision.empty - let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post - let episode = defaultArg post.episode Episode.empty - { PostId = PostId.toString post.id - Title = post.title - Permalink = Permalink.toString post.permalink - Source = MarkupText.sourceType latest.text - Text = MarkupText.text latest.text - Tags = String.Join (", ", post.tags) - Template = defaultArg post.template "" - CategoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList - Status = PostStatus.toString post.status + let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post + let episode = defaultArg post.Episode Episode.empty + { PostId = PostId.toString post.Id + Title = post.Title + Permalink = Permalink.toString post.Permalink + Source = MarkupText.sourceType latest.Text + Text = MarkupText.text latest.Text + Tags = String.Join (", ", post.Tags) + Template = defaultArg post.Template "" + CategoryIds = post.CategoryIds |> List.map CategoryId.toString |> Array.ofList + Status = PostStatus.toString post.Status DoPublish = false - MetaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList - MetaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList + MetaNames = post.Metadata |> List.map (fun m -> m.Name) |> Array.ofList + MetaValues = post.Metadata |> List.map (fun m -> m.Value) |> Array.ofList SetPublished = false - PubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable + PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable SetUpdated = false - IsEpisode = Option.isSome post.episode - Media = episode.media - Length = episode.length - Duration = defaultArg (episode.duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) "" - MediaType = defaultArg episode.mediaType "" - ImageUrl = defaultArg episode.imageUrl "" - Subtitle = defaultArg episode.subtitle "" - Explicit = defaultArg (episode.explicit |> Option.map ExplicitRating.toString) "" - ChapterFile = defaultArg episode.chapterFile "" - ChapterType = defaultArg episode.chapterType "" - TranscriptUrl = defaultArg episode.transcriptUrl "" - TranscriptType = defaultArg episode.transcriptType "" - TranscriptLang = defaultArg episode.transcriptLang "" - TranscriptCaptions = defaultArg episode.transcriptCaptions false - SeasonNumber = defaultArg episode.seasonNumber 0 - SeasonDescription = defaultArg episode.seasonDescription "" - EpisodeNumber = defaultArg (episode.episodeNumber |> Option.map string) "" - EpisodeDescription = defaultArg episode.episodeDescription "" + IsEpisode = Option.isSome post.Episode + Media = episode.Media + Length = episode.Length + Duration = defaultArg (episode.Duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) "" + MediaType = defaultArg episode.MediaType "" + ImageUrl = defaultArg episode.ImageUrl "" + Subtitle = defaultArg episode.Subtitle "" + Explicit = defaultArg (episode.Explicit |> Option.map ExplicitRating.toString) "" + ChapterFile = defaultArg episode.ChapterFile "" + ChapterType = defaultArg episode.ChapterType "" + TranscriptUrl = defaultArg episode.TranscriptUrl "" + TranscriptType = defaultArg episode.TranscriptType "" + TranscriptLang = defaultArg episode.TranscriptLang "" + TranscriptCaptions = defaultArg episode.TranscriptCaptions false + SeasonNumber = defaultArg episode.SeasonNumber 0 + SeasonDescription = defaultArg episode.SeasonDescription "" + EpisodeNumber = defaultArg (episode.EpisodeNumber |> Option.map string) "" + EpisodeDescription = defaultArg episode.EpisodeDescription "" } /// Update a post with values from the submitted form - member this.updatePost (post : Post) (revision : Revision) now = + member this.UpdatePost (post : Post) (revision : Revision) now = { post with - title = this.Title - permalink = Permalink this.Permalink - publishedOn = if this.DoPublish then Some now else post.publishedOn - updatedOn = now - text = MarkupText.toHtml revision.text - tags = this.Tags.Split "," + Title = this.Title + Permalink = Permalink this.Permalink + PublishedOn = if this.DoPublish then Some now else post.PublishedOn + UpdatedOn = now + Text = MarkupText.toHtml revision.Text + Tags = this.Tags.Split "," |> Seq.ofArray |> Seq.map (fun it -> it.Trim().ToLower ()) |> Seq.filter (fun it -> it <> "") |> Seq.sort |> List.ofSeq - template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl - categoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray - status = if this.DoPublish then Published else post.status - metadata = Seq.zip this.MetaNames this.MetaValues + Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl + CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray + Status = if this.DoPublish then Published else post.Status + Metadata = Seq.zip this.MetaNames this.MetaValues |> Seq.filter (fun it -> fst it > "") - |> Seq.map (fun it -> { name = fst it; value = snd it }) - |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") + |> Seq.map (fun it -> { Name = fst it; Value = snd it }) + |> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}") |> List.ofSeq - revisions = match post.revisions |> List.tryHead with - | Some r when r.text = revision.text -> post.revisions - | _ -> revision :: post.revisions - episode = + Revisions = match post.Revisions |> List.tryHead with + | Some r when r.Text = revision.Text -> post.Revisions + | _ -> revision :: post.Revisions + Episode = if this.IsEpisode then Some { - media = this.Media - length = this.Length - duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse - mediaType = noneIfBlank this.MediaType - imageUrl = noneIfBlank this.ImageUrl - subtitle = noneIfBlank this.Subtitle - explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse - chapterFile = noneIfBlank this.ChapterFile - chapterType = noneIfBlank this.ChapterType - transcriptUrl = noneIfBlank this.TranscriptUrl - transcriptType = noneIfBlank this.TranscriptType - transcriptLang = noneIfBlank this.TranscriptLang - transcriptCaptions = if this.TranscriptCaptions then Some true else None - seasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber - seasonDescription = noneIfBlank this.SeasonDescription - episodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with + Media = this.Media + Length = this.Length + Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse + MediaType = noneIfBlank this.MediaType + ImageUrl = noneIfBlank this.ImageUrl + Subtitle = noneIfBlank this.Subtitle + Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse + ChapterFile = noneIfBlank this.ChapterFile + ChapterType = noneIfBlank this.ChapterType + TranscriptUrl = noneIfBlank this.TranscriptUrl + TranscriptType = noneIfBlank this.TranscriptType + TranscriptLang = noneIfBlank this.TranscriptLang + TranscriptCaptions = if this.TranscriptCaptions then Some true else None + SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber + SeasonDescription = noneIfBlank this.SeasonDescription + EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with | Some it when it = 0.0 -> None | Some it -> Some (double it) | None -> None - episodeDescription = noneIfBlank this.EpisodeDescription + EpisodeDescription = noneIfBlank this.EpisodeDescription } else None @@ -665,23 +695,23 @@ type EditRssModel = /// Create an edit model from a set of RSS options static member fromRssOptions (rss : RssOptions) = - { IsFeedEnabled = rss.feedEnabled - FeedName = rss.feedName - ItemsInFeed = defaultArg rss.itemsInFeed 0 - IsCategoryEnabled = rss.categoryEnabled - IsTagEnabled = rss.tagEnabled - Copyright = defaultArg rss.copyright "" + { IsFeedEnabled = rss.IsFeedEnabled + FeedName = rss.FeedName + ItemsInFeed = defaultArg rss.ItemsInFeed 0 + IsCategoryEnabled = rss.IsCategoryEnabled + IsTagEnabled = rss.IsTagEnabled + Copyright = defaultArg rss.Copyright "" } /// Update RSS options from values in this mode - member this.updateOptions (rss : RssOptions) = + member this.UpdateOptions (rss : RssOptions) = { rss with - feedEnabled = this.IsFeedEnabled - feedName = this.FeedName - itemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed - categoryEnabled = this.IsCategoryEnabled - tagEnabled = this.IsTagEnabled - copyright = noneIfBlank this.Copyright + IsFeedEnabled = this.IsFeedEnabled + FeedName = this.FeedName + ItemsInFeed = if this.ItemsInFeed = 0 then None else Some this.ItemsInFeed + IsCategoryEnabled = this.IsCategoryEnabled + IsTagEnabled = this.IsTagEnabled + Copyright = noneIfBlank this.Copyright } @@ -703,37 +733,9 @@ type EditTagMapModel = /// Create an edit model from the tag mapping static member fromMapping (tagMap : TagMap) : EditTagMapModel = - { Id = TagMapId.toString tagMap.id - Tag = tagMap.tag - UrlValue = tagMap.urlValue - } - - -/// View model to edit a user -[] -type EditUserModel = - { /// The user's first name - FirstName : string - - /// The user's last name - LastName : string - - /// The user's preferred name - PreferredName : string - - /// A new password for the user - NewPassword : string - - /// A new password for the user, confirmed - NewPasswordConfirm : string - } - /// Create an edit model from a user - static member fromUser (user : WebLogUser) = - { FirstName = user.firstName - LastName = user.lastName - PreferredName = user.preferredName - NewPassword = "" - NewPasswordConfirm = "" + { Id = TagMapId.toString tagMap.Id + Tag = tagMap.Tag + UrlValue = tagMap.UrlValue } @@ -776,20 +778,20 @@ type ManagePermalinksModel = /// Create a permalink model from a page static member fromPage (pg : Page) = - { Id = PageId.toString pg.id + { Id = PageId.toString pg.Id Entity = "page" - CurrentTitle = pg.title - CurrentPermalink = Permalink.toString pg.permalink - Prior = pg.priorPermalinks |> List.map Permalink.toString |> Array.ofList + CurrentTitle = pg.Title + CurrentPermalink = Permalink.toString pg.Permalink + Prior = pg.PriorPermalinks |> List.map Permalink.toString |> Array.ofList } /// Create a permalink model from a post static member fromPost (post : Post) = - { Id = PostId.toString post.id + { Id = PostId.toString post.Id Entity = "post" - CurrentTitle = post.title - CurrentPermalink = Permalink.toString post.permalink - Prior = post.priorPermalinks |> List.map Permalink.toString |> Array.ofList + CurrentTitle = post.Title + CurrentPermalink = Permalink.toString post.Permalink + Prior = post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList } @@ -811,18 +813,18 @@ type ManageRevisionsModel = /// Create a revision model from a page static member fromPage webLog (pg : Page) = - { Id = PageId.toString pg.id + { Id = PageId.toString pg.Id Entity = "page" - CurrentTitle = pg.title - Revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList + CurrentTitle = pg.Title + Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList } /// Create a revision model from a post static member fromPost webLog (post : Post) = - { Id = PostId.toString post.id + { Id = PostId.toString post.Id Entity = "post" - CurrentTitle = post.title - Revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList + CurrentTitle = post.Title + Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList } @@ -870,18 +872,18 @@ type PostListItem = static member fromPost (webLog : WebLog) (post : Post) = let _, extra = WebLog.hostAndPath webLog let inTZ = WebLog.localTime webLog - { Id = PostId.toString post.id - AuthorId = WebLogUserId.toString post.authorId - Status = PostStatus.toString post.status - Title = post.title - Permalink = Permalink.toString post.permalink - PublishedOn = post.publishedOn |> Option.map inTZ |> Option.toNullable - UpdatedOn = inTZ post.updatedOn - Text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/") - CategoryIds = post.categoryIds |> List.map CategoryId.toString - Tags = post.tags - Episode = post.episode - Metadata = post.metadata + { Id = PostId.toString post.Id + AuthorId = WebLogUserId.toString post.AuthorId + Status = PostStatus.toString post.Status + Title = post.Title + Permalink = Permalink.toString post.Permalink + PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable + UpdatedOn = inTZ post.UpdatedOn + Text = if extra = "" then post.Text else post.Text.Replace ("href=\"/", $"href=\"{extra}/") + CategoryIds = post.CategoryIds |> List.map CategoryId.toString + Tags = post.Tags + Episode = post.Episode + Metadata = post.Metadata } @@ -932,7 +934,7 @@ type SettingsModel = TimeZone : string /// The theme to use to display the web log - ThemePath : string + ThemeId : string /// Whether to automatically load htmx AutoHtmx : bool @@ -943,29 +945,29 @@ type SettingsModel = /// Create a settings model from a web log static member fromWebLog (webLog : WebLog) = - { Name = webLog.name - Slug = webLog.slug - Subtitle = defaultArg webLog.subtitle "" - DefaultPage = webLog.defaultPage - PostsPerPage = webLog.postsPerPage - TimeZone = webLog.timeZone - ThemePath = webLog.themePath - AutoHtmx = webLog.autoHtmx - Uploads = UploadDestination.toString webLog.uploads + { Name = webLog.Name + Slug = webLog.Slug + Subtitle = defaultArg webLog.Subtitle "" + DefaultPage = webLog.DefaultPage + PostsPerPage = webLog.PostsPerPage + TimeZone = webLog.TimeZone + ThemeId = ThemeId.toString webLog.ThemeId + AutoHtmx = webLog.AutoHtmx + Uploads = UploadDestination.toString webLog.Uploads } /// Update a web log with settings from the form 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 - themePath = this.ThemePath - 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 } diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 1c3586e..6a39f08 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -67,13 +67,13 @@ module WebLogCache = /// Try to get the web log for the current request (longest matching URL base wins) let tryGet (path : string) = _cache - |> List.filter (fun wl -> path.StartsWith wl.urlBase) - |> List.sortByDescending (fun wl -> wl.urlBase.Length) + |> List.filter (fun wl -> path.StartsWith wl.UrlBase) + |> List.sortByDescending (fun wl -> wl.UrlBase.Length) |> List.tryHead /// Cache the web log for a particular host let set webLog = - _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.id <> webLog.id)) + _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id)) /// Fill the web log cache from the database let fill (data : IData) = backgroundTask { @@ -91,18 +91,18 @@ module PageListCache = let private _cache = ConcurrentDictionary () /// Are there pages cached for this web log? - let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase + let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase /// Get the pages for the web log for this request - let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] + let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase] /// Update the pages for the current web log let update (ctx : HttpContext) = backgroundTask { let webLog = ctx.WebLog - let! pages = ctx.Data.Page.FindListed webLog.id - _cache[webLog.urlBase] <- + let! pages = ctx.Data.Page.FindListed webLog.Id + _cache[webLog.UrlBase] <- pages - |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" }) + |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" }) |> Array.ofList } @@ -116,15 +116,15 @@ module CategoryCache = let private _cache = ConcurrentDictionary () /// Are there categories cached for this web log? - let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.urlBase + let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase /// Get the categories for the web log for this request - let get (ctx : HttpContext) = _cache[ctx.WebLog.urlBase] + let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase] /// Update the cache with fresh data let update (ctx : HttpContext) = backgroundTask { - let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.id - _cache[ctx.WebLog.urlBase] <- cats + let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id + _cache[ctx.WebLog.UrlBase] <- cats } @@ -149,10 +149,10 @@ module TemplateCache = | false -> match! data.Theme.FindById (ThemeId themeId) with | Some theme -> - let mutable text = (theme.templates |> List.find (fun t -> t.name = templateName)).text + let mutable text = (theme.Templates |> List.find (fun t -> t.Name = templateName)).Text while hasInclude.IsMatch text do let child = hasInclude.Match text - let childText = (theme.templates |> List.find (fun t -> t.name = child.Groups[1].Value)).text + let childText = (theme.Templates |> List.find (fun t -> t.Name = child.Groups[1].Value)).Text text <- text.Replace (child.Value, childText) _cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22) | None -> () @@ -179,14 +179,14 @@ module ThemeAssetCache = /// Refresh the list of assets for the given theme let refreshTheme themeId (data : IData) = backgroundTask { let! assets = data.ThemeAsset.FindByTheme themeId - _cache[themeId] <- assets |> List.map (fun a -> match a.id with ThemeAssetId (_, path) -> path) + _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path) } /// Fill the theme asset cache let fill (data : IData) = backgroundTask { let! assets = data.ThemeAsset.All () for asset in assets do - let (ThemeAssetId (themeId, path)) = asset.id + let (ThemeAssetId (themeId, path)) = asset.Id if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] _cache[themeId] <- path :: _cache[themeId] } diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 33640f4..c72d8c5 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -12,11 +12,13 @@ open MyWebLog.ViewModels type Context with /// Get the current web log from the DotLiquid context - member this.WebLog = this.Environments[0].["web_log"] :?> WebLog + member this.WebLog = + this.Environments[0].["web_log"] :?> WebLog + /// Does an asset exist for the current theme? let assetExists fileName (webLog : WebLog) = - ThemeAssetCache.get (ThemeId webLog.themePath) |> List.exists (fun it -> it = fileName) + ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName) /// Obtain the link from known types let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = @@ -24,7 +26,7 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st | :? String as link -> Some link | :? DisplayPage as page -> Some page.Permalink | :? PostListItem as post -> Some post.Permalink - | :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string + | :? DropProxy as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string | _ -> None |> function | Some link -> linkFunc ctx.WebLog (Permalink link) @@ -42,7 +44,7 @@ type CategoryLinkFilter () = static member CategoryLink (ctx : Context, catObj : obj) = match catObj with | :? DisplayCategory as cat -> Some cat.Slug - | :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string + | :? DropProxy as proxy -> Option.ofObj proxy["Slug"] |> Option.map string | _ -> None |> function | Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/") @@ -54,7 +56,7 @@ type EditPageLinkFilter () = static member EditPageLink (ctx : Context, pageObj : obj) = match pageObj with | :? DisplayPage as page -> Some page.Id - | :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string + | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string | :? String as theId -> Some theId | _ -> None |> function @@ -67,7 +69,7 @@ type EditPostLinkFilter () = static member EditPostLink (ctx : Context, postObj : obj) = match postObj with | :? PostListItem as post -> Some post.Id - | :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string + | :? DropProxy as proxy -> Option.ofObj proxy["Id"] |> Option.map string | :? String as theId -> Some theId | _ -> None |> function @@ -89,13 +91,13 @@ type NavLinkFilter () = text "" } - |> Seq.fold (+) "" + |> String.concat "" /// A filter to generate a link for theme asset (image, stylesheet, script, etc.) type ThemeAssetFilter () = static member ThemeAsset (ctx : Context, asset : string) = - WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.themePath}/{asset}") + WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}") /// Create various items in the page header based on the state of the page being generated @@ -107,7 +109,7 @@ type PageHeadTag () = // spacer let s = " " let getBool name = - context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean |> Option.defaultValue false + defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false result.WriteLine $"""""" @@ -123,17 +125,17 @@ type PageHeadTag () = let relUrl = WebLog.relativeUrl webLog (Permalink url) $"""{s}""" - if webLog.rss.feedEnabled && getBool "is_home" then - result.WriteLine (feedLink webLog.name webLog.rss.feedName) + if webLog.Rss.IsFeedEnabled && getBool "is_home" then + result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName) result.WriteLine $"""{s}""" - if webLog.rss.categoryEnabled && getBool "is_category_home" then + if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then let slug = context.Environments[0].["slug"] :?> string - result.WriteLine (feedLink webLog.name $"category/{slug}/{webLog.rss.feedName}") + result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}") - if webLog.rss.tagEnabled && getBool "is_tag_home" then + if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then let slug = context.Environments[0].["slug"] :?> string - result.WriteLine (feedLink webLog.name $"tag/{slug}/{webLog.rss.feedName}") + result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}") if getBool "is_post" then let post = context.Environments[0].["model"] :?> PostDisplay @@ -155,7 +157,7 @@ type PageFootTag () = // spacer let s = " " - if webLog.autoHtmx then + if webLog.AutoHtmx then result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}" if assetExists "script.js" webLog then @@ -172,9 +174,9 @@ type RelativeLinkFilter () = type TagLinkFilter () = static member TagLink (ctx : Context, tag : string) = ctx.Environments[0].["tag_mappings"] :?> TagMap list - |> List.tryFind (fun it -> it.tag = tag) + |> List.tryFind (fun it -> it.Tag = tag) |> function - | Some tagMap -> tagMap.urlValue + | Some tagMap -> tagMap.UrlValue | None -> tag.Replace (" ", "+") |> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/") @@ -201,8 +203,8 @@ type UserLinksTag () = // (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`) type ValueFilter () = static member Value (_ : Context, items : MetaItem list, name : string) = - match items |> List.tryFind (fun it -> it.name = name) with - | Some item -> item.value + match items |> List.tryFind (fun it -> it.Name = name) with + | Some item -> item.Value | None -> $"-- {name} not found --" @@ -225,11 +227,11 @@ let register () = typeof; typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof // View models - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof // Framework types typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 34183dc..bae1c9b 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -9,7 +9,7 @@ open MyWebLog.ViewModels // GET /admin let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let getCount (f : WebLogId -> Task) = f ctx.WebLog.id + let getCount (f : WebLogId -> Task) = f ctx.WebLog.Id let data = ctx.Data let posts = getCount (data.Post.CountByStatus Published) let drafts = getCount (data.Post.CountByStatus Draft) @@ -30,7 +30,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task { TopLevelCategories = topCats.Result } |} - |> viewForTheme "admin" "dashboard" next ctx + |> adminView "dashboard" next ctx } // -- CATEGORIES -- @@ -44,8 +44,9 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> web_log = ctx.WebLog categories = CategoryCache.get ctx |} - hash.Add ("category_list", catListTemplate.Render hash) - return! viewForTheme "admin" "category-list" next ctx hash + return! + addToHash "category_list" (catListTemplate.Render hash) hash + |> adminView "category-list" next ctx } // GET /admin/categories/bare @@ -54,16 +55,16 @@ let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ct categories = CategoryCache.get ctx csrf = ctx.CsrfTokenSet |} - |> bareForTheme "admin" "category-list-body" next ctx + |> adminBareView "category-list-body" next ctx // GET /admin/category/{id}/edit let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let! result = task { match catId with - | "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" }) + | "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" }) | _ -> - match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.id with + match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with | Some cat -> return Some ("Edit Category", cat) | None -> return None } @@ -76,7 +77,7 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct model = EditCategoryModel.fromCategory cat categories = CategoryCache.get ctx |} - |> bareForTheme "admin" "category-edit" next ctx + |> adminBareView "category-edit" next ctx | None -> return! Error.notFound next ctx } @@ -86,16 +87,16 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t let! model = ctx.BindFormAsync () let category = match model.CategoryId with - | "new" -> Task.FromResult (Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id }) - | catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.id + | "new" -> Task.FromResult (Some { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }) + | catId -> data.Category.FindById (CategoryId catId) ctx.WebLog.Id match! category with | Some cat -> let cat = { cat with - name = model.Name - slug = model.Slug - description = if model.Description = "" then None else Some model.Description - parentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId) + Name = model.Name + Slug = model.Slug + Description = if model.Description = "" then None else Some model.Description + ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId) } do! (match model.CategoryId with "new" -> data.Category.Add | _ -> data.Category.Update) cat do! CategoryCache.update ctx @@ -106,7 +107,7 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t // POST /admin/category/{id}/delete let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.id with + match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id with | true -> do! CategoryCache.update ctx do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" } @@ -120,12 +121,12 @@ open Microsoft.AspNetCore.Http /// Get the hash necessary to render the tag mapping list let private tagMappingHash (ctx : HttpContext) = task { - let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.id + let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id return Hash.FromAnonymousObject {| csrf = ctx.CsrfTokenSet web_log = ctx.WebLog mappings = mappings - mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id }) + mapping_ids = mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }) |} } @@ -136,30 +137,30 @@ let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta return! addToHash "tag_mapping_list" (listTemplate.Render hash) hash |> addToHash "page_title" "Tag Mappings" - |> viewForTheme "admin" "tag-mapping-list" next ctx + |> adminView "tag-mapping-list" next ctx } // GET /admin/settings/tag-mappings/bare let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let! hash = tagMappingHash ctx - return! bareForTheme "admin" "tag-mapping-list-body" next ctx hash + return! adminBareView "tag-mapping-list-body" next ctx hash } // GET /admin/settings/tag-mapping/{id}/edit let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let isNew = tagMapId = "new" let tagMap = - if isNew then Task.FromResult (Some { TagMap.empty with id = TagMapId "new" }) - else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.id + if isNew then Task.FromResult (Some { TagMap.empty with Id = TagMapId "new" }) + else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id match! tagMap with | Some tm -> return! Hash.FromAnonymousObject {| - page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag" + page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag" csrf = ctx.CsrfTokenSet model = EditTagMapModel.fromMapping tm |} - |> bareForTheme "admin" "tag-mapping-edit" next ctx + |> adminBareView "tag-mapping-edit" next ctx | None -> return! Error.notFound next ctx } @@ -169,11 +170,11 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta let! model = ctx.BindFormAsync () let tagMap = if model.IsNew then - Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = ctx.WebLog.id }) - else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.id + Task.FromResult (Some { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }) + else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id match! tagMap with | Some tm -> - do! data.TagMap.Save { tm with tag = model.Tag.ToLower (); urlValue = model.UrlValue.ToLower () } + do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () } do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" } return! tagMappingsBare next ctx | None -> return! Error.notFound next ctx @@ -181,7 +182,7 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta // POST /admin/settings/tag-mapping/{id}/delete let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.id with + match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with | true -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" } | false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" } return! tagMappingsBare next ctx @@ -201,7 +202,7 @@ let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx page_title = "Upload Theme" csrf = ctx.CsrfTokenSet |} - |> viewForTheme "admin" "upload-theme" next ctx + |> adminView "upload-theme" next ctx /// Update the name and version for a theme based on the version.txt file, if present let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask { @@ -211,17 +212,17 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background use versionFile = new StreamReader(versionItem.Open ()) let! versionText = versionFile.ReadToEndAsync () let parts = versionText.Trim().Replace("\r", "").Split "\n" - let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.id + let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now () - return { theme with name = displayName; version = version } - | None -> return { theme with name = ThemeId.toString theme.id; version = now () } + return { theme with Name = displayName; Version = version } + | None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () } } /// Delete all theme assets, and remove templates from theme let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask { if cleanLoad then - do! data.ThemeAsset.DeleteByTheme theme.id - return { theme with templates = [] } + do! data.ThemeAsset.DeleteByTheme theme.Id + return { theme with Templates = [] } else return theme } @@ -233,13 +234,13 @@ let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask |> Seq.map (fun templateItem -> backgroundTask { use templateFile = new StreamReader (templateItem.Open ()) let! template = templateFile.ReadToEndAsync () - return { name = templateItem.Name.Replace (".liquid", ""); text = template } + return { Name = templateItem.Name.Replace (".liquid", ""); Text = template } }) let! templates = Task.WhenAll tasks return templates |> Array.fold (fun t template -> - { t with templates = template :: (t.templates |> List.filter (fun it -> it.name <> template.name)) }) + { t with Templates = template :: (t.Templates |> List.filter (fun it -> it.Name <> template.Name)) }) theme } @@ -251,9 +252,9 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT use stream = new MemoryStream () do! asset.Open().CopyToAsync stream do! data.ThemeAsset.Save - { id = ThemeAssetId (themeId, assetName) - updatedOn = asset.LastWriteTime.DateTime - data = stream.ToArray () + { Id = ThemeAssetId (themeId, assetName) + UpdatedOn = asset.LastWriteTime.DateTime + Data = stream.ToArray () } } @@ -269,7 +270,7 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask { let! theme = backgroundTask { match! data.Theme.FindById themeId with | Some t -> return t - | None -> return { Theme.empty with id = themeId } + | None -> return { Theme.empty with Id = themeId } } let! theme = updateNameAndVersion theme zip let! theme = checkForCleanLoad theme clean data @@ -308,7 +309,7 @@ open System.Collections.Generic // GET /admin/settings let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data - let! allPages = data.Page.All ctx.WebLog.id + let! allPages = data.Page.All ctx.WebLog.Id let! themes = data.Theme.All () return! Hash.FromAnonymousObject {| @@ -318,41 +319,41 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task pages = seq { KeyValuePair.Create ("posts", "- First Page of Posts -") yield! allPages - |> List.sortBy (fun p -> p.title.ToLower ()) - |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.id, p.title)) + |> List.sortBy (fun p -> p.Title.ToLower ()) + |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title)) } |> Array.ofSeq themes = themes |> Seq.ofList - |> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})")) + |> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})")) |> Array.ofSeq upload_values = [| KeyValuePair.Create (UploadDestination.toString Database, "Database") KeyValuePair.Create (UploadDestination.toString Disk, "Disk") |] |} - |> viewForTheme "admin" "settings" next ctx + |> adminView "settings" next ctx } // POST /admin/settings let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync () - match! data.WebLog.FindById ctx.WebLog.id with + match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> - let oldSlug = webLog.slug + let oldSlug = webLog.Slug let webLog = model.update webLog do! data.WebLog.UpdateSettings webLog // Update cache WebLogCache.set webLog - if oldSlug <> webLog.slug then + if oldSlug <> webLog.Slug then // Rename disk directory if it exists let uploadRoot = Path.Combine ("wwwroot", "upload") let oldDir = Path.Combine (uploadRoot, oldSlug) - if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.slug)) + if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug)) do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" } return! redirectToGet "admin/settings" next ctx diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 2d63643..ae5f22a 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -26,22 +26,22 @@ type FeedType = let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = let webLog = ctx.WebLog let debug = debug "Feed" ctx - let name = $"/{webLog.rss.feedName}" - let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage + let name = $"/{webLog.Rss.FeedName}" + let postCount = defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})") // Standard feed - match webLog.rss.feedEnabled && feedPath = name with + match webLog.Rss.IsFeedEnabled && feedPath = name with | true -> debug (fun () -> "Found standard feed") Some (StandardFeed feedPath, postCount) | false -> // Category and tag feeds are handled by defined routes; check for custom feed - match webLog.rss.customFeeds - |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with + match webLog.Rss.CustomFeeds + |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with | Some feed -> debug (fun () -> "Found custom feed") Some (Custom (feed, feedPath), - feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount) + feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount) | None -> debug (fun () -> $"No matching feed found") None @@ -53,13 +53,13 @@ let private getFeedPosts ctx feedType = getCategoryIds cat.Slug ctx let data = ctx.Data match feedType with - | StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.id 1 - | CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 - | TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.id tag 1 + | StandardFeed _ -> data.Post.FindPageOfPublishedPosts ctx.WebLog.Id 1 + | CategoryFeed (catId, _) -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1 + | TagFeed (tag, _) -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1 | Custom (feed, _) -> - match feed.source with - | Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1 - | Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.id tag 1 + match feed.Source with + | Category catId -> data.Post.FindPageOfCategorizedPosts ctx.WebLog.Id (childIds catId) 1 + | Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1 /// Strip HTML from a string let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "") @@ -90,13 +90,13 @@ module private Namespace = let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list) (post : Post) = let plainText = - let endingP = post.text.IndexOf "

" - stripHtml <| if endingP >= 0 then post.text[..(endingP - 1)] else post.text + let endingP = post.Text.IndexOf "

" + stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text let item = SyndicationItem ( - Id = WebLog.absoluteUrl webLog post.permalink, - Title = TextSyndicationContent.CreateHtmlContent post.title, - PublishDate = DateTimeOffset post.publishedOn.Value, - LastUpdatedTime = DateTimeOffset post.updatedOn, + Id = WebLog.absoluteUrl webLog post.Permalink, + Title = TextSyndicationContent.CreateHtmlContent post.Title, + PublishDate = DateTimeOffset post.PublishedOn.Value, + LastUpdatedTime = DateTimeOffset post.UpdatedOn, Content = TextSyndicationContent.CreatePlaintextContent plainText) item.AddPermalink (Uri item.Id) @@ -104,25 +104,25 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[ let encoded = let txt = - post.text - .Replace("src=\"/", $"src=\"{webLog.urlBase}/") - .Replace ("href=\"/", $"href=\"{webLog.urlBase}/") + post.Text + .Replace("src=\"/", $"src=\"{webLog.UrlBase}/") + .Replace ("href=\"/", $"href=\"{webLog.UrlBase}/") let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content) let _ = it.AppendChild (xmlDoc.CreateCDataSection txt) it item.ElementExtensions.Add encoded item.Authors.Add (SyndicationPerson ( - Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value)) - [ post.categoryIds + Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value)) + [ post.CategoryIds |> List.map (fun catId -> let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId) SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name)) - post.tags + post.Tags |> List.map (fun tag -> let urlTag = - match tagMaps |> List.tryFind (fun tm -> tm.tag = tag) with - | Some tm -> tm.urlValue + match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with + | Some tm -> tm.UrlValue | None -> tag.Replace (" ", "+") SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)")) ] @@ -137,19 +137,19 @@ let toAbsolute webLog (link : string) = /// Add episode information to a podcast feed item let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) = let epMediaUrl = - match episode.media with + match episode.Media with | link when link.StartsWith "http" -> link - | link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}" + | link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}" | link -> WebLog.absoluteUrl webLog (Permalink link) - let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten - let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute webLog - let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString + let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten + let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog + let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString let xmlDoc = XmlDocument () let enclosure = let it = xmlDoc.CreateElement "enclosure" it.SetAttribute ("url", epMediaUrl) - it.SetAttribute ("length", string episode.length) + it.SetAttribute ("length", string episode.Length) epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ)) it let image = @@ -159,18 +159,18 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po item.ElementExtensions.Add enclosure item.ElementExtensions.Add image - item.ElementExtensions.Add ("creator", Namespace.dc, podcast.displayedAuthor) - item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) + item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor) + item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit) - episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) - episode.duration + episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it)) + episode.Duration |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss""")) - match episode.chapterFile with + match episode.ChapterFile with | Some chapters -> let url = toAbsolute webLog chapters let typ = - match episode.chapterType with + match episode.ChapterType with | Some mime -> Some mime | None when chapters.EndsWith ".json" -> Some "application/json+chapters" | None -> None @@ -180,21 +180,21 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po item.ElementExtensions.Add elt | None -> () - match episode.transcriptUrl with + match episode.TranscriptUrl with | Some transcript -> let url = toAbsolute webLog transcript let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast) elt.SetAttribute ("url", url) - elt.SetAttribute ("type", Option.get episode.transcriptType) - episode.transcriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) - if defaultArg episode.transcriptCaptions false then + elt.SetAttribute ("type", Option.get episode.TranscriptType) + episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it)) + if defaultArg episode.TranscriptCaptions false then elt.SetAttribute ("rel", "captions") item.ElementExtensions.Add elt | None -> () - match episode.seasonNumber with + match episode.SeasonNumber with | Some season -> - match episode.seasonDescription with + match episode.SeasonDescription with | Some desc -> let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast) elt.SetAttribute ("name", desc) @@ -203,9 +203,9 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season) | None -> () - match episode.episodeNumber with + match episode.EpisodeNumber with | Some epNumber -> - match episode.episodeDescription with + match episode.EpisodeDescription with | Some desc -> let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast) elt.SetAttribute ("name", desc) @@ -214,15 +214,15 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber) | None -> () - if post.metadata |> List.exists (fun it -> it.name = "chapter") then + if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then try let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc) chapters.SetAttribute ("version", "1.2") - post.metadata - |> List.filter (fun it -> it.name = "chapter") + post.Metadata + |> List.filter (fun it -> it.Name = "chapter") |> List.map (fun it -> - TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1)) + TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1)) |> List.sortBy fst |> List.iter (fun chap -> let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc) @@ -247,12 +247,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = child.InnerText <- value elt - let podcast = Option.get feed.podcast - let feedUrl = WebLog.absoluteUrl webLog feed.path + let podcast = Option.get feed.Podcast + let feedUrl = WebLog.absoluteUrl webLog feed.Path let imageUrl = - match podcast.imageUrl with + match podcast.ImageUrl with | Permalink link when link.StartsWith "http" -> link - | Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl + | Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl let xmlDoc = XmlDocument () @@ -266,15 +266,15 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = let categorization = let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) - it.SetAttribute ("text", podcast.iTunesCategory) - podcast.iTunesSubcategory + it.SetAttribute ("text", podcast.AppleCategory) + podcast.AppleSubcategory |> Option.iter (fun subCat -> let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes) subCatElt.SetAttribute ("text", subCat) it.AppendChild subCatElt |> ignore) it let image = - [ "title", podcast.title + [ "title", podcast.Title "url", imageUrl "link", feedUrl ] @@ -284,8 +284,8 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = it.SetAttribute ("href", imageUrl) it let owner = - [ "name", podcast.displayedAuthor - "email", podcast.email + [ "name", podcast.DisplayedAuthor + "email", podcast.Email ] |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt) (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes)) @@ -300,62 +300,62 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) = rssFeed.ElementExtensions.Add categorization rssFeed.ElementExtensions.Add iTunesImage rssFeed.ElementExtensions.Add rawVoice - rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.summary) - rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor) - rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.explicit) - podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) - podcast.fundingUrl + rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary) + rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor) + rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit) + podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub)) + podcast.FundingUrl |> Option.iter (fun url -> let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast) funding.SetAttribute ("url", toAbsolute webLog url) - funding.InnerText <- defaultArg podcast.fundingText "Support This Podcast" + funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast" rssFeed.ElementExtensions.Add funding) - podcast.guid + podcast.PodcastGuid |> Option.iter (fun guid -> rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ())) - podcast.medium + podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med)) /// Get the feed's self reference and non-feed link let private selfAndLink webLog feedType ctx = - let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.rss.feedName}", "")) + let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", "")) match feedType with | StandardFeed path | CategoryFeed (_, path) | TagFeed (_, path) -> Permalink path[1..], withoutFeed path | Custom (feed, _) -> - match feed.source with + match feed.Source with | Category (CategoryId catId) -> - feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}" - | Tag tag -> feed.path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" + feed.Path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId)).Slug}" + | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" /// Set the title and description of the feed based on its source let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) = let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def)) match feedType with | StandardFeed _ -> - feed.Title <- cleanText None webLog.name - feed.Description <- cleanText webLog.subtitle webLog.name + feed.Title <- cleanText None webLog.Name + feed.Description <- cleanText webLog.Subtitle webLog.Name | CategoryFeed (CategoryId catId, _) -> let cat = cats |> Array.find (fun it -> it.Id = catId) - feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.Name}" Category""" + feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category""" feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """ | TagFeed (tag, _) -> - feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" + feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" | Custom (custom, _) -> - match custom.podcast with + match custom.Podcast with | Some podcast -> - feed.Title <- cleanText None podcast.title - feed.Description <- cleanText podcast.subtitle podcast.title + feed.Title <- cleanText None podcast.Title + feed.Description <- cleanText podcast.Subtitle podcast.Title | None -> - match custom.source with + match custom.Source with | Category (CategoryId catId) -> let cat = cats |> Array.find (fun it -> it.Id = catId) - feed.Title <- cleanText None $"""{webLog.name} - "{stripHtml cat.Name}" Category""" + feed.Title <- cleanText None $"""{webLog.Name} - "{stripHtml cat.Name}" Category""" feed.Description <- cleanText cat.Description $"""Posts categorized under "{cat.Name}" """ | Tag tag -> - feed.Title <- cleanText None $"""{webLog.name} - "{tag}" Tag""" + feed.Title <- cleanText None $"""{webLog.Name} - "{tag}" Tag""" feed.Description <- cleanText None $"""Posts with the "{tag}" tag""" /// Create a feed with a known non-zero-length list of posts @@ -365,15 +365,15 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg let! authors = getAuthors webLog posts data let! tagMaps = getTagMappings webLog posts data let cats = CategoryCache.get ctx - let podcast = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None + let podcast = match feedType with Custom (feed, _) when Option.isSome feed.Podcast -> Some feed | _ -> None let self, link = selfAndLink webLog feedType ctx let toItem post = let item = toFeedItem webLog authors cats tagMaps post - match podcast, post.episode with - | Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item + match podcast, post.Episode with + | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item | Some _, _ -> - warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media" + warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media" item | _ -> item @@ -381,12 +381,12 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg addNamespace feed "content" Namespace.content setTitleAndDescription feedType webLog cats feed - feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset + feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset feed.Generator <- ctx.Generator feed.Items <- posts |> Seq.ofList |> Seq.map toItem feed.Language <- "en" feed.Id <- WebLog.absoluteUrl webLog link - webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) + webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy) feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L)) feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link) @@ -419,24 +419,24 @@ open DotLiquid // GET: /admin/settings/rss let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let feeds = - ctx.WebLog.rss.customFeeds + ctx.WebLog.Rss.CustomFeeds |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx)) |> Array.ofList Hash.FromAnonymousObject {| page_title = "RSS Settings" csrf = ctx.CsrfTokenSet - model = EditRssModel.fromRssOptions ctx.WebLog.rss + model = EditRssModel.fromRssOptions ctx.WebLog.Rss custom_feeds = feeds |} - |> viewForTheme "admin" "rss-settings" next ctx + |> adminView "rss-settings" next ctx // POST: /admin/settings/rss let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync () - match! data.WebLog.FindById ctx.WebLog.id with + match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> - let webLog = { webLog with rss = model.updateOptions webLog.rss } + let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss } do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" } @@ -448,8 +448,8 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let customFeed = match feedId with - | "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" } - | _ -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId) + | "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" } + | _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId) match customFeed with | Some f -> Hash.FromAnonymousObject {| @@ -468,30 +468,30 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") |] |} - |> viewForTheme "admin" "custom-feed-edit" next ctx + |> adminView "custom-feed-edit" next ctx | None -> Error.notFound next ctx // POST: /admin/settings/rss/save let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data - match! data.WebLog.FindById ctx.WebLog.id with + match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> let! model = ctx.BindFormAsync () let theFeed = match model.Id with - | "new" -> Some { CustomFeed.empty with id = CustomFeedId.create () } - | _ -> webLog.rss.customFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.id = model.Id) + | "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () } + | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id) match theFeed with | Some feed -> - let feeds = model.updateFeed feed :: (webLog.rss.customFeeds |> List.filter (fun it -> it.id <> feed.id)) - let webLog = { webLog with rss = { webLog.rss with customFeeds = feeds } } + let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id)) + let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog do! addMessage ctx { UserMessage.success with Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" } - return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" next ctx + return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx | None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx } @@ -499,15 +499,15 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> // POST /admin/settings/rss/{id}/delete let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data - match! data.WebLog.FindById ctx.WebLog.id with + match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> let customId = CustomFeedId feedId - if webLog.rss.customFeeds |> List.exists (fun f -> f.id = customId) then + if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then let webLog = { webLog with - rss = { - webLog.rss with - customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId) + Rss = { + webLog.Rss with + CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } } do! data.WebLog.UpdateRssOptions webLog diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index b77d607..8deb910 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -58,7 +58,7 @@ open DotLiquid /// Add a key to the hash, returning the modified hash // (note that the hash itself is mutated; this is only used to make it pipeable) let addToHash key (value : obj) (hash : Hash) = - hash.Add (key, value) + if hash.ContainsKey key then hash[key] <- value else hash.Add (key, value) hash open System.Security.Claims @@ -101,11 +101,11 @@ let isHtmx (ctx : HttpContext) = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh /// Render a view for the specified theme, using the specified template, layout, and hash -let viewForTheme theme template next ctx (hash : Hash) = task { - if not (hash.ContainsKey "web_log") then +let viewForTheme themeId template next ctx (hash : Hash) = task { + if not (hash.ContainsKey "htmx_script") then let! _ = populateHash hash ctx () - + let (ThemeId theme) = themeId // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render; // the net effect is a "layout" capability similar to Razor or Pug @@ -134,8 +134,9 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler = |> Seq.reduce (>=>) /// Render a bare view for the specified theme, using the specified template and hash -let bareForTheme theme template next ctx (hash : Hash) = task { +let bareForTheme themeId template next ctx (hash : Hash) = task { let! hash = populateHash hash ctx + let (ThemeId theme) = themeId if not (hash.ContainsKey "content") then let! contentTemplate = TemplateCache.get theme template ctx.Data @@ -151,9 +152,16 @@ let bareForTheme theme template next ctx (hash : Hash) = task { /// Return a view for the web log's default theme let themedView template next ctx hash = task { let! hash = populateHash hash ctx - return! viewForTheme (hash["web_log"] :?> WebLog).themePath template next ctx hash + return! viewForTheme (hash["web_log"] :?> WebLog).ThemeId template next ctx hash } +/// Display a view for the admin theme +let adminView template = + viewForTheme (ThemeId "admin") template + +/// Display a bare view for the admin theme +let adminBareView template = + bareForTheme (ThemeId "admin") template /// Redirect after doing some action; commits session and issues a temporary redirect let redirectToGet url : HttpHandler = fun _ ctx -> task { @@ -232,15 +240,15 @@ open MyWebLog.Data /// Get the templates available for the current web log's theme (in a key/value pair list) let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask { - match! ctx.Data.Theme.FindByIdWithoutText (ThemeId ctx.WebLog.themePath) with + match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with | Some theme -> return seq { KeyValuePair.Create ("", $"- Default (single-{typ}) -") yield! - theme.templates + theme.Templates |> Seq.ofList - |> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}") - |> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name)) + |> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}") + |> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name)) } |> Array.ofSeq | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |] @@ -249,17 +257,17 @@ let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask { /// Get all authors for a list of posts as metadata items let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) = posts - |> List.map (fun p -> p.authorId) + |> List.map (fun p -> p.AuthorId) |> List.distinct - |> data.WebLogUser.FindNames webLog.id + |> data.WebLogUser.FindNames webLog.Id /// Get all tag mappings for a list of posts as metadata items let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) = posts - |> List.map (fun p -> p.tags) + |> List.map (fun p -> p.Tags) |> List.concat |> List.distinct - |> fun tags -> data.TagMap.FindMappingForTags tags webLog.id + |> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id /// Get all category IDs for the given slug (includes owned subcategories) let getCategoryIds slug ctx = diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 26fc054..9b4507d 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -9,7 +9,7 @@ open MyWebLog.ViewModels // GET /admin/pages // GET /admin/pages/page/{pageNbr} let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.id pageNbr + let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr return! Hash.FromAnonymousObject {| page_title = "Pages" @@ -19,21 +19,21 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { prev_page = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}" next_page = $"/page/{pageNbr + 1}" |} - |> viewForTheme "admin" "page-list" next ctx + |> adminView "page-list" next ctx } // GET /admin/page/{id}/edit let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! result = task { match pgId with - | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new"; authorId = ctx.UserId }) + | "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId }) | _ -> - match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some page -> return Some ("Edit Page", page) | None -> return None } match result with - | Some (title, page) when canEdit page.authorId ctx -> + | Some (title, page) when canEdit page.AuthorId ctx -> let model = EditPageModel.fromPage page let! templates = templatesForTheme ctx "page" return! @@ -45,14 +45,14 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) templates = templates |} - |> viewForTheme "admin" "page-edit" next ctx + |> adminView "page-edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } // POST /admin/page/{id}/delete let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.id with + match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with | true -> do! PageListCache.update ctx do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" } @@ -62,15 +62,15 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta // GET /admin/page/{id}/permalinks let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with - | Some pg when canEdit pg.authorId ctx -> + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with + | Some pg when canEdit pg.AuthorId ctx -> return! Hash.FromAnonymousObject {| page_title = "Manage Prior Permalinks" csrf = ctx.CsrfTokenSet model = ManagePermalinksModel.fromPage pg |} - |> viewForTheme "admin" "permalinks" next ctx + |> adminView "permalinks" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -79,10 +79,10 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let pageId = PageId model.Id - match! ctx.Data.Page.FindById pageId ctx.WebLog.id with - | Some pg when canEdit pg.authorId ctx -> + match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with + | Some pg when canEdit pg.AuthorId ctx -> let links = model.Prior |> Array.map Permalink |> List.ofArray - match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.id links with + match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with | true -> do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" } return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx @@ -93,15 +93,15 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task // GET /admin/page/{id}/revisions let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with - | Some pg when canEdit pg.authorId ctx -> + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with + | Some pg when canEdit pg.AuthorId ctx -> return! Hash.FromAnonymousObject {| page_title = "Manage Page Revisions" csrf = ctx.CsrfTokenSet model = ManageRevisionsModel.fromPage ctx.WebLog pg |} - |> viewForTheme "admin" "revisions" next ctx + |> adminView "revisions" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -109,9 +109,9 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> // GET /admin/page/{id}/revisions/purge let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data - match! data.Page.FindFullById (PageId pgId) ctx.WebLog.id with + match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some pg -> - do! data.Page.Update { pg with revisions = [ List.head pg.revisions ] } + do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] } do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" } return! redirectToGet $"admin/page/{pgId}/revisions" next ctx | None -> return! Error.notFound next ctx @@ -121,22 +121,22 @@ open Microsoft.AspNetCore.Http /// Find the page and the requested revision let private findPageRevision pgId revDate (ctx : HttpContext) = task { - match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some pg -> let asOf = parseToUtc revDate - return Some pg, pg.revisions |> List.tryFind (fun r -> r.asOf = asOf) + return Some pg, pg.Revisions |> List.tryFind (fun r -> r.AsOf = asOf) | None -> return None, None } // GET /admin/page/{id}/revision/{revision-date}/preview let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with - | Some pg, Some rev when canEdit pg.authorId ctx -> + | Some pg, Some rev when canEdit pg.AuthorId ctx -> return! Hash.FromAnonymousObject {| - content = $"""
{MarkupText.toHtml rev.text}
""" + content = $"""
{MarkupText.toHtml rev.Text}
""" |} - |> bareForTheme "admin" "" next ctx + |> adminBareView "" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx @@ -147,11 +147,11 @@ open System // POST /admin/page/{id}/revision/{revision-date}/restore let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with - | Some pg, Some rev when canEdit pg.authorId ctx -> + | Some pg, Some rev when canEdit pg.AuthorId ctx -> do! ctx.Data.Page.Update { pg with - revisions = { rev with asOf = DateTime.UtcNow } - :: (pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf)) + Revisions = { rev with AsOf = DateTime.UtcNow } + :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } return! redirectToGet $"admin/page/{pgId}/revisions" next ctx @@ -163,10 +163,10 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun // POST /admin/page/{id}/revision/{revision-date}/delete let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPageRevision pgId revDate ctx with - | Some pg, Some rev when canEdit pg.authorId ctx -> - do! ctx.Data.Page.Update { pg with revisions = pg.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) } + | Some pg, Some rev when canEdit pg.AuthorId ctx -> + do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } - return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |}) + return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx @@ -187,43 +187,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { Task.FromResult ( Some { Page.empty with - id = PageId.create () - webLogId = ctx.WebLog.id - authorId = ctx.UserId - publishedOn = now + Id = PageId.create () + WebLogId = ctx.WebLog.Id + AuthorId = ctx.UserId + PublishedOn = now }) - | pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.id + | pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.Id match! pg with - | Some page when canEdit page.authorId ctx -> - let updateList = page.showInPageList <> model.IsShownInPageList - let revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" } + | Some page when canEdit page.AuthorId ctx -> + let updateList = page.IsInPageList <> model.IsShownInPageList + let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" } // Detect a permalink change, and add the prior one to the prior list let page = - match Permalink.toString page.permalink with + match Permalink.toString page.Permalink with | "" -> page | link when link = model.Permalink -> page - | _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks } + | _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks } let page = { page with - title = model.Title - permalink = Permalink model.Permalink - updatedOn = now - showInPageList = model.IsShownInPageList - template = match model.Template with "" -> None | tmpl -> Some tmpl - text = MarkupText.toHtml revision.text - metadata = Seq.zip model.MetaNames model.MetaValues + Title = model.Title + Permalink = Permalink model.Permalink + UpdatedOn = now + IsInPageList = model.IsShownInPageList + Template = match model.Template with "" -> None | tmpl -> Some tmpl + Text = MarkupText.toHtml revision.Text + Metadata = Seq.zip model.MetaNames model.MetaValues |> Seq.filter (fun it -> fst it > "") - |> Seq.map (fun it -> { name = fst it; value = snd it }) - |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") + |> Seq.map (fun it -> { Name = fst it; Value = snd it }) + |> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}") |> List.ofSeq - revisions = match page.revisions |> List.tryHead with - | Some r when r.text = revision.text -> page.revisions - | _ -> revision :: page.revisions + Revisions = match page.Revisions |> List.tryHead with + | Some r when r.Text = revision.Text -> page.Revisions + | _ -> revision :: page.Revisions } do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) page if updateList then do! PageListCache.update ctx do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } - return! redirectToGet $"admin/page/{PageId.toString page.id}/edit" next ctx + return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 68f996d..dbca310 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -10,10 +10,10 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) = let fullPath = slugAndPage |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugs, isFeed = - let feedName = $"/{webLog.rss.feedName}" + let feedName = $"/{webLog.Rss.FeedName}" let notBlank = Array.filter (fun it -> it <> "") - if ( (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/") - || (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" )) + if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/") + || (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" )) && slugPath.EndsWith feedName then notBlank (slugPath.Replace(feedName, "").Split "/"), true else notBlank (slugPath.Split "/"), false @@ -54,14 +54,14 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da match listType with | SinglePost -> let post = List.head posts - let dateTime = defaultArg post.publishedOn post.updatedOn - data.Post.FindSurroundingPosts webLog.id dateTime + let dateTime = defaultArg post.PublishedOn post.UpdatedOn + data.Post.FindSurroundingPosts webLog.Id dateTime | _ -> Task.FromResult (None, None) let newerLink = match listType, pageNbr with - | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink) + | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink) | _, 1 -> None - | PostList, 2 when webLog.defaultPage = "posts" -> Some "" + | PostList, 2 when webLog.DefaultPage = "posts" -> Some "" | PostList, _ -> relUrl $"page/{pageNbr - 1}" | CategoryList, 2 -> relUrl $"category/{url}/" | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" @@ -71,7 +71,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}" let olderLink = match listType, List.length posts > perPage with - | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink) + | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink) | _, false -> None | PostList, true -> relUrl $"page/{pageNbr + 1}" | CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}" @@ -82,9 +82,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da Authors = authors Subtitle = None NewerLink = newerLink - NewerName = newerPost |> Option.map (fun p -> p.title) + NewerName = newerPost |> Option.map (fun p -> p.Title) OlderLink = olderLink - OlderName = olderPost |> Option.map (fun p -> p.title) + OlderName = olderPost |> Option.map (fun p -> p.Title) } return Hash.FromAnonymousObject {| model = model @@ -98,17 +98,17 @@ open Giraffe // GET /page/{pageNbr} let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { - let count = ctx.WebLog.postsPerPage + let count = ctx.WebLog.PostsPerPage let data = ctx.Data - let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.id pageNbr count + let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count ctx data let title = - match pageNbr, ctx.WebLog.defaultPage with + match pageNbr, ctx.WebLog.DefaultPage with | 1, "posts" -> None | _, "posts" -> Some $"Page {pageNbr}" | _, _ -> Some $"Page {pageNbr} « Posts" match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () - if pageNbr = 1 && ctx.WebLog.defaultPage = "posts" then hash.Add ("is_home", true) + if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then hash.Add ("is_home", true) return! themedView "index" next ctx hash } @@ -125,14 +125,14 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task { | Some pageNbr, slug, isFeed -> match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with | Some cat when isFeed -> - return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.rss.feedName}")) - (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx + return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}")) + (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx | Some cat -> // Category pages include posts in subcategories - match! data.Post.FindPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage + match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage with | posts when List.length posts > 0 -> - let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.postsPerPage ctx data + let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash "page_title" $"{cat.Name}: Category Archive{pgTitle}" hash @@ -157,17 +157,17 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { | Some pageNbr, rawTag, isFeed -> let urlTag = HttpUtility.UrlDecode rawTag let! tag = backgroundTask { - match! data.TagMap.FindByUrlValue urlTag webLog.id with - | Some m -> return m.tag + match! data.TagMap.FindByUrlValue urlTag webLog.Id with + | Some m -> return m.Tag | None -> return urlTag } if isFeed then - return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}")) - (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx + return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}")) + (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx else - match! data.Post.FindPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage with + match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with | posts when List.length posts > 0 -> - let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx data + let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash "page_title" $"Posts Tagged “{tag}”{pgTitle}" hash @@ -178,7 +178,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { // Other systems use hyphens for spaces; redirect if this is an old tag link | _ -> let spacedTag = tag.Replace ("-", " ") - match! data.Post.FindPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with + match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with | posts when List.length posts > 0 -> let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" return! @@ -192,19 +192,19 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { // GET / let home : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog - match webLog.defaultPage with + match webLog.DefaultPage with | "posts" -> return! pageOfPosts 1 next ctx | pageId -> - match! ctx.Data.Page.FindById (PageId pageId) webLog.id with + match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with | Some page -> return! Hash.FromAnonymousObject {| - page_title = page.title + page_title = page.Title page = DisplayPage.fromPage webLog page categories = CategoryCache.get ctx is_home = true |} - |> themedView (defaultArg page.template "single-page") next ctx + |> themedView (defaultArg page.Template "single-page") next ctx | None -> return! Error.notFound next ctx } @@ -212,12 +212,12 @@ let home : HttpHandler = fun next ctx -> task { // GET /admin/posts/page/{pageNbr} let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data - let! posts = data.Post.FindPageOfPosts ctx.WebLog.id pageNbr 25 + let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25 let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 ctx data return! addToHash "page_title" "Posts" hash |> addToHash "csrf" ctx.CsrfTokenSet - |> viewForTheme "admin" "post-list" next ctx + |> adminView "post-list" next ctx } // GET /admin/post/{id}/edit @@ -225,15 +225,15 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data let! result = task { match postId with - | "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" }) + | "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" }) | _ -> - match! data.Post.FindFullById (PostId postId) ctx.WebLog.id with + match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post -> return Some ("Edit Post", post) | None -> return None } match result with - | Some (title, post) when canEdit post.authorId ctx -> - let! cats = data.Category.FindAllForView ctx.WebLog.id + | Some (title, post) when canEdit post.AuthorId ctx -> + let! cats = data.Category.FindAllForView ctx.WebLog.Id let! templates = templatesForTheme ctx "post" let model = EditPostModel.fromPost ctx.WebLog post return! @@ -252,14 +252,14 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") |] |} - |> viewForTheme "admin" "post-edit" next ctx + |> adminView "post-edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } // POST /admin/post/{id}/delete let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.id with + match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with | true -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" } | false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" } return! redirectToGet "admin/posts" next ctx @@ -267,15 +267,15 @@ let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> // GET /admin/post/{id}/permalinks let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with - | Some post when canEdit post.authorId ctx -> + match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with + | Some post when canEdit post.AuthorId ctx -> return! Hash.FromAnonymousObject {| page_title = "Manage Prior Permalinks" csrf = ctx.CsrfTokenSet model = ManagePermalinksModel.fromPost post |} - |> viewForTheme "admin" "permalinks" next ctx + |> adminView "permalinks" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -284,10 +284,10 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let postId = PostId model.Id - match! ctx.Data.Post.FindById postId ctx.WebLog.id with - | Some post when canEdit post.authorId ctx -> + match! ctx.Data.Post.FindById postId ctx.WebLog.Id with + | Some post when canEdit post.AuthorId ctx -> let links = model.Prior |> Array.map Permalink |> List.ofArray - match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.id links with + match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with | true -> do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" } return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx @@ -298,15 +298,15 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task // GET /admin/post/{id}/revisions let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with - | Some post when canEdit post.authorId ctx -> + match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with + | Some post when canEdit post.AuthorId ctx -> return! Hash.FromAnonymousObject {| page_title = "Manage Post Revisions" csrf = ctx.CsrfTokenSet model = ManageRevisionsModel.fromPost ctx.WebLog post |} - |> viewForTheme "admin" "revisions" next ctx + |> adminView "revisions" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } @@ -314,9 +314,9 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx - // GET /admin/post/{id}/revisions/purge let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data - match! data.Post.FindFullById (PostId postId) ctx.WebLog.id with - | Some post when canEdit post.authorId ctx -> - do! data.Post.Update { post with revisions = [ List.head post.revisions ] } + match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with + | Some post when canEdit post.AuthorId ctx -> + do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] } do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx | Some _ -> return! Error.notAuthorized next ctx @@ -327,22 +327,22 @@ open Microsoft.AspNetCore.Http /// Find the post and the requested revision let private findPostRevision postId revDate (ctx : HttpContext) = task { - match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with + match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post -> let asOf = parseToUtc revDate - return Some post, post.revisions |> List.tryFind (fun r -> r.asOf = asOf) + return Some post, post.Revisions |> List.tryFind (fun r -> r.AsOf = asOf) | None -> return None, None } // GET /admin/post/{id}/revision/{revision-date}/preview let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with - | Some post, Some rev when canEdit post.authorId ctx -> + | Some post, Some rev when canEdit post.AuthorId ctx -> return! Hash.FromAnonymousObject {| - content = $"""
{MarkupText.toHtml rev.text}
""" + content = $"""
{MarkupText.toHtml rev.Text}
""" |} - |> bareForTheme "admin" "" next ctx + |> adminBareView "" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx @@ -351,11 +351,11 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f // POST /admin/post/{id}/revision/{revision-date}/restore let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with - | Some post, Some rev when canEdit post.authorId ctx -> + | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update { post with - revisions = { rev with asOf = DateTime.UtcNow } - :: (post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf)) + Revisions = { rev with AsOf = DateTime.UtcNow } + :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx @@ -367,10 +367,10 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f // POST /admin/post/{id}/revision/{revision-date}/delete let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with - | Some post, Some rev when canEdit post.authorId ctx -> - do! ctx.Data.Post.Update { post with revisions = post.revisions |> List.filter (fun r -> r.asOf <> rev.asOf) } + | Some post, Some rev when canEdit post.AuthorId ctx -> + do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" } - return! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |}) + return! adminBareView "" next ctx (Hash.FromAnonymousObject {| content = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx @@ -388,43 +388,43 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { Task.FromResult ( Some { Post.empty with - id = PostId.create () - webLogId = ctx.WebLog.id - authorId = ctx.UserId + Id = PostId.create () + WebLogId = ctx.WebLog.Id + AuthorId = ctx.UserId }) - else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.id + else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id match! tryPost with - | Some post when canEdit post.authorId ctx -> - let priorCats = post.categoryIds - let revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" } + | Some post when canEdit post.AuthorId ctx -> + let priorCats = post.CategoryIds + let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" } // Detect a permalink change, and add the prior one to the prior list let post = - match Permalink.toString post.permalink with + match Permalink.toString post.Permalink with | "" -> post | link when link = model.Permalink -> post - | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } - let post = model.updatePost post revision now + | _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks } + let post = model.UpdatePost post revision now let post = if model.SetPublished then let dt = parseToUtc (model.PubOverride.Value.ToString "o") if model.SetUpdated then { post with - publishedOn = Some dt - updatedOn = dt - revisions = [ { (List.head post.revisions) with asOf = dt } ] + PublishedOn = Some dt + UpdatedOn = dt + Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] } - else { post with publishedOn = Some dt } + else { post with PublishedOn = Some dt } else post do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) post // If the post was published or its categories changed, refresh the category cache if model.DoPublish || not (priorCats - |> List.append post.categoryIds + |> List.append post.CategoryIds |> List.distinct |> List.length = List.length priorCats) then do! CategoryCache.update ctx do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" } - return! redirectToGet $"admin/post/{PostId.toString post.id}/edit" next ctx + return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index b11d5ce..78cf085 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -27,25 +27,25 @@ module CatchAll = if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty) let permalink = Permalink (textLink.Substring 1) // Current post - match data.Post.FindByPermalink permalink webLog.id |> await with + match data.Post.FindByPermalink permalink webLog.Id |> await with | Some post -> debug (fun () -> "Found post by permalink") let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await - model.Add ("page_title", post.title) - yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model + model.Add ("page_title", post.Title) + yield fun next ctx -> themedView (defaultArg post.Template "single-post") next ctx model | None -> () // Current page - match data.Page.FindByPermalink permalink webLog.id |> await with + match data.Page.FindByPermalink permalink webLog.Id |> await with | Some page -> debug (fun () -> "Found page by permalink") yield fun next ctx -> Hash.FromAnonymousObject {| - page_title = page.title + page_title = page.Title page = DisplayPage.fromPage webLog page categories = CategoryCache.get ctx is_page = true |} - |> themedView (defaultArg page.template "single-page") next ctx + |> themedView (defaultArg page.Template "single-page") next ctx | None -> () // RSS feed match Feed.deriveFeedType ctx textLink with @@ -56,25 +56,25 @@ module CatchAll = // Post differing only by trailing slash let altLink = Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/") - match data.Post.FindByPermalink altLink webLog.id |> await with + match data.Post.FindByPermalink altLink webLog.Id |> await with | Some post -> debug (fun () -> "Found post by trailing-slash-agnostic permalink") - yield redirectTo true (WebLog.relativeUrl webLog post.permalink) + yield redirectTo true (WebLog.relativeUrl webLog post.Permalink) | None -> () // Page differing only by trailing slash - match data.Page.FindByPermalink altLink webLog.id |> await with + match data.Page.FindByPermalink altLink webLog.Id |> await with | Some page -> debug (fun () -> "Found page by trailing-slash-agnostic permalink") - yield redirectTo true (WebLog.relativeUrl webLog page.permalink) + yield redirectTo true (WebLog.relativeUrl webLog page.Permalink) | None -> () // Prior post - match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.id |> await with + match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with | Some link -> debug (fun () -> "Found post by prior permalink") yield redirectTo true (WebLog.relativeUrl webLog link) | None -> () // Prior page - match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.id |> await with + match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with | Some link -> debug (fun () -> "Found page by prior permalink") yield redirectTo true (WebLog.relativeUrl webLog link) @@ -95,9 +95,9 @@ module Asset = let path = urlParts |> Seq.skip 1 |> Seq.head match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with | Some asset -> - match Upload.checkModified asset.updatedOn ctx with + match Upload.checkModified asset.UpdatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx + | None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx | None -> return! Error.notFound next ctx } @@ -148,7 +148,9 @@ let router : HttpHandler = choose [ route "s" >=> Upload.list route "/new" >=> Upload.showNew ]) - route "/user/edit" >=> User.edit + subRoute "/user" (choose [ + route "/my-info" >=> User.myInfo + ]) ] POST >=> validateCsrf >=> choose [ subRoute "/category" (choose [ @@ -189,7 +191,9 @@ let router : HttpHandler = choose [ routexp "/delete/(.*)" Upload.deleteFromDisk routef "/%s/delete" Upload.deleteFromDb ]) - route "/user/save" >=> User.save + subRoute "/user" (choose [ + route "/my-info" >=> User.saveMyInfo + ]) ] ]) GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 8c733e8..b2b5130 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -58,18 +58,18 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/' let slug = Array.head parts - if slug = webLog.slug then + if slug = webLog.Slug then // Static file middleware will not work in subdirectories; check for an actual file first let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..]) if File.Exists fileName then return! streamFile true fileName None None next ctx else let path = String.Join ('/', Array.skip 1 parts) - match! ctx.Data.Upload.FindByPath path webLog.id with + match! ctx.Data.Upload.FindByPath path webLog.Id with | Some upload -> - match checkModified upload.updatedOn ctx with + match checkModified upload.UpdatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! sendFile upload.updatedOn path upload.data next ctx + | None -> return! sendFile upload.UpdatedOn path upload.Data next ctx | None -> return! Error.notFound next ctx else return! Error.notFound next ctx @@ -87,9 +87,9 @@ let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, // GET /admin/uploads let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { let webLog = ctx.WebLog - let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.id + let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id let diskUploads = - let path = Path.Combine (uploadDir, webLog.slug) + let path = Path.Combine (uploadDir, webLog.Slug) try Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories) |> Seq.map (fun file -> @@ -122,7 +122,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { csrf = ctx.CsrfTokenSet files = allFiles |} - |> viewForTheme "admin" "upload-list" next ctx + |> adminView "upload-list" next ctx } // GET /admin/upload/new @@ -130,9 +130,9 @@ let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> Hash.FromAnonymousObject {| page_title = "Upload a File" csrf = ctx.CsrfTokenSet - destination = UploadDestination.toString ctx.WebLog.uploads + destination = UploadDestination.toString ctx.WebLog.Uploads |} - |> viewForTheme "admin" "upload-new" next ctx + |> adminView "upload-new" next ctx /// Redirect to the upload list @@ -155,15 +155,15 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { use stream = new MemoryStream () do! upload.CopyToAsync stream let file = - { id = UploadId.create () - webLogId = ctx.WebLog.id - path = Permalink $"{year}/{month}/{fileName}" - updatedOn = DateTime.UtcNow - data = stream.ToArray () + { Id = UploadId.create () + WebLogId = ctx.WebLog.Id + Path = Permalink $"{year}/{month}/{fileName}" + UpdatedOn = DateTime.UtcNow + Data = stream.ToArray () } do! ctx.Data.Upload.Add file | Disk -> - let fullPath = Path.Combine (uploadDir, ctx.WebLog.slug, year, month) + let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month) let _ = Directory.CreateDirectory fullPath use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create) do! upload.CopyToAsync stream @@ -176,7 +176,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { // POST /admin/upload/{id}/delete let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.id with + match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with | Ok fileName -> do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" } return! showUploads next ctx @@ -188,7 +188,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) = let mutable path = Path.GetDirectoryName filePath let mutable finished = false while (not finished) && path > "" do - let fullPath = Path.Combine (uploadDir, webLog.slug, path) + let fullPath = Path.Combine (uploadDir, webLog.Slug, path) if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then Directory.Delete fullPath path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) @@ -197,7 +197,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) = // POST /admin/upload/delete/{**path} let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let filePath = urlParts |> Seq.skip 1 |> Seq.head - let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath) + let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath) if File.Exists path then File.Delete path removeEmptyDirectories ctx.WebLog filePath diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 5888e43..90a8b36 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -27,7 +27,7 @@ let logOn returnUrl : HttpHandler = fun next ctx -> csrf = ctx.CsrfTokenSet model = { LogOnModel.empty with ReturnTo = returnTo } |} - |> viewForTheme "admin" "log-on" next ctx + |> adminView "log-on" next ctx open System.Security.Claims @@ -38,21 +38,21 @@ open Microsoft.AspNetCore.Authentication.Cookies let doLogOn : HttpHandler = fun next ctx -> task { let! model = ctx.BindFormAsync () let data = ctx.Data - match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.id with - | Some user when user.passwordHash = hashedPassword model.Password user.userName user.salt -> + match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with + | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt -> let claims = seq { - Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) - Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}") - Claim (ClaimTypes.GivenName, user.preferredName) - Claim (ClaimTypes.Role, AccessLevel.toString user.accessLevel) + Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id) + Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}") + Claim (ClaimTypes.GivenName, user.PreferredName) + Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel) } let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) - do! data.WebLogUser.SetLastSeen user.id user.webLogId + do! data.WebLogUser.SetLastSeen user.Id user.WebLogId do! addMessage ctx - { UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.name}!" } + { UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.Name}!" } return! match model.ReturnTo with | Some url -> redirectTo false url next ctx @@ -69,49 +69,52 @@ let logOff : HttpHandler = fun next ctx -> task { return! redirectToGet "" next ctx } -/// Display the user edit page, with information possibly filled in -let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> - addToHash "page_title" "Edit Your Information" hash - |> addToHash "csrf" ctx.CsrfTokenSet - |> viewForTheme "admin" "user-edit" next ctx +/// Display the user "my info" page, with information possibly filled in +let private showMyInfo (user : WebLogUser) (hash : Hash) : HttpHandler = fun next ctx -> + addToHash "page_title" "Edit Your Information" hash + |> addToHash "csrf" ctx.CsrfTokenSet + |> addToHash "access_level" (AccessLevel.toString user.AccessLevel) + |> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn) + |> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch)) + |> adminView "my-info" next ctx -// GET /admin/user/edit -let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with - | Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx +// GET /admin/user/my-info +let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { + match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with + | Some user -> return! showMyInfo user (Hash.FromAnonymousObject {| model = EditMyInfoModel.fromUser user |}) next ctx | None -> return! Error.notFound next ctx } -// POST /admin/user/save -let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () - if model.NewPassword = model.NewPasswordConfirm then - let data = ctx.Data - match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with - | Some user -> +// POST /admin/user/my-info +let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { + let! model = ctx.BindFormAsync () + let data = ctx.Data + match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with + | Some user -> + if model.NewPassword = model.NewPasswordConfirm then let pw, salt = if model.NewPassword = "" then - user.passwordHash, user.salt + user.PasswordHash, user.Salt else let newSalt = Guid.NewGuid () - hashedPassword model.NewPassword user.userName newSalt, newSalt + hashedPassword model.NewPassword user.Email newSalt, newSalt let user = { user with - firstName = model.FirstName - lastName = model.LastName - preferredName = model.PreferredName - passwordHash = pw - salt = salt + FirstName = model.FirstName + LastName = model.LastName + PreferredName = model.PreferredName + PasswordHash = pw + Salt = salt } do! data.WebLogUser.Update user let pwMsg = if model.NewPassword = "" then "" else " and updated your password" do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" } - return! redirectToGet "admin/user/edit" next ctx - | None -> return! Error.notFound next ctx - else - do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" } - return! showEdit (Hash.FromAnonymousObject {| - model = { model with NewPassword = ""; NewPasswordConfirm = "" } - |}) next ctx + return! redirectToGet "admin/user/my-info" next ctx + else + do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" } + return! showMyInfo user (Hash.FromAnonymousObject {| + model = { model with NewPassword = ""; NewPasswordConfirm = "" } + |}) next ctx + | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 5540bdd..2d04e4c 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -32,12 +32,12 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { do! data.WebLog.Add { WebLog.empty with - id = webLogId - name = args[2] - slug = slug - urlBase = args[1] - defaultPage = PageId.toString homePageId - timeZone = timeZone + Id = webLogId + Name = args[2] + Slug = slug + UrlBase = args[1] + DefaultPage = PageId.toString homePageId + TimeZone = timeZone } // Create the admin user @@ -46,32 +46,32 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { do! data.WebLogUser.Add { WebLogUser.empty with - id = userId - webLogId = webLogId - userName = args[3] - firstName = "Admin" - lastName = "User" - preferredName = "Admin" - passwordHash = Handlers.User.hashedPassword args[4] args[3] salt - salt = salt - accessLevel = accessLevel - createdOn = now + Id = userId + WebLogId = webLogId + Email = args[3] + FirstName = "Admin" + LastName = "User" + PreferredName = "Admin" + PasswordHash = Handlers.User.hashedPassword args[4] args[3] salt + Salt = salt + AccessLevel = accessLevel + CreatedOn = now } // Create the default home page do! data.Page.Add { Page.empty with - id = homePageId - webLogId = webLogId - authorId = userId - title = "Welcome to myWebLog!" - permalink = Permalink "welcome-to-myweblog.html" - publishedOn = now - updatedOn = now - text = "

This is your default home page.

" - revisions = [ - { asOf = now - text = Html "

This is your default home page.

" + Id = homePageId + WebLogId = webLogId + AuthorId = userId + Title = "Welcome to myWebLog!" + Permalink = Permalink "welcome-to-myweblog.html" + PublishedOn = now + UpdatedOn = now + Text = "

This is your default home page.

" + Revisions = [ + { AsOf = now + Text = Html "

This is your default home page.

" } ] } @@ -107,11 +107,11 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task { Permalink parts[0], Permalink parts[1]) for old, current in mapping do - match! data.Post.FindByPermalink current webLog.id with + match! data.Post.FindByPermalink current webLog.Id with | Some post -> - let! withLinks = data.Post.FindFullById post.id post.webLogId - let! _ = data.Post.UpdatePriorPermalinks post.id post.webLogId - (old :: withLinks.Value.priorPermalinks) + let! withLinks = data.Post.FindFullById post.Id post.WebLogId + let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId + (old :: withLinks.Value.PriorPermalinks) printfn $"{Permalink.toString old} -> {Permalink.toString current}" | None -> eprintfn $"Cannot find current post for {Permalink.toString current}" printfn "Done!" @@ -160,93 +160,93 @@ module Backup = /// A theme asset, with the data base-64 encoded type EncodedAsset = { /// The ID of the theme asset - id : ThemeAssetId + Id : ThemeAssetId /// The updated date for this asset - updatedOn : DateTime + UpdatedOn : DateTime /// The data for this asset, base-64 encoded - data : string + Data : string } /// Create an encoded theme asset from the original theme asset static member fromAsset (asset : ThemeAsset) = - { id = asset.id - updatedOn = asset.updatedOn - data = Convert.ToBase64String asset.data + { Id = asset.Id + UpdatedOn = asset.UpdatedOn + Data = Convert.ToBase64String asset.Data } /// Create a theme asset from an encoded theme asset - static member fromEncoded (encoded : EncodedAsset) : ThemeAsset = - { id = encoded.id - updatedOn = encoded.updatedOn - data = Convert.FromBase64String encoded.data + static member toAsset (encoded : EncodedAsset) : ThemeAsset = + { Id = encoded.Id + UpdatedOn = encoded.UpdatedOn + Data = Convert.FromBase64String encoded.Data } /// An uploaded file, with the data base-64 encoded type EncodedUpload = { /// The ID of the upload - id : UploadId + Id : UploadId /// The ID of the web log to which the upload belongs - webLogId : WebLogId + WebLogId : WebLogId /// The path at which this upload is served - path : Permalink + Path : Permalink /// The date/time this upload was last updated (file time) - updatedOn : DateTime + UpdatedOn : DateTime /// The data for the upload, base-64 encoded - data : string + Data : string } /// Create an encoded uploaded file from the original uploaded file static member fromUpload (upload : Upload) : EncodedUpload = - { id = upload.id - webLogId = upload.webLogId - path = upload.path - updatedOn = upload.updatedOn - data = Convert.ToBase64String upload.data + { Id = upload.Id + WebLogId = upload.WebLogId + Path = upload.Path + UpdatedOn = upload.UpdatedOn + Data = Convert.ToBase64String upload.Data } /// Create an uploaded file from an encoded uploaded file - static member fromEncoded (encoded : EncodedUpload) : Upload = - { id = encoded.id - webLogId = encoded.webLogId - path = encoded.path - updatedOn = encoded.updatedOn - data = Convert.FromBase64String encoded.data + static member toUpload (encoded : EncodedUpload) : Upload = + { Id = encoded.Id + WebLogId = encoded.WebLogId + Path = encoded.Path + UpdatedOn = encoded.UpdatedOn + Data = Convert.FromBase64String encoded.Data } /// A unified archive for a web log type Archive = { /// The web log to which this archive belongs - webLog : WebLog + WebLog : WebLog /// The users for this web log - users : WebLogUser list + Users : WebLogUser list /// The theme used by this web log at the time the archive was made - theme : Theme + Theme : Theme /// Assets for the theme used by this web log at the time the archive was made - assets : EncodedAsset list + Assets : EncodedAsset list /// The categories for this web log - categories : Category list + Categories : Category list /// The tag mappings for this web log - tagMappings : TagMap list + TagMappings : TagMap list /// The pages for this web log (containing only the most recent revision) - pages : Page list + Pages : Page list /// The posts for this web log (containing only the most recent revision) - posts : Post list + Posts : Post list /// The uploaded files for this web log - uploads : EncodedUpload list + Uploads : EncodedUpload list } /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters) @@ -259,21 +259,21 @@ module Backup = /// Display statistics for a backup archive let private displayStats (msg : string) (webLog : WebLog) archive = - let userCount = List.length archive.users - let assetCount = List.length archive.assets - let categoryCount = List.length archive.categories - let tagMapCount = List.length archive.tagMappings - let pageCount = List.length archive.pages - let postCount = List.length archive.posts - let uploadCount = List.length archive.uploads + let userCount = List.length archive.Users + let assetCount = List.length archive.Assets + let categoryCount = List.length archive.Categories + let tagMapCount = List.length archive.TagMappings + let pageCount = List.length archive.Pages + let postCount = List.length archive.Posts + let uploadCount = List.length archive.Uploads // Create a pluralized output based on the count let plural count ifOne ifMany = if count = 1 then ifOne else ifMany printfn "" - printfn $"""{msg.Replace ("<>NAME<>", webLog.name)}""" - printfn $""" - The theme "{archive.theme.name}" with {assetCount} asset{plural assetCount "" "s"}""" + printfn $"""{msg.Replace ("<>NAME<>", webLog.Name)}""" + printfn $""" - The theme "{archive.Theme.Name}" with {assetCount} asset{plural assetCount "" "s"}""" printfn $""" - {userCount} user{plural userCount "" "s"}""" printfn $""" - {categoryCount} categor{plural categoryCount "y" "ies"}""" printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}""" @@ -284,39 +284,37 @@ module Backup = /// Create a backup archive let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { // Create the data structure - let themeId = ThemeId webLog.themePath - printfn "- Exporting theme..." - let! theme = data.Theme.FindById themeId - let! assets = data.ThemeAsset.FindByThemeWithData themeId + let! theme = data.Theme.FindById webLog.ThemeId + let! assets = data.ThemeAsset.FindByThemeWithData webLog.ThemeId printfn "- Exporting users..." - let! users = data.WebLogUser.FindByWebLog webLog.id + let! users = data.WebLogUser.FindByWebLog webLog.Id printfn "- Exporting categories and tag mappings..." - let! categories = data.Category.FindByWebLog webLog.id - let! tagMaps = data.TagMap.FindByWebLog webLog.id + let! categories = data.Category.FindByWebLog webLog.Id + let! tagMaps = data.TagMap.FindByWebLog webLog.Id printfn "- Exporting pages..." - let! pages = data.Page.FindFullByWebLog webLog.id + let! pages = data.Page.FindFullByWebLog webLog.Id printfn "- Exporting posts..." - let! posts = data.Post.FindFullByWebLog webLog.id + let! posts = data.Post.FindFullByWebLog webLog.Id printfn "- Exporting uploads..." - let! uploads = data.Upload.FindByWebLogWithData webLog.id + let! uploads = data.Upload.FindByWebLogWithData webLog.Id printfn "- Writing archive..." let archive = { - webLog = webLog - users = users - theme = Option.get theme - assets = assets |> List.map EncodedAsset.fromAsset - categories = categories - tagMappings = tagMaps - pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) - posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions }) - uploads = uploads |> List.map EncodedUpload.fromUpload + WebLog = webLog + Users = users + Theme = Option.get theme + Assets = assets |> List.map EncodedAsset.fromAsset + Categories = categories + TagMappings = tagMaps + Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions }) + Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions }) + Uploads = uploads |> List.map EncodedUpload.fromUpload } // Write the structure to the backup file @@ -331,83 +329,83 @@ module Backup = let private doRestore archive newUrlBase (data : IData) = task { let! restore = task { - match! data.WebLog.FindById archive.webLog.id with - | Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase -> - do! data.WebLog.Delete webLog.id - return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } } + match! data.WebLog.FindById archive.WebLog.Id with + | Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase -> + do! data.WebLog.Delete webLog.Id + return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } } | Some _ -> // Err'body gets new IDs... let newWebLogId = WebLogId.create () - let newCatIds = archive.categories |> List.map (fun cat -> cat.id, CategoryId.create ()) |> dict - let newMapIds = archive.tagMappings |> List.map (fun tm -> tm.id, TagMapId.create ()) |> dict - let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict - let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict - let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict - let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict + let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict + let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict + let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict + let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict + let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict + let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict return { archive with - webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase } - users = archive.users - |> List.map (fun u -> { u with id = newUserIds[u.id]; webLogId = newWebLogId }) - categories = archive.categories - |> List.map (fun c -> { c with id = newCatIds[c.id]; webLogId = newWebLogId }) - tagMappings = archive.tagMappings - |> List.map (fun tm -> { tm with id = newMapIds[tm.id]; webLogId = newWebLogId }) - pages = archive.pages + WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase } + Users = archive.Users + |> List.map (fun u -> { u with Id = newUserIds[u.Id]; WebLogId = newWebLogId }) + Categories = archive.Categories + |> List.map (fun c -> { c with Id = newCatIds[c.Id]; WebLogId = newWebLogId }) + TagMappings = archive.TagMappings + |> List.map (fun tm -> { tm with Id = newMapIds[tm.Id]; WebLogId = newWebLogId }) + Pages = archive.Pages |> List.map (fun page -> { page with - id = newPageIds[page.id] - webLogId = newWebLogId - authorId = newUserIds[page.authorId] + Id = newPageIds[page.Id] + WebLogId = newWebLogId + AuthorId = newUserIds[page.AuthorId] }) - posts = archive.posts + Posts = archive.Posts |> List.map (fun post -> { post with - id = newPostIds[post.id] - webLogId = newWebLogId - authorId = newUserIds[post.authorId] - categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c]) + Id = newPostIds[post.Id] + WebLogId = newWebLogId + AuthorId = newUserIds[post.AuthorId] + CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c]) }) - uploads = archive.uploads - |> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId }) + Uploads = archive.Uploads + |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId }) } | None -> return { archive with - webLog = { archive.webLog with urlBase = defaultArg newUrlBase archive.webLog.urlBase } + WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase } } } // Restore theme and assets (one at a time, as assets can be large) printfn "" printfn "- Importing theme..." - do! data.Theme.Save restore.theme - let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.Save) |> Task.WhenAll + do! data.Theme.Save restore.Theme + let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll // Restore web log data printfn "- Restoring web log..." - do! data.WebLog.Add restore.webLog + do! data.WebLog.Add restore.WebLog printfn "- Restoring users..." - do! data.WebLogUser.Restore restore.users + do! data.WebLogUser.Restore restore.Users printfn "- Restoring categories and tag mappings..." - do! data.TagMap.Restore restore.tagMappings - do! data.Category.Restore restore.categories + do! data.TagMap.Restore restore.TagMappings + do! data.Category.Restore restore.Categories printfn "- Restoring pages..." - do! data.Page.Restore restore.pages + do! data.Page.Restore restore.Pages printfn "- Restoring posts..." - do! data.Post.Restore restore.posts + do! data.Post.Restore restore.Posts // TODO: comments not yet implemented printfn "- Restoring uploads..." - do! data.Upload.Restore (restore.uploads |> List.map EncodedUpload.fromEncoded) + do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload) - displayStats "Restored for <>NAME<>:" restore.webLog restore + displayStats "Restored for <>NAME<>:" restore.WebLog restore } /// Decide whether to restore a backup @@ -431,7 +429,7 @@ module Backup = if doOverwrite then do! doRestore archive newUrlBase data else - printfn $"{archive.webLog.name} backup restoration canceled" + printfn $"{archive.WebLog.Name} backup restoration canceled" } /// Generate a backup archive @@ -442,7 +440,7 @@ module Backup = | Some webLog -> let fileName = if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then - $"{webLog.slug}.json" + $"{webLog.Slug}.json" elif args[2].EndsWith ".json" then args[2] else @@ -473,11 +471,11 @@ module Backup = let private doUserUpgrade urlBase email (data : IData) = task { match! data.WebLog.FindByHost urlBase with | Some webLog -> - match! data.WebLogUser.FindByEmail email webLog.id with + match! data.WebLogUser.FindByEmail email webLog.Id with | Some user -> - match user.accessLevel with + match user.AccessLevel with | WebLogAdmin -> - do! data.WebLogUser.Update { user with accessLevel = Administrator } + do! data.WebLogUser.Update { user with AccessLevel = Administrator } printfn $"{email} is now an Administrator user" | other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin" | None -> eprintfn $"ERROR: no user {email} found at {urlBase}" diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 12d7063..81e88a4 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -15,7 +15,7 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger) let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}" match WebLogCache.tryGet path with | Some webLog -> - if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.id} for {path}" + if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}" ctx.Items["webLog"] <- webLog if PageListCache.exists ctx then () else do! PageListCache.update ctx if CategoryCache.exists ctx then () else do! CategoryCache.update ctx diff --git a/src/admin-theme/_layout.liquid b/src/admin-theme/_layout.liquid index cfa7145..d43ff56 100644 --- a/src/admin-theme/_layout.liquid +++ b/src/admin-theme/_layout.liquid @@ -23,7 +23,7 @@ {%- endif %}