From 5fb3a73dcf63beb3e6f9c5ffb1b896a7187a42a5 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 17 Jul 2022 23:10:30 -0400 Subject: [PATCH] Add user created and last seen on (#19) - Updated view models / interfaces per F# naming guidelines --- src/MyWebLog.Data/Interfaces.fs | 159 ++-- src/MyWebLog.Data/RethinkDbData.fs | 185 ++-- src/MyWebLog.Data/SQLite/Helpers.fs | 2 + .../SQLite/SQLiteCategoryData.fs | 30 +- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 30 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 32 +- src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs | 14 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 20 +- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 12 +- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 14 +- .../SQLite/SQLiteWebLogUserData.fs | 42 +- src/MyWebLog.Data/SQLiteData.fs | 6 +- src/MyWebLog.Data/Utils.fs | 12 +- src/MyWebLog.Domain/DataTypes.fs | 8 + src/MyWebLog.Domain/ViewModels.fs | 808 +++++++++--------- src/MyWebLog/Caches.fs | 12 +- src/MyWebLog/DotLiquidBespoke.fs | 47 +- src/MyWebLog/Handlers/Admin.fs | 154 ++-- src/MyWebLog/Handlers/Feed.fs | 112 ++- src/MyWebLog/Handlers/Helpers.fs | 24 +- src/MyWebLog/Handlers/Page.fs | 92 +- src/MyWebLog/Handlers/Post.fs | 174 ++-- src/MyWebLog/Handlers/Routes.fs | 27 +- src/MyWebLog/Handlers/Upload.fs | 57 +- src/MyWebLog/Handlers/User.fs | 74 +- src/MyWebLog/Maintenance.fs | 70 +- src/MyWebLog/Program.fs | 2 +- src/admin-theme/category-edit.liquid | 10 +- src/admin-theme/custom-feed-edit.liquid | 48 +- src/admin-theme/log-on.liquid | 6 +- src/admin-theme/page-edit.liquid | 20 +- src/admin-theme/permalinks.liquid | 4 +- src/admin-theme/post-edit.liquid | 66 +- src/admin-theme/rss-settings.liquid | 18 +- src/admin-theme/settings.liquid | 18 +- src/admin-theme/tag-mapping-edit.liquid | 6 +- src/admin-theme/upload-new.liquid | 6 +- src/admin-theme/user-edit.liquid | 10 +- src/admin-theme/wwwroot/admin.js | 6 +- 39 files changed, 1234 insertions(+), 1203 deletions(-) diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index d20c41a..9cd8bfa 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -9,269 +9,272 @@ open MyWebLog.ViewModels type ICategoryData = /// Add a category - abstract member add : Category -> Task + abstract member Add : Category -> Task /// Count all categories for the given web log - abstract member countAll : WebLogId -> Task + abstract member CountAll : WebLogId -> Task /// Count all top-level categories for the given web log - abstract member countTopLevel : WebLogId -> Task + abstract member CountTopLevel : WebLogId -> Task /// Delete a category (also removes it from posts) - abstract member delete : CategoryId -> WebLogId -> Task + abstract member Delete : CategoryId -> WebLogId -> Task /// Find all categories for a web log, sorted alphabetically and grouped by hierarchy - abstract member findAllForView : WebLogId -> Task + abstract member FindAllForView : WebLogId -> Task /// Find a category by its ID - abstract member findById : CategoryId -> WebLogId -> Task + abstract member FindById : CategoryId -> WebLogId -> Task /// Find all categories for the given web log - abstract member findByWebLog : WebLogId -> Task + abstract member FindByWebLog : WebLogId -> Task /// Restore categories from a backup - abstract member restore : Category list -> Task + abstract member Restore : Category list -> Task /// Update a category (slug, name, description, and parent ID) - abstract member update : Category -> Task + abstract member Update : Category -> Task /// Data functions to support manipulating pages type IPageData = /// Add a page - abstract member add : Page -> Task + abstract member Add : Page -> Task /// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks) - abstract member all : WebLogId -> Task + abstract member All : WebLogId -> Task /// Count all pages for the given web log - abstract member countAll : WebLogId -> Task + abstract member CountAll : WebLogId -> Task /// Count pages marked as "show in page list" for the given web log - abstract member countListed : WebLogId -> Task + abstract member CountListed : WebLogId -> Task /// Delete a page - abstract member delete : PageId -> WebLogId -> Task + abstract member Delete : PageId -> WebLogId -> Task /// Find a page by its ID (excluding revisions and prior permalinks) - abstract member findById : PageId -> WebLogId -> Task + abstract member FindById : PageId -> WebLogId -> Task /// Find a page by its permalink (excluding revisions and prior permalinks) - abstract member findByPermalink : Permalink -> WebLogId -> Task + abstract member FindByPermalink : Permalink -> WebLogId -> Task /// Find the current permalink for a page from a list of prior permalinks - abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task + abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task /// Find a page by its ID (including revisions and prior permalinks) - abstract member findFullById : PageId -> WebLogId -> Task + abstract member FindFullById : PageId -> WebLogId -> Task /// Find all pages for the given web log (including revisions and prior permalinks) - abstract member findFullByWebLog : WebLogId -> Task + abstract member FindFullByWebLog : WebLogId -> Task /// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks) - abstract member findListed : WebLogId -> Task + abstract member FindListed : WebLogId -> Task /// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks) - abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task + abstract member FindPageOfPages : WebLogId -> pageNbr : int -> Task /// Restore pages from a backup - abstract member restore : Page list -> Task + abstract member Restore : Page list -> Task /// Update a page - abstract member update : Page -> Task + abstract member Update : Page -> Task /// Update the prior permalinks for the given page - abstract member updatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task + abstract member UpdatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task /// Data functions to support manipulating posts type IPostData = /// Add a post - abstract member add : Post -> Task + abstract member Add : Post -> Task /// Count posts by their status - abstract member countByStatus : PostStatus -> WebLogId -> Task + abstract member CountByStatus : PostStatus -> WebLogId -> Task /// Delete a post - abstract member delete : PostId -> WebLogId -> Task + abstract member Delete : PostId -> WebLogId -> Task /// Find a post by its ID (excluding revisions and prior permalinks) - abstract member findById : PostId -> WebLogId -> Task + abstract member FindById : PostId -> WebLogId -> Task /// Find a post by its permalink (excluding revisions and prior permalinks) - abstract member findByPermalink : Permalink -> WebLogId -> Task + abstract member FindByPermalink : Permalink -> WebLogId -> Task /// Find the current permalink for a post from a list of prior permalinks - abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task + abstract member FindCurrentPermalink : Permalink list -> WebLogId -> Task /// Find a post by its ID (including revisions and prior permalinks) - abstract member findFullById : PostId -> WebLogId -> Task + abstract member FindFullById : PostId -> WebLogId -> Task /// Find all posts for the given web log (including revisions and prior permalinks) - abstract member findFullByWebLog : WebLogId -> Task + abstract member FindFullByWebLog : WebLogId -> Task /// Find posts to be displayed on a category list page (excluding revisions and prior permalinks) - abstract member findPageOfCategorizedPosts : + abstract member FindPageOfCategorizedPosts : WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task /// Find posts to be displayed on an admin page (excluding revisions and prior permalinks) - abstract member findPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task + abstract member FindPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task /// Find posts to be displayed on a page (excluding revisions and prior permalinks) - abstract member findPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task + abstract member FindPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task /// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks) - abstract member findPageOfTaggedPosts : + abstract member FindPageOfTaggedPosts : WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks) - abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task + abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task /// Restore posts from a backup - abstract member restore : Post list -> Task + abstract member Restore : Post list -> Task /// Update a post - abstract member update : Post -> Task + abstract member Update : Post -> Task /// Update the prior permalinks for a post - abstract member updatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task + abstract member UpdatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task /// Functions to manipulate tag mappings type ITagMapData = /// Delete a tag mapping - abstract member delete : TagMapId -> WebLogId -> Task + abstract member Delete : TagMapId -> WebLogId -> Task /// Find a tag mapping by its ID - abstract member findById : TagMapId -> WebLogId -> Task + abstract member FindById : TagMapId -> WebLogId -> Task /// Find a tag mapping by its URL value - abstract member findByUrlValue : string -> WebLogId -> Task + abstract member FindByUrlValue : string -> WebLogId -> Task /// Retrieve all tag mappings for the given web log - abstract member findByWebLog : WebLogId -> Task + abstract member FindByWebLog : WebLogId -> Task /// Find tag mappings for the given tags - abstract member findMappingForTags : tags : string list -> WebLogId -> Task + abstract member FindMappingForTags : tags : string list -> WebLogId -> Task /// Restore tag mappings from a backup - abstract member restore : TagMap list -> Task + abstract member Restore : TagMap list -> Task /// Save a tag mapping (insert or update) - abstract member save : TagMap -> Task + abstract member Save : TagMap -> Task /// Functions to manipulate themes type IThemeData = /// Retrieve all themes (except "admin") - abstract member all : unit -> Task + abstract member All : unit -> Task /// Find a theme by its ID - abstract member findById : ThemeId -> Task + abstract member FindById : ThemeId -> Task /// Find a theme by its ID (excluding the text of its templates) - abstract member findByIdWithoutText : ThemeId -> Task + abstract member FindByIdWithoutText : ThemeId -> Task /// Save a theme (insert or update) - abstract member save : Theme -> Task + abstract member Save : Theme -> Task /// Functions to manipulate theme assets type IThemeAssetData = /// Retrieve all theme assets (excluding data) - abstract member all : unit -> Task + abstract member All : unit -> Task /// Delete all theme assets for the given theme - abstract member deleteByTheme : ThemeId -> Task + abstract member DeleteByTheme : ThemeId -> Task /// Find a theme asset by its ID - abstract member findById : ThemeAssetId -> Task + abstract member FindById : ThemeAssetId -> Task /// Find all assets for the given theme (excludes data) - abstract member findByTheme : ThemeId -> Task + abstract member FindByTheme : ThemeId -> Task /// Find all assets for the given theme (includes data) - abstract member findByThemeWithData : ThemeId -> Task + abstract member FindByThemeWithData : ThemeId -> Task /// Save a theme asset (insert or update) - abstract member save : ThemeAsset -> Task + abstract member Save : ThemeAsset -> Task /// Functions to manipulate uploaded files type IUploadData = /// Add an uploaded file - abstract member add : Upload -> Task + abstract member Add : Upload -> Task /// Delete an uploaded file - abstract member delete : UploadId -> WebLogId -> Task> + abstract member Delete : UploadId -> WebLogId -> Task> /// Find an uploaded file by its path for the given web log - abstract member findByPath : string -> WebLogId -> Task + abstract member FindByPath : string -> WebLogId -> Task /// Find all uploaded files for a web log (excludes data) - abstract member findByWebLog : WebLogId -> Task + abstract member FindByWebLog : WebLogId -> Task /// Find all uploaded files for a web log - abstract member findByWebLogWithData : WebLogId -> Task + abstract member FindByWebLogWithData : WebLogId -> Task /// Restore uploaded files from a backup - abstract member restore : Upload list -> Task + abstract member Restore : Upload list -> Task /// Functions to manipulate web logs type IWebLogData = /// Add a web log - abstract member add : WebLog -> Task + abstract member Add : WebLog -> Task /// Retrieve all web logs - abstract member all : unit -> Task + abstract member All : unit -> Task /// Delete a web log, including categories, tag mappings, posts/comments, and pages - abstract member delete : WebLogId -> Task + abstract member Delete : WebLogId -> Task /// Find a web log by its host (URL base) - abstract member findByHost : string -> Task + abstract member FindByHost : string -> Task /// Find a web log by its ID - abstract member findById : WebLogId -> Task + abstract member FindById : WebLogId -> Task /// Update RSS options for a web log - abstract member updateRssOptions : WebLog -> Task + abstract member UpdateRssOptions : WebLog -> Task /// Update web log settings (from the settings page) - abstract member updateSettings : WebLog -> Task + abstract member UpdateSettings : WebLog -> Task /// Functions to manipulate web log users type IWebLogUserData = /// Add a web log user - abstract member add : WebLogUser -> Task + abstract member Add : WebLogUser -> Task /// Find a web log user by their e-mail address - abstract member findByEmail : email : string -> WebLogId -> Task + abstract member FindByEmail : email : string -> WebLogId -> Task /// Find a web log user by their ID - abstract member findById : WebLogUserId -> WebLogId -> Task + abstract member FindById : WebLogUserId -> WebLogId -> Task /// Find all web log users for the given web log - abstract member findByWebLog : WebLogId -> Task + abstract member FindByWebLog : WebLogId -> Task /// Get a user ID -> name dictionary for the given user IDs - abstract member findNames : WebLogId -> WebLogUserId list -> Task + abstract member FindNames : WebLogId -> WebLogUserId list -> Task /// Restore users from a backup - abstract member restore : WebLogUser list -> Task + abstract member Restore : WebLogUser list -> Task + + /// Set a user's last seen date/time to now + abstract member SetLastSeen : WebLogUserId -> WebLogId -> Task /// Update a web log user - abstract member update : WebLogUser -> Task + abstract member Update : WebLogUser -> Task /// Data interface required for a myWebLog data implementation @@ -305,5 +308,5 @@ type IData = abstract member WebLogUser : IWebLogUserData /// Do any required start up data checks - abstract member startUp : unit -> Task + abstract member StartUp : unit -> Task \ No newline at end of file diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 1967407..54541d1 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -66,6 +66,7 @@ module private RethinkHelpers = let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj) +open System open Microsoft.Extensions.Logging open MyWebLog.ViewModels open RethinkDb.Driver.FSharp @@ -158,20 +159,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.CountAll webLogId = rethink { withTable Table.Category getAll [ webLogId ] (nameof webLogId) count result; withRetryDefault conn } - member _.countTopLevel webLogId = rethink { + member _.CountTopLevel webLogId = rethink { withTable Table.Category getAll [ webLogId ] (nameof webLogId) filter "parentId" None @@ -179,7 +180,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Category getAll [ webLogId ] (nameof webLogId) @@ -193,9 +194,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name) - |> Seq.map (fun cat -> cat.id :> obj) - |> Seq.append (Seq.singleton it.id) + |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + |> Seq.map (fun cat -> cat.Id :> obj) + |> Seq.append (Seq.singleton it.Id) |> List.ofSeq let! count = rethink { withTable Table.Post @@ -205,22 +206,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Task.WhenAll return ordered |> Seq.map (fun cat -> { cat with - postCount = counts - |> Array.tryFind (fun c -> fst c = cat.id) + PostCount = counts + |> Array.tryFind (fun c -> fst c = cat.Id) |> Option.map snd |> Option.defaultValue 0 }) |> Array.ofSeq } - member _.findById catId webLogId = + member _.FindById catId webLogId = rethink { withTable Table.Category get catId @@ -228,14 +229,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun c -> c.webLogId) <| conn - member _.findByWebLog webLogId = rethink { + member _.FindByWebLog webLogId = rethink { withTable Table.Category getAll [ webLogId ] (nameof webLogId) result; withRetryDefault conn } - member this.delete catId webLogId = backgroundTask { - match! this.findById catId webLogId with + member this.Delete catId webLogId = backgroundTask { + match! this.FindById catId webLogId with | Some _ -> // Delete the category off all posts where it is assigned do! rethink { @@ -256,7 +257,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger return false } - member _.restore cats = backgroundTask { + member _.Restore cats = backgroundTask { for batch in cats |> List.chunkBySize restoreBatchSize do do! rethink { withTable Table.Category @@ -265,7 +266,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger obj @@ -280,13 +281,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.All webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) without [ "text"; "metadata"; "revisions"; "priorPermalinks" ] @@ -294,14 +295,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.CountAll webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) count result; withRetryDefault conn } - member _.countListed webLogId = rethink { + member _.CountListed webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) filter "showInPageList" true @@ -309,7 +310,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Page getAll [ pageId ] @@ -320,7 +321,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger 0UL } - member _.findById pageId webLogId = + member _.FindById pageId webLogId = rethink { withTable Table.Page get pageId @@ -329,7 +330,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun it -> it.webLogId) <| conn - member _.findByPermalink permalink webLogId = + member _.FindByPermalink permalink webLogId = rethink { withTable Table.Page getAll [ r.Array (webLogId, permalink) ] (nameof permalink) @@ -339,7 +340,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findCurrentPermalink permalinks webLogId = backgroundTask { + member _.FindCurrentPermalink permalinks webLogId = backgroundTask { let! result = (rethink { withTable Table.Page @@ -353,7 +354,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Option.map (fun pg -> pg.permalink) } - member _.findFullById pageId webLogId = + member _.FindFullById pageId webLogId = rethink { withTable Table.Page get pageId @@ -361,13 +362,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun it -> it.webLogId) <| conn - member _.findFullByWebLog webLogId = rethink { + member _.FindFullByWebLog webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) resultCursor; withRetryCursorDefault; toList conn } - member _.findListed webLogId = rethink { + member _.FindListed webLogId = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) filter [ "showInPageList", true :> obj ] @@ -376,7 +377,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindPageOfPages webLogId pageNbr = rethink { withTable Table.Page getAll [ webLogId ] (nameof webLogId) without [ "metadata"; "priorPermalinks"; "revisions" ] @@ -386,7 +387,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.chunkBySize restoreBatchSize do do! rethink { withTable Table.Page @@ -395,7 +396,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger do! rethink { withTable Table.Page @@ -429,13 +430,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.CountByStatus status webLogId = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) filter "status" status @@ -443,7 +444,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post getAll [ postId ] @@ -454,7 +455,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger 0UL } - member _.findById postId webLogId = + member _.FindById postId webLogId = rethink { withTable Table.Post get postId @@ -463,7 +464,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun p -> p.webLogId) <| conn - member _.findByPermalink permalink webLogId = + member _.FindByPermalink permalink webLogId = rethink { withTable Table.Post getAll [ r.Array (webLogId, permalink) ] (nameof permalink) @@ -473,7 +474,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findFullById postId webLogId = + member _.FindFullById postId webLogId = rethink { withTable Table.Post get postId @@ -481,7 +482,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun p -> p.webLogId) <| conn - member _.findCurrentPermalink permalinks webLogId = backgroundTask { + member _.FindCurrentPermalink permalinks webLogId = backgroundTask { let! result = (rethink { withTable Table.Post @@ -495,13 +496,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Option.map (fun post -> post.permalink) } - member _.findFullByWebLog webLogId = rethink { + member _.FindFullByWebLog webLogId = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) resultCursor; withRetryCursorDefault; toList conn } - member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { + member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink { withTable Table.Post getAll (objList categoryIds) "categoryIds" filter "webLogId" webLogId @@ -514,7 +515,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) without [ "priorPermalinks"; "revisions" ] @@ -524,7 +525,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) filter "status" Published @@ -535,7 +536,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink { withTable Table.Post getAll [ tag ] "tags" filter "webLogId" webLogId @@ -547,7 +548,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post @@ -573,7 +574,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.chunkBySize restoreBatchSize do do! rethink { withTable Table.Post @@ -582,14 +583,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Post @@ -613,7 +614,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.TagMap getAll [ tagMapId ] @@ -624,7 +625,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger 0UL } - member _.findById tagMapId webLogId = + member _.FindById tagMapId webLogId = rethink { withTable Table.TagMap get tagMapId @@ -632,7 +633,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn - member _.findByUrlValue urlValue webLogId = + member _.FindByUrlValue urlValue webLogId = rethink { withTable Table.TagMap getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl" @@ -641,20 +642,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findByWebLog webLogId = rethink { + member _.FindByWebLog webLogId = rethink { withTable Table.TagMap between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ] orderBy "tag" result; withRetryDefault conn } - member _.findMappingForTags tags webLogId = rethink { + member _.FindMappingForTags tags webLogId = rethink { withTable Table.TagMap getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag" result; withRetryDefault conn } - member _.restore tagMaps = backgroundTask { + member _.Restore tagMaps = backgroundTask { for batch in tagMaps |> List.chunkBySize restoreBatchSize do do! rethink { withTable Table.TagMap @@ -663,7 +664,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.All () = rethink { withTable Table.Theme filter (fun row -> row["id"].Ne "admin" :> obj) without [ "templates" ] @@ -682,20 +683,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindById themeId = rethink { withTable Table.Theme get themeId resultOption; withRetryOptionDefault conn } - member _.findByIdWithoutText themeId = rethink { + member _.FindByIdWithoutText themeId = rethink { withTable Table.Theme get themeId merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |])) resultOption; withRetryOptionDefault conn } - member _.save theme = rethink { + member _.Save theme = rethink { withTable Table.Theme get theme.id replace theme @@ -706,39 +707,39 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.All () = rethink { withTable Table.ThemeAsset without [ "data" ] result; withRetryDefault conn } - member _.deleteByTheme themeId = rethink { + member _.DeleteByTheme themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) delete write; withRetryDefault; ignoreResult conn } - member _.findById assetId = rethink { + member _.FindById assetId = rethink { withTable Table.ThemeAsset get assetId resultOption; withRetryOptionDefault conn } - member _.findByTheme themeId = rethink { + member _.FindByTheme themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) without [ "data" ] result; withRetryDefault conn } - member _.findByThemeWithData themeId = rethink { + member _.FindByThemeWithData themeId = rethink { withTable Table.ThemeAsset filter (matchAssetByThemeId themeId) resultCursor; withRetryCursorDefault; toList conn } - member _.save asset = rethink { + member _.Save asset = rethink { withTable Table.ThemeAsset get asset.id replace asset @@ -749,13 +750,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Upload @@ -775,7 +776,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger return Result.Error $"Upload ID {UploadId.toString uploadId} not found" } - member _.findByPath path webLogId = + member _.FindByPath path webLogId = rethink { withTable Table.Upload getAll [ r.Array (webLogId, path) ] "webLogAndPath" @@ -783,7 +784,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findByWebLog webLogId = rethink { + member _.FindByWebLog webLogId = rethink { withTable Table.Upload between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndPath" ] @@ -791,14 +792,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.FindByWebLogWithData webLogId = rethink { withTable Table.Upload between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndPath" ] resultCursor; withRetryCursorDefault; toList conn } - member _.restore uploads = backgroundTask { + member _.Restore uploads = backgroundTask { // Files can be large; we'll do 5 at a time for batch in uploads |> List.chunkBySize 5 do do! rethink { @@ -812,18 +813,18 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + member _.All () = rethink { withTable Table.WebLog result; withRetryDefault conn } - member _.delete webLogId = backgroundTask { + member _.Delete webLogId = backgroundTask { // Comments should be deleted by post IDs let! thePostIds = rethink<{| id : string |} list> { withTable Table.Post @@ -870,7 +871,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLog getAll [ url ] "urlBase" @@ -879,20 +880,20 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findById webLogId = rethink { + member _.FindById webLogId = rethink { withTable Table.WebLog get webLogId resultOption; withRetryOptionDefault conn } - member _.updateRssOptions webLog = rethink { + member _.UpdateRssOptions webLog = rethink { withTable Table.WebLog get webLog.id update [ "rss", webLog.rss :> obj ] write; withRetryDefault; ignoreResult conn } - member _.updateSettings webLog = rethink { + member _.UpdateSettings webLog = rethink { withTable Table.WebLog get webLog.id update [ @@ -913,13 +914,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.WebLogUser getAll [ r.Array (webLogId, email) ] "logOn" @@ -928,7 +929,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst <| conn - member _.findById userId webLogId = + member _.FindById userId webLogId = rethink { withTable Table.WebLogUser get userId @@ -936,13 +937,13 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun u -> u.webLogId) <| conn - member _.findByWebLog webLogId = rethink { + member _.FindByWebLog webLogId = rethink { withTable Table.WebLogUser getAll [ webLogId ] (nameof webLogId) result; withRetryDefault conn } - member _.findNames webLogId userIds = backgroundTask { + member _.FindNames webLogId userIds = backgroundTask { let! users = rethink { withTable Table.WebLogUser getAll (objList userIds) @@ -954,7 +955,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) } - member _.restore users = backgroundTask { + member _.Restore users = backgroundTask { for batch in users |> List.chunkBySize restoreBatchSize do do! rethink { withTable Table.WebLogUser @@ -963,7 +964,19 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger + do! rethink { + withTable Table.WebLogUser + get userId + update [ "lastSeenOn", DateTime.UtcNow :> obj ] + write; withRetryOnce; ignoreResult conn + } + | None -> () + } + + member _.Update user = rethink { withTable Table.WebLogUser get user.id update [ @@ -978,7 +991,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { dbList; result; withRetryOnce conn } if not (dbs |> List.contains config.Database) then log.LogInformation $"Creating database {config.Database}..." diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index a7a6fd6..03f0067 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -301,6 +301,8 @@ module Map = 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 } /// 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 afe5361..3418348 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -78,24 +78,24 @@ type SQLiteCategoryData (conn : SqliteConnection) = AND p.status = 'Published' AND pc.category_id IN (""" ordered - |> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name) - |> Seq.map (fun cat -> cat.id) - |> Seq.append (Seq.singleton it.id) + |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) + |> Seq.map (fun cat -> cat.Id) + |> Seq.append (Seq.singleton it.Id) |> Seq.iteri (fun idx item -> if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, " cmd.CommandText <- $"{cmd.CommandText}@catId{idx}" cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore) cmd.CommandText <- $"{cmd.CommandText})" let! postCount = count cmd - return it.id, postCount + return it.Id, postCount }) |> Task.WhenAll return ordered |> Seq.map (fun cat -> { cat with - postCount = counts - |> Array.tryFind (fun c -> fst c = cat.id) + PostCount = counts + |> Array.tryFind (fun c -> fst c = cat.Id) |> Option.map snd |> Option.defaultValue 0 }) @@ -163,12 +163,12 @@ type SQLiteCategoryData (conn : SqliteConnection) = } interface ICategoryData with - member _.add cat = add cat - member _.countAll webLogId = countAll webLogId - member _.countTopLevel webLogId = countTopLevel webLogId - member _.findAllForView webLogId = findAllForView webLogId - member _.findById catId webLogId = findById catId webLogId - member _.findByWebLog webLogId = findByWebLog webLogId - member _.delete catId webLogId = delete catId webLogId - member _.restore cats = restore cats - member _.update cat = update cat + member _.Add cat = add cat + member _.CountAll webLogId = countAll webLogId + member _.CountTopLevel webLogId = countTopLevel webLogId + member _.FindAllForView webLogId = findAllForView webLogId + member _.FindById catId webLogId = findById catId webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.Delete catId webLogId = delete catId webLogId + member _.Restore cats = restore cats + member _.Update cat = update cat diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index a6cd283..98a7324 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -349,18 +349,18 @@ type SQLitePageData (conn : SqliteConnection) = } interface IPageData with - member _.add page = add page - member _.all webLogId = all webLogId - member _.countAll webLogId = countAll webLogId - member _.countListed webLogId = countListed webLogId - member _.delete pageId webLogId = delete pageId webLogId - member _.findById pageId webLogId = findById pageId webLogId - member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId - member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId - member _.findFullById pageId webLogId = findFullById pageId webLogId - member _.findFullByWebLog webLogId = findFullByWebLog webLogId - member _.findListed webLogId = findListed webLogId - member _.findPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr - member _.restore pages = restore pages - member _.update page = update page - member _.updatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks + member _.Add page = add page + member _.All webLogId = all webLogId + member _.CountAll webLogId = countAll webLogId + member _.CountListed webLogId = countListed webLogId + member _.Delete pageId webLogId = delete pageId webLogId + member _.FindById pageId webLogId = findById pageId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById pageId webLogId = findFullById pageId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindListed webLogId = findListed webLogId + member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr + member _.Restore pages = restore pages + member _.Update page = update page + member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index fac16c0..afeae82 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -571,22 +571,22 @@ type SQLitePostData (conn : SqliteConnection) = } interface IPostData with - member _.add post = add post - member _.countByStatus status webLogId = countByStatus status webLogId - member _.delete postId webLogId = delete postId webLogId - member _.findById postId webLogId = findById postId webLogId - member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId - member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId - member _.findFullById postId webLogId = findFullById postId webLogId - member _.findFullByWebLog webLogId = findFullByWebLog webLogId - member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = + member _.Add post = add post + member _.CountByStatus status webLogId = countByStatus status webLogId + member _.Delete postId webLogId = delete postId webLogId + member _.FindById postId webLogId = findById postId webLogId + member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId + member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId + member _.FindFullById postId webLogId = findFullById postId webLogId + member _.FindFullByWebLog webLogId = findFullByWebLog webLogId + member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage - member _.findPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage - member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage = + member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage + member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = findPageOfPublishedPosts webLogId pageNbr postsPerPage - member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage = + member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = findPageOfTaggedPosts webLogId tag pageNbr postsPerPage - member _.findSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn - member _.restore posts = restore posts - member _.update post = update post - member _.updatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks + member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn + member _.Restore posts = restore posts + member _.Update post = update post + member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index 6b8c1ac..0950fd3 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -99,10 +99,10 @@ type SQLiteTagMapData (conn : SqliteConnection) = } interface ITagMapData with - member _.delete tagMapId webLogId = delete tagMapId webLogId - member _.findById tagMapId webLogId = findById tagMapId webLogId - member _.findByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId - member _.findByWebLog webLogId = findByWebLog webLogId - member _.findMappingForTags tags webLogId = findMappingForTags tags webLogId - member _.save tagMap = save tagMap - member this.restore tagMaps = restore tagMaps + member _.Delete tagMapId webLogId = delete tagMapId webLogId + member _.FindById tagMapId webLogId = findById tagMapId webLogId + member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId + member _.Save tagMap = save tagMap + member this.Restore tagMaps = restore tagMaps diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index da81553..85ff0c0 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -101,10 +101,10 @@ type SQLiteThemeData (conn : SqliteConnection) = } interface IThemeData with - member _.all () = all () - member _.findById themeId = findById themeId - member _.findByIdWithoutText themeId = findByIdWithoutText themeId - member _.save theme = save theme + member _.All () = all () + member _.FindById themeId = findById themeId + member _.FindByIdWithoutText themeId = findByIdWithoutText themeId + member _.Save theme = save theme open System.IO @@ -199,9 +199,9 @@ type SQLiteThemeAssetData (conn : SqliteConnection) = } interface IThemeAssetData with - member _.all () = all () - member _.deleteByTheme themeId = deleteByTheme themeId - member _.findById assetId = findById assetId - member _.findByTheme themeId = findByTheme themeId - member _.findByThemeWithData themeId = findByThemeWithData themeId - member _.save asset = save asset + member _.All () = all () + member _.DeleteByTheme themeId = deleteByTheme themeId + member _.FindById assetId = findById assetId + member _.FindByTheme themeId = findByTheme themeId + member _.FindByThemeWithData themeId = findByThemeWithData themeId + member _.Save asset = save asset diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index 1af4d69..c21c717 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -92,10 +92,10 @@ type SQLiteUploadData (conn : SqliteConnection) = } interface IUploadData with - member _.add upload = add upload - member _.delete uploadId webLogId = delete uploadId webLogId - member _.findByPath path webLogId = findByPath path webLogId - member _.findByWebLog webLogId = findByWebLog webLogId - member _.findByWebLogWithData webLogId = findByWebLogWithData webLogId - member _.restore uploads = restore uploads + member _.Add upload = add upload + member _.Delete uploadId webLogId = delete uploadId webLogId + member _.FindByPath path webLogId = findByPath path webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId + member _.Restore uploads = restore uploads \ No newline at end of file diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 8090cb6..60bb69d 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -325,10 +325,10 @@ type SQLiteWebLogData (conn : SqliteConnection) = } interface IWebLogData with - member _.add webLog = add webLog - member _.all () = all () - member _.delete webLogId = delete webLogId - member _.findByHost url = findByHost url - member _.findById webLogId = findById webLogId - member _.updateSettings webLog = updateSettings webLog - member _.updateRssOptions webLog = updateRssOptions webLog + member _.Add webLog = add webLog + member _.All () = all () + member _.Delete webLogId = delete webLogId + member _.FindByHost url = findByHost url + member _.FindById webLogId = findById webLogId + member _.UpdateSettings webLog = updateSettings webLog + member _.UpdateRssOptions webLog = updateRssOptions webLog diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index d448f5b..b36032f 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -1,5 +1,6 @@ namespace MyWebLog.Data.SQLite +open System open Microsoft.Data.Sqlite open MyWebLog open MyWebLog.Data @@ -21,6 +22,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = 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 @@ -31,10 +34,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = 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 + access_level, created_on, last_seen_on ) VALUES ( @id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, - @accessLevel + @accessLevel, @createdOn, @lastSeenOn )""" addWebLogUserParameters cmd user do! write cmd @@ -91,6 +94,22 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = do! add user } + /// Set a user's last seen date/time to now + let setLastSeen userId webLogId = backgroundTask { + use cmd = conn.CreateCommand () + cmd.CommandText <- """ + UPDATE web_log_user + SET last_seen_on = @lastSeenOn + WHERE id = @id + AND web_log_id = @webLogId""" + addWebLogId cmd webLogId + [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) + cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow) + ] |> ignore + let! _ = cmd.ExecuteNonQueryAsync () + () + } + /// Update a user let update user = backgroundTask { use cmd = conn.CreateCommand () @@ -103,7 +122,9 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = password_hash = @passwordHash, salt = @salt, url = @url, - access_level = @accessLevel + access_level = @accessLevel, + created_on = @createdOn, + last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId""" addWebLogUserParameters cmd user @@ -111,10 +132,11 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = } interface IWebLogUserData with - member _.add user = add user - member _.findByEmail email webLogId = findByEmail email webLogId - member _.findById userId webLogId = findById userId webLogId - member _.findByWebLog webLogId = findByWebLog webLogId - member _.findNames webLogId userIds = findNames webLogId userIds - member this.restore users = restore users - member _.update user = update user + member _.Add user = add user + member _.FindByEmail email webLogId = findByEmail email webLogId + member _.FindById userId webLogId = findById userId webLogId + member _.FindByWebLog webLogId = findByWebLog webLogId + member _.FindNames webLogId userIds = findNames webLogId userIds + member _.Restore users = restore users + member _.SetLastSeen userId webLogId = setLastSeen userId webLogId + member _.Update user = update user diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index f3e4885..a30b4e6 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -40,7 +40,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = member _.WebLog = SQLiteWebLogData conn member _.WebLogUser = SQLiteWebLogUserData conn - member _.startUp () = backgroundTask { + member _.StartUp () = backgroundTask { use cmd = conn.CreateCommand () @@ -174,7 +174,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = password_hash TEXT NOT NULL, salt TEXT NOT NULL, url TEXT, - access_level TEXT NOT NULL); + 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)""" do! write cmd diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index e435067..80aebec 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -9,13 +9,13 @@ open MyWebLog.ViewModels 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 - slug = fullSlug - name = cat.name - description = cat.description - parentNames = Array.ofList parentNames + { Id = CategoryId.toString cat.id + Slug = fullSlug + Name = cat.name + Description = cat.description + ParentNames = Array.ofList parentNames // Post counts are filled on a second pass - postCount = 0 + PostCount = 0 } 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 8c285b1..28b252b 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -438,6 +438,12 @@ type WebLogUser = /// The user's access level accessLevel : AccessLevel + + /// When the user was created + createdOn : DateTime + + /// When the user last logged on + lastSeenOn : DateTime option } /// Functions to support web log users @@ -455,6 +461,8 @@ module WebLogUser = salt = Guid.Empty url = None accessLevel = Author + createdOn = DateTime.UnixEpoch + lastSeenOn = None } /// Get the user's displayed name diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 0334d8f..f0b6fc1 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -16,22 +16,22 @@ module private Helpers = [] type DashboardModel = { /// The number of published posts - posts : int + Posts : int /// The number of post drafts - drafts : int + Drafts : int /// The number of pages - pages : int + Pages : int /// The number of pages in the page list - listedPages : int + ListedPages : int /// The number of categories - categories : int + Categories : int /// The top-level categories - topLevelCategories : int + TopLevelCategories : int } @@ -39,50 +39,50 @@ type DashboardModel = [] type DisplayCategory = { /// The ID of the category - id : string + Id : string /// The slug for the category - slug : string + Slug : string /// The name of the category - name : string + Name : string /// A description of the category - description : string option + Description : string option /// The parent category names for this (sub)category - parentNames : string[] + ParentNames : string[] /// The number of posts in this category - postCount : int + PostCount : int } /// A display version of a custom feed definition type DisplayCustomFeed = { /// The ID of the custom feed - id : string + Id : string /// The source of the custom feed - source : string + Source : string /// The relative path at which the custom feed is served - path : string + Path : string /// Whether this custom feed is for a podcast - isPodcast : bool + IsPodcast : bool } /// Create a display version from a custom feed static member fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed = let source = match feed.source with - | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.id = catId)).name}" + | Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}" | Tag tag -> $"Tag: {tag}" - { id = CustomFeedId.toString feed.id - source = source - path = Permalink.toString feed.path - isPodcast = Option.isSome feed.podcast + { Id = CustomFeedId.toString feed.id + Source = source + Path = Permalink.toString feed.path + IsPodcast = Option.isSome feed.podcast } @@ -90,87 +90,87 @@ type DisplayCustomFeed = [] type DisplayPage = { /// The ID of this page - id : string + Id : string /// The ID of the author of this page - authorId : string + AuthorId : string /// The title of the page - title : string + Title : string /// The link at which this page is displayed - permalink : string + Permalink : string /// 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 + ShowInPageList : bool /// Is this the default page? - isDefault : bool + IsDefault : bool /// The text of the page - text : string + Text : string /// The metadata for the page - metadata : MetaItem list + Metadata : MetaItem list } /// 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 = [] + { 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 = [] } /// 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 + { 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 } /// Information about a revision used for display -[] +[] type DisplayRevision = { /// The as-of date/time for the revision - asOf : DateTime + AsOf : DateTime /// The as-of date/time for the revision in the web log's local time zone - asOfLocal : DateTime + AsOfLocal : DateTime /// The format of the text of the revision - format : string + Format : string } 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 } @@ -180,30 +180,30 @@ open System.IO [] type DisplayUpload = { /// The ID of the uploaded file - id : string + Id : string /// The name of the uploaded file - name : string + Name : string /// The path at which the file is served - path : string + Path : string /// The date/time the file was updated - updatedOn : DateTime option + UpdatedOn : DateTime option /// The source for this file (created from UploadDestination DU) - source : string + Source : string } /// Create a display uploaded file static member fromUpload webLog source (upload : Upload) = let path = Permalink.toString upload.path let name = Path.GetFileName path - { id = UploadId.toString upload.id - name = name - path = path.Replace (name, "") - updatedOn = Some (WebLog.localTime webLog upload.updatedOn) - source = UploadDestination.toString source + { Id = UploadId.toString upload.id + Name = name + Path = path.Replace (name, "") + UpdatedOn = Some (WebLog.localTime webLog upload.updatedOn) + Source = UploadDestination.toString source } @@ -211,28 +211,28 @@ type DisplayUpload = [] type EditCategoryModel = { /// The ID of the category being edited - categoryId : string + CategoryId : string /// The name of the category - name : string + Name : string /// The category's URL slug - slug : string + Slug : string /// A description of the category (optional) - description : string + Description : string /// The ID of the category for which this is a subcategory (optional) - parentId : string + ParentId : string } /// 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 "" } @@ -240,152 +240,152 @@ type EditCategoryModel = [] type EditCustomFeedModel = { /// The ID of the feed being editing - id : string + Id : string /// The type of source for this feed ("category" or "tag") - sourceType : string + SourceType : string /// The category ID or tag on which this feed is based - sourceValue : string + SourceValue : string /// The relative path at which this feed is served - path : string + Path : string /// Whether this feed defines a podcast - isPodcast : bool + IsPodcast : bool /// The title of the podcast - title : string + Title : string /// A subtitle for the podcast - subtitle : string + Subtitle : string /// 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 : string + ImageUrl : string /// The category from iTunes under which this podcast is categorized - itunesCategory : string + iTunesCategory : string /// A further refinement of the categorization of this podcast (iTunes field / values) - itunesSubcategory : string + iTunesSubcategory : string /// The explictness rating (iTunes field) - explicit : string + Explicit : string /// The default media type for files in this podcast - defaultMediaType : string + DefaultMediaType : string /// The base URL for relative URL media files for this podcast (optional; defaults to web log base) - mediaBaseUrl : string + MediaBaseUrl : string /// The URL for funding information for the podcast - fundingUrl : string + FundingUrl : string /// The text for the funding link - fundingText : string + FundingText : string /// A unique identifier to follow this podcast - guid : string + PodcastGuid : string /// The medium for the content of this podcast - medium : string + Medium : string } /// 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 = "" - guid = "" - medium = "" + { 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 = "" } /// 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 | 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 "" - guid = p.guid + 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 "" + Medium = p.medium |> Option.map PodcastMedium.toString |> Option.defaultValue "" } | None -> rss /// Update a feed with values from this model 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 + source = if this.SourceType = "tag" then Tag this.SourceValue else Category (CategoryId this.SourceValue) + path = Permalink this.Path podcast = - if this.isPodcast then + 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.guid |> 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 + 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 } else None @@ -395,31 +395,31 @@ type EditCustomFeedModel = [] type EditPageModel = { /// The ID of the page being edited - pageId : string + PageId : string /// The title of the page - title : string + Title : string /// The permalink for the page - permalink : string + Permalink : string /// The template to use to display the page - template : string + Template : string /// Whether this page is shown in the page list - isShownInPageList : bool + IsShownInPageList : bool /// The source format for the text - source : string + Source : string /// The text of the page - text : string + Text : string /// Names of metadata items - metaNames : string[] + MetaNames : string[] /// Values of metadata items - metaValues : string[] + MetaValues : string[] } /// Create an edit model from an existing page @@ -429,15 +429,15 @@ type EditPageModel = | 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 + { 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 } @@ -445,103 +445,103 @@ type EditPageModel = [] type EditPostModel = { /// The ID of the post being edited - postId : string + PostId : string /// The title of the post - title : string + Title : string /// The permalink for the post - permalink : string + Permalink : string /// The source format for the text - source : string + Source : string /// The text of the post - text : string + Text : string /// The tags for the post - tags : string + Tags : string /// The template used to display the post - template : string + Template : string /// The category IDs for the post - categoryIds : string[] + CategoryIds : string[] /// The post status - status : string + Status : string /// Whether this post should be published - doPublish : bool + DoPublish : bool /// Names of metadata items - metaNames : string[] + MetaNames : string[] /// Values of metadata items - metaValues : string[] + MetaValues : string[] /// Whether to override the published date/time - setPublished : bool + SetPublished : bool /// The published date/time to override - pubOverride : Nullable + PubOverride : Nullable /// Whether all revisions should be purged and the override date set as the updated date as well - setUpdated : bool + SetUpdated : bool /// Whether this post has a podcast episode - isEpisode : bool + IsEpisode : bool /// The URL for the media for this episode (may be permalink) - media : string + Media : string /// The size (in bytes) of the media for this episode - length : int64 + Length : int64 /// The duration of the media for this episode - duration : string + Duration : string /// The media type (optional, defaults to podcast-defined media type) - mediaType : string + MediaType : string /// The URL for the image for this episode (may be permalink; optional, defaults to podcast image) - imageUrl : string + ImageUrl : string /// A subtitle for the episode (optional) - subtitle : string + Subtitle : string /// The explicit rating for this episode (optional, defaults to podcast setting) - explicit : string + Explicit : string /// The URL for the chapter file for the episode (may be permalink; optional) - chapterFile : string + ChapterFile : string /// The type of the chapter file (optional; defaults to application/json+chapters if chapterFile is provided) - chapterType : string + ChapterType : string /// The URL for the transcript (may be permalink; optional) - transcriptUrl : string + TranscriptUrl : string /// The MIME type for the transcript (optional, recommended if transcriptUrl is provided) - transcriptType : string + TranscriptType : string /// The language of the transcript (optional) - transcriptLang : string + TranscriptLang : string /// Whether the provided transcript should be presented as captions - transcriptCaptions : bool + TranscriptCaptions : bool /// The season number (optional) - seasonNumber : int + SeasonNumber : int /// A description of this season (optional, ignored if season number is not provided) - seasonDescription : string + SeasonDescription : string /// The episode number (decimal; optional) - episodeNumber : string + EpisodeNumber : string /// A description of this episode (optional, ignored if episode number is not provided) - episodeDescription : string + EpisodeDescription : string } /// Create an edit model from an existing past @@ -552,59 +552,59 @@ type EditPostModel = | 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 - doPublish = false - 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 - 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 "" + { 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 + SetPublished = false + 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 "" } /// Update a post with values from the submitted form 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 + 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 "," + 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 ()}") @@ -613,28 +613,28 @@ type EditPostModel = | Some r when r.text = revision.text -> post.revisions | _ -> revision :: post.revisions episode = - if this.isEpisode then + 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 @@ -645,43 +645,43 @@ type EditPostModel = [] type EditRssModel = { /// 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 + ItemsInFeed : int /// 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 + Copyright : string } /// Create an edit model from a set of RSS options static member fromRssOptions (rss : RssOptions) = - { feedEnabled = rss.feedEnabled - feedName = rss.feedName - itemsInFeed = defaultArg rss.itemsInFeed 0 - categoryEnabled = rss.categoryEnabled - tagEnabled = rss.tagEnabled - copyright = defaultArg rss.copyright "" + { IsFeedEnabled = rss.feedEnabled + FeedName = rss.feedName + ItemsInFeed = defaultArg rss.itemsInFeed 0 + IsCategoryEnabled = rss.categoryEnabled + IsTagEnabled = rss.tagEnabled + Copyright = defaultArg rss.copyright "" } /// Update RSS options from values in this mode member this.updateOptions (rss : RssOptions) = { rss with - feedEnabled = this.feedEnabled - feedName = this.feedName - itemsInFeed = if this.itemsInFeed = 0 then None else Some this.itemsInFeed - categoryEnabled = this.categoryEnabled - tagEnabled = this.tagEnabled - copyright = noneIfBlank this.copyright + 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 } @@ -689,23 +689,23 @@ type EditRssModel = [] type EditTagMapModel = { /// The ID of the tag mapping being edited - id : string + Id : string /// The tag being mapped to a different link value - tag : string + Tag : string /// The link value for the tag - urlValue : string + UrlValue : string } /// Whether this is a new tag mapping - member this.isNew = this.id = "new" + member this.IsNew = this.Id = "new" /// 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 + { Id = TagMapId.toString tagMap.id + Tag = tagMap.tag + UrlValue = tagMap.urlValue } @@ -713,27 +713,27 @@ type EditTagMapModel = [] type EditUserModel = { /// 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 /// A new password for the user - newPassword : string + NewPassword : string /// A new password for the user, confirmed - newPasswordConfirm : string + 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 = "" + { FirstName = user.firstName + LastName = user.lastName + PreferredName = user.preferredName + NewPassword = "" + NewPasswordConfirm = "" } @@ -741,88 +741,88 @@ type EditUserModel = [] type LogOnModel = { /// The user's e-mail address - emailAddress : string + EmailAddress : string /// The user's password - password : string + Password : string /// Where the user should be redirected once they have logged on - returnTo : string option + ReturnTo : string option } /// An empty log on model static member empty = - { emailAddress = ""; password = ""; returnTo = None } + { EmailAddress = ""; Password = ""; ReturnTo = None } /// View model to manage permalinks [] type ManagePermalinksModel = { /// The ID for the entity being edited - id : string + Id : string /// The type of entity being edited ("page" or "post") - entity : string + Entity : string /// The current title of the page or post - currentTitle : string + CurrentTitle : string /// The current permalink of the page or post - currentPermalink : string + CurrentPermalink : string /// The prior permalinks for the page or post - prior : string[] + Prior : string[] } /// Create a permalink model from a page static member fromPage (pg : Page) = - { id = PageId.toString pg.id - entity = "page" - currentTitle = pg.title - currentPermalink = Permalink.toString pg.permalink - prior = pg.priorPermalinks |> List.map Permalink.toString |> Array.ofList + { Id = PageId.toString pg.id + Entity = "page" + 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 - entity = "post" - currentTitle = post.title - currentPermalink = Permalink.toString post.permalink - prior = post.priorPermalinks |> List.map Permalink.toString |> Array.ofList + { Id = PostId.toString post.id + Entity = "post" + CurrentTitle = post.title + CurrentPermalink = Permalink.toString post.permalink + Prior = post.priorPermalinks |> List.map Permalink.toString |> Array.ofList } /// View model to manage revisions -[] +[] type ManageRevisionsModel = { /// The ID for the entity being edited - id : string + Id : string /// The type of entity being edited ("page" or "post") - entity : string + Entity : string /// The current title of the page or post - currentTitle : string + CurrentTitle : string /// The revisions for the page or post - revisions : DisplayRevision[] + Revisions : DisplayRevision[] } /// Create a revision model from a page static member fromPage webLog (pg : Page) = - { id = PageId.toString pg.id - entity = "page" - currentTitle = pg.title - revisions = pg.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList + { Id = PageId.toString pg.id + Entity = "page" + 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 - entity = "post" - currentTitle = post.title - revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList + { Id = PostId.toString post.id + Entity = "post" + CurrentTitle = post.title + Revisions = post.revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList } @@ -830,83 +830,83 @@ type ManageRevisionsModel = [] type PostListItem = { /// The ID of the post - id : string + Id : string /// The ID of the user who authored the post - authorId : string + AuthorId : string /// The status of the post - status : string + Status : string /// The title of the post - title : string + Title : string /// The permalink for the post - permalink : string + Permalink : string /// When this post was published - publishedOn : Nullable + PublishedOn : Nullable /// When this post was last updated - updatedOn : DateTime + UpdatedOn : DateTime /// The text of the post - text : string + Text : string /// The IDs of the categories for this post - categoryIds : string list + CategoryIds : string list /// Tags for the post - tags : string list + Tags : string list /// The podcast episode information for this post - episode : Episode option + Episode : Episode option /// Metadata for the post - metadata : MetaItem list + Metadata : MetaItem list } /// Create a post list item from a post 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 } /// View model for displaying posts type PostDisplay = { /// The posts to be displayed - posts : PostListItem[] + Posts : PostListItem[] /// Author ID -> name lookup - authors : MetaItem list + Authors : MetaItem list /// A subtitle for the page - subtitle : string option + Subtitle : string option /// The link to view newer (more recent) posts - newerLink : string option + NewerLink : string option /// The name of the next newer post (single-post only) - newerName : string option + NewerName : string option /// The link to view older (less recent) posts - olderLink : string option + OlderLink : string option /// The name of the next older post (single-post only) - olderName : string option + OlderName : string option } @@ -914,58 +914,58 @@ type PostDisplay = [] type SettingsModel = { /// The name of the web log - name : string + Name : string /// The slug of the web log - slug : string + Slug : string /// The subtitle of the web log - subtitle : string + Subtitle : string /// The default page - defaultPage : string + DefaultPage : string /// How many posts should appear on index pages - postsPerPage : int + PostsPerPage : int /// The time zone in which dates/times should be displayed - timeZone : string + TimeZone : string /// The theme to use to display the web log - themePath : string + ThemePath : string /// Whether to automatically load htmx - autoHtmx : bool + AutoHtmx : bool /// The default location for uploads - uploads : string + Uploads : string } /// 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 + ThemePath = webLog.themePath + 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 + themePath = this.ThemePath + autoHtmx = this.AutoHtmx + uploads = UploadDestination.parse this.Uploads } @@ -973,7 +973,7 @@ type SettingsModel = [] type UploadFileModel = { /// The upload destination - destination : string + Destination : string } @@ -981,29 +981,29 @@ type UploadFileModel = [] type UserMessage = { /// The level of the message - level : string + Level : string /// The message - message : string + Message : string /// Further details about the message - detail : string option + Detail : string option } /// Functions to support user messages module UserMessage = /// An empty user message (use one of the others for pre-filled level) - let empty = { level = ""; message = ""; detail = None } + let empty = { Level = ""; Message = ""; Detail = None } /// A blank success message - let success = { empty with level = "success" } + let success = { empty with Level = "success" } /// A blank informational message - let info = { empty with level = "primary" } + let info = { empty with Level = "primary" } /// A blank warning message - let warning = { empty with level = "warning" } + let warning = { empty with Level = "warning" } /// A blank error message - let error = { empty with level = "danger" } + let error = { empty with Level = "danger" } diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 88dce01..1c3586e 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -77,7 +77,7 @@ module WebLogCache = /// Fill the web log cache from the database let fill (data : IData) = backgroundTask { - let! webLogs = data.WebLog.all () + let! webLogs = data.WebLog.All () _cache <- webLogs } @@ -99,7 +99,7 @@ module PageListCache = /// 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 + let! pages = ctx.Data.Page.FindListed webLog.id _cache[webLog.urlBase] <- pages |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with text = "" }) @@ -123,7 +123,7 @@ module CategoryCache = /// Update the cache with fresh data let update (ctx : HttpContext) = backgroundTask { - let! cats = ctx.Data.Category.findAllForView ctx.WebLog.id + let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.id _cache[ctx.WebLog.urlBase] <- cats } @@ -147,7 +147,7 @@ module TemplateCache = match _cache.ContainsKey templatePath with | true -> () | false -> - match! data.Theme.findById (ThemeId themeId) with + match! data.Theme.FindById (ThemeId themeId) with | Some theme -> let mutable text = (theme.templates |> List.find (fun t -> t.name = templateName)).text while hasInclude.IsMatch text do @@ -178,13 +178,13 @@ module ThemeAssetCache = /// Refresh the list of assets for the given theme let refreshTheme themeId (data : IData) = backgroundTask { - let! assets = data.ThemeAsset.findByTheme themeId + let! assets = data.ThemeAsset.FindByTheme themeId _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 () + let! assets = data.ThemeAsset.All () for asset in assets do let (ThemeAssetId (themeId, path)) = asset.id if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 22af39e..33640f4 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -8,9 +8,11 @@ open DotLiquid open Giraffe.ViewEngine open MyWebLog.ViewModels -/// Get the current web log from the DotLiquid context -let webLog (ctx : Context) = - ctx.Environments[0].["web_log"] :?> WebLog +/// Extensions on the DotLiquid Context object +type Context with + + /// Get the current web log from the DotLiquid context + member this.WebLog = this.Environments[0].["web_log"] :?> WebLog /// Does an asset exist for the current theme? let assetExists fileName (webLog : WebLog) = @@ -20,12 +22,12 @@ let assetExists fileName (webLog : WebLog) = let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) = match item with | :? String as link -> Some link - | :? DisplayPage as page -> Some page.permalink - | :? PostListItem as post -> Some post.permalink + | :? DisplayPage as page -> Some page.Permalink + | :? PostListItem as post -> Some post.Permalink | :? DropProxy as proxy -> Option.ofObj proxy["permalink"] |> Option.map string | _ -> None |> function - | Some link -> linkFunc (webLog ctx) (Permalink link) + | Some link -> linkFunc ctx.WebLog (Permalink link) | None -> $"alert('unknown item type {item.GetType().Name}')" @@ -39,11 +41,11 @@ type AbsoluteLinkFilter () = type CategoryLinkFilter () = static member CategoryLink (ctx : Context, catObj : obj) = match catObj with - | :? DisplayCategory as cat -> Some cat.slug + | :? DisplayCategory as cat -> Some cat.Slug | :? DropProxy as proxy -> Option.ofObj proxy["slug"] |> Option.map string | _ -> None |> function - | Some slug -> WebLog.relativeUrl (webLog ctx) (Permalink $"category/{slug}/") + | Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/") | None -> $"alert('unknown category object type {catObj.GetType().Name}')" @@ -51,12 +53,12 @@ type CategoryLinkFilter () = type EditPageLinkFilter () = static member EditPageLink (ctx : Context, pageObj : obj) = match pageObj with - | :? DisplayPage as page -> Some page.id + | :? DisplayPage as page -> Some page.Id | :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? String as theId -> Some theId | _ -> None |> function - | Some pageId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/page/{pageId}/edit") + | Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit") | None -> $"alert('unknown page object type {pageObj.GetType().Name}')" @@ -64,26 +66,25 @@ type EditPageLinkFilter () = type EditPostLinkFilter () = static member EditPostLink (ctx : Context, postObj : obj) = match postObj with - | :? PostListItem as post -> Some post.id + | :? PostListItem as post -> Some post.Id | :? DropProxy as proxy -> Option.ofObj proxy["id"] |> Option.map string | :? String as theId -> Some theId | _ -> None |> function - | Some postId -> WebLog.relativeUrl (webLog ctx) (Permalink $"admin/post/{postId}/edit") + | Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit") | None -> $"alert('unknown post object type {postObj.GetType().Name}')" /// A filter to generate nav links, highlighting the active link (exact match) type NavLinkFilter () = static member NavLink (ctx : Context, url : string, text : string) = - let webLog = webLog ctx - let _, path = WebLog.hostAndPath webLog + let _, path = WebLog.hostAndPath ctx.WebLog let path = if path = "" then path else $"{path.Substring 1}/" seq { "
  • " text "
    • " @@ -94,8 +95,7 @@ type NavLinkFilter () = /// A filter to generate a link for theme asset (image, stylesheet, script, etc.) type ThemeAssetFilter () = static member ThemeAsset (ctx : Context, asset : string) = - let webLog = webLog ctx - WebLog.relativeUrl webLog (Permalink $"themes/{webLog.themePath}/{asset}") + WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.themePath}/{asset}") /// Create various items in the page header based on the state of the page being generated @@ -103,7 +103,7 @@ type PageHeadTag () = inherit Tag () override this.Render (context : Context, result : TextWriter) = - let webLog = webLog context + let webLog = context.WebLog // spacer let s = " " let getBool name = @@ -137,12 +137,12 @@ type PageHeadTag () = if getBool "is_post" then let post = context.Environments[0].["model"] :?> PostDisplay - let url = WebLog.absoluteUrl webLog (Permalink post.posts[0].permalink) + let url = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink) result.WriteLine $"""{s}""" if getBool "is_page" then let page = context.Environments[0].["page"] :?> DisplayPage - let url = WebLog.absoluteUrl webLog (Permalink page.permalink) + let url = WebLog.absoluteUrl webLog (Permalink page.Permalink) result.WriteLine $"""{s}""" @@ -151,7 +151,7 @@ type PageFootTag () = inherit Tag () override this.Render (context : Context, result : TextWriter) = - let webLog = webLog context + let webLog = context.WebLog // spacer let s = " " @@ -176,7 +176,7 @@ type TagLinkFilter () = |> function | Some tagMap -> tagMap.urlValue | None -> tag.Replace (" ", "+") - |> function tagUrl -> WebLog.relativeUrl (webLog ctx) (Permalink $"tag/{tagUrl}/") + |> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/") /// Create links for a user to log on or off, and a dashboard link if they are logged off @@ -184,8 +184,7 @@ type UserLinksTag () = inherit Tag () override this.Render (context : Context, result : TextWriter) = - let webLog = webLog context - let link it = WebLog.relativeUrl webLog (Permalink it) + let link it = WebLog.relativeUrl context.WebLog (Permalink it) seq { """
      """ match Convert.ToBoolean context.Environments[0].["is_logged_on"] with diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 0aad0db..34183dc 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -9,25 +9,25 @@ open MyWebLog.ViewModels // GET /admin let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let webLogId = ctx.WebLog.id - let data = ctx.Data - let getCount (f : WebLogId -> Task) = f webLogId - let! posts = data.Post.countByStatus Published |> getCount - let! drafts = data.Post.countByStatus Draft |> getCount - let! pages = data.Page.countAll |> getCount - let! listed = data.Page.countListed |> getCount - let! cats = data.Category.countAll |> getCount - let! topCats = data.Category.countTopLevel |> getCount + 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) + let pages = getCount data.Page.CountAll + let listed = getCount data.Page.CountListed + let cats = getCount data.Category.CountAll + let topCats = getCount data.Category.CountTopLevel + let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats) return! Hash.FromAnonymousObject {| page_title = "Dashboard" model = - { posts = posts - drafts = drafts - pages = pages - listedPages = listed - categories = cats - topLevelCategories = topCats + { Posts = posts.Result + Drafts = drafts.Result + Pages = pages.Result + ListedPages = listed.Result + Categories = cats.Result + TopLevelCategories = topCats.Result } |} |> viewForTheme "admin" "dashboard" next ctx @@ -49,14 +49,12 @@ let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> } // GET /admin/categories/bare -let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - return! - Hash.FromAnonymousObject {| - categories = CategoryCache.get ctx - csrf = ctx.CsrfTokenSet - |} - |> bareForTheme "admin" "category-list-body" next ctx -} +let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> + Hash.FromAnonymousObject {| + categories = CategoryCache.get ctx + csrf = ctx.CsrfTokenSet + |} + |> bareForTheme "admin" "category-list-body" next ctx // GET /admin/category/{id}/edit @@ -65,7 +63,7 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct match catId with | "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 } @@ -86,34 +84,33 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data let! model = ctx.BindFormAsync () - let! category = task { - match model.categoryId with - | "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = ctx.WebLog.id } - | catId -> return! data.Category.findById (CategoryId catId) ctx.WebLog.id - } - match category with + 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 + 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! (match model.CategoryId with "new" -> data.Category.Add | _ -> data.Category.Update) cat do! CategoryCache.update ctx - do! addMessage ctx { UserMessage.success with message = "Category saved successfully" } + do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" } return! listCategoriesBare next ctx | None -> return! Error.notFound next ctx } // 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" } - | false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" } + do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" } + | false -> do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" } return! listCategoriesBare next ctx } @@ -123,7 +120,7 @@ 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 @@ -136,11 +133,10 @@ let private tagMappingHash (ctx : HttpContext) = task { let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let! hash = tagMappingHash ctx let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data - - hash.Add ("tag_mapping_list", listTemplate.Render hash) - hash.Add ("page_title", "Tag Mappings") - - return! viewForTheme "admin" "tag-mapping-list" next ctx hash + return! + addToHash "tag_mapping_list" (listTemplate.Render hash) hash + |> addToHash "page_title" "Tag Mappings" + |> viewForTheme "admin" "tag-mapping-list" next ctx } // GET /admin/settings/tag-mappings/bare @@ -153,10 +149,8 @@ let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx - 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! @@ -174,23 +168,22 @@ let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta let data = ctx.Data let! model = ctx.BindFormAsync () let tagMap = - if model.id = "new" then + 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 + 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! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" } + 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 } // 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 - | 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" } + 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 } @@ -203,14 +196,12 @@ open System.Text.RegularExpressions open MyWebLog.Data // GET /admin/theme/update -let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { - return! - Hash.FromAnonymousObject {| - page_title = "Upload Theme" - csrf = ctx.CsrfTokenSet - |} - |> viewForTheme "admin" "upload-theme" next ctx -} +let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx -> + Hash.FromAnonymousObject {| + page_title = "Upload Theme" + csrf = ctx.CsrfTokenSet + |} + |> viewForTheme "admin" "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 { @@ -223,17 +214,15 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background 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 () } + | 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 + do! data.ThemeAsset.DeleteByTheme theme.id return { theme with templates = [] } - else - return theme + else return theme } /// Update the theme with all templates from the ZIP archive @@ -261,7 +250,7 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT if assetName <> "" && not (assetName.EndsWith "/") then use stream = new MemoryStream () do! asset.Open().CopyToAsync stream - do! data.ThemeAsset.save + do! data.ThemeAsset.Save { id = ThemeAssetId (themeId, assetName) updatedOn = asset.LastWriteTime.DateTime data = stream.ToArray () @@ -278,14 +267,14 @@ let loadThemeFromZip themeName file clean (data : IData) = backgroundTask { use zip = new ZipArchive (file, ZipArchiveMode.Read) let themeId = ThemeId themeName let! theme = backgroundTask { - match! data.Theme.findById themeId with + match! data.Theme.FindById themeId with | Some t -> return t | None -> return { Theme.empty with id = themeId } } let! theme = updateNameAndVersion theme zip let! theme = checkForCleanLoad theme clean data let! theme = updateTemplates theme zip - do! data.Theme.save theme + do! data.Theme.Save theme do! updateAssets themeId zip data } @@ -301,16 +290,15 @@ let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> do! loadThemeFromZip themeName stream true data do! ThemeAssetCache.refreshTheme (ThemeId themeName) data TemplateCache.invalidateTheme themeName - do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" } + do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" } return! redirectToGet "admin/dashboard" next ctx | Ok _ -> - do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" } + do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" } return! redirectToGet "admin/theme/update" next ctx | Error message -> - do! addMessage ctx { UserMessage.error with message = message } + do! addMessage ctx { UserMessage.error with Message = message } return! redirectToGet "admin/theme/update" next ctx - else - return! RequestErrors.BAD_REQUEST "Bad request" next ctx + else return! RequestErrors.BAD_REQUEST "Bad request" next ctx } // -- WEB LOG SETTINGS -- @@ -320,8 +308,8 @@ 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! themes = data.Theme.all () + let! allPages = data.Page.All ctx.WebLog.id + let! themes = data.Theme.All () return! Hash.FromAnonymousObject {| page_title = "Web Log Settings" @@ -351,11 +339,11 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task 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 webLog = model.update webLog - do! data.WebLog.updateSettings webLog + do! data.WebLog.UpdateSettings webLog // Update cache WebLogCache.set webLog @@ -366,7 +354,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t let oldDir = Path.Combine (uploadRoot, oldSlug) 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" } + do! addMessage ctx { UserMessage.success with Message = "Web log settings saved successfully" } return! redirectToGet "admin/settings" next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 23fc381..2d63643 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -49,17 +49,17 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = /// Determine the function to retrieve posts for the given feed let private getFeedPosts ctx feedType = let childIds catId = - let cat = CategoryCache.get ctx |> Array.find (fun c -> c.id = CategoryId.toString catId) - getCategoryIds cat.slug ctx + let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId) + 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 + | 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)*?>", "") @@ -116,8 +116,8 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[ 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)) + 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 |> List.map (fun tag -> let urlTag = @@ -326,7 +326,7 @@ let private selfAndLink webLog feedType ctx = | Custom (feed, _) -> match feed.source with | Category (CategoryId catId) -> - feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.id = catId)).slug}" + 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 @@ -337,9 +337,9 @@ let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCat 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.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """ + let cat = cats |> Array.find (fun it -> it.Id = catId) + 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.Description <- cleanText None $"""Posts with the "{tag}" tag""" @@ -351,9 +351,9 @@ let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCat | None -> 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.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """ + let cat = cats |> Array.find (fun it -> it.Id = catId) + 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.Description <- cleanText None $"""Posts with the "{tag}" tag""" @@ -417,81 +417,79 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac open DotLiquid // GET: /admin/settings/rss -let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { +let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let feeds = ctx.WebLog.rss.customFeeds |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx)) |> Array.ofList - return! Hash.FromAnonymousObject {| - page_title = "RSS Settings" - csrf = ctx.CsrfTokenSet - model = EditRssModel.fromRssOptions ctx.WebLog.rss - custom_feeds = feeds - |} - |> viewForTheme "admin" "rss-settings" next ctx -} + Hash.FromAnonymousObject {| + page_title = "RSS Settings" + csrf = ctx.CsrfTokenSet + model = EditRssModel.fromRssOptions ctx.WebLog.rss + custom_feeds = feeds + |} + |> viewForTheme "admin" "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 } - do! data.WebLog.updateRssOptions webLog + do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog - do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" } + do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" } return! redirectToGet "admin/settings/rss" next ctx | None -> return! Error.notFound next ctx } // GET: /admin/settings/rss/{id}/edit -let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { +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) match customFeed with | Some f -> - return! Hash.FromAnonymousObject {| - page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" - csrf = ctx.CsrfTokenSet - model = EditCustomFeedModel.fromFeed f - categories = CategoryCache.get ctx - medium_values = [| - KeyValuePair.Create ("", "– Unspecified –") - KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast") - KeyValuePair.Create (PodcastMedium.toString Music, "Music") - KeyValuePair.Create (PodcastMedium.toString Video, "Video") - KeyValuePair.Create (PodcastMedium.toString Film, "Film") - KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook") - KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter") - KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") - |] - |} - |> viewForTheme "admin" "custom-feed-edit" next ctx - | None -> return! Error.notFound next ctx -} + Hash.FromAnonymousObject {| + page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" + csrf = ctx.CsrfTokenSet + model = EditCustomFeedModel.fromFeed f + categories = CategoryCache.get ctx + medium_values = [| + KeyValuePair.Create ("", "– Unspecified –") + KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast") + KeyValuePair.Create (PodcastMedium.toString Music, "Music") + KeyValuePair.Create (PodcastMedium.toString Video, "Video") + KeyValuePair.Create (PodcastMedium.toString Film, "Film") + KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook") + KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter") + KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") + |] + |} + |> viewForTheme "admin" "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 + 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) + | _ -> 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 } } - do! data.WebLog.updateRssOptions webLog + 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""" + 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 | None -> return! Error.notFound next ctx @@ -501,7 +499,7 @@ 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 @@ -512,11 +510,11 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId) } } - do! data.WebLog.updateRssOptions webLog + do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog - do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" } + do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" } else - do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" } + do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" } return! redirectToGet "admin/settings/rss" next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index f0d8fda..b77d607 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -125,9 +125,9 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler = yield! messages |> Array.map (fun m -> - match m.detail with - | Some detail -> $"{m.level}|||{m.message}|||{detail}" - | None -> $"{m.level}|||{m.message}" + match m.Detail with + | Some detail -> $"{m.Level}|||{m.Message}|||{detail}" + | None -> $"{m.Level}|||{m.Message}" |> setHttpHeader "X-Message") withHxNoPushUrl } @@ -184,7 +184,7 @@ module Error = if isHtmx ctx then let messages = [| { UserMessage.error with - message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" + Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" } |] (messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx @@ -195,7 +195,7 @@ module Error = handleContext (fun ctx -> if isHtmx ctx then let messages = [| - { UserMessage.error with message = $"The URL {ctx.Request.Path.Value} was not found" } + { UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" } |] (messagesToHeaders messages >=> setStatusCode 404) earlyReturn ctx else @@ -216,7 +216,7 @@ let requireAccess level : HttpHandler = fun next ctx -> task { | Some lvl -> $"The page you tried to access requires {AccessLevel.toString level} privileges; your account only has {AccessLevel.toString lvl} privileges" | None -> "The page you tried to access required you to be logged on" - do! addMessage ctx { UserMessage.warning with message = message } + do! addMessage ctx { UserMessage.warning with Message = message } printfn "Added message to context" do! commitSession ctx return! Error.notAuthorized next ctx @@ -232,7 +232,7 @@ 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 (ThemeId ctx.WebLog.themePath) with | Some theme -> return seq { KeyValuePair.Create ("", $"- Default (single-{typ}) -") @@ -251,7 +251,7 @@ let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) = posts |> 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) = @@ -259,17 +259,17 @@ let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) = |> 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 = let allCats = CategoryCache.get ctx - let cat = allCats |> Array.find (fun cat -> cat.slug = slug) + let cat = allCats |> Array.find (fun cat -> cat.Slug = slug) // Category pages include posts in subcategories allCats |> Seq.ofArray - |> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames) - |> Seq.map (fun c -> CategoryId c.id) + |> Seq.filter (fun c -> c.Id = cat.Id || Array.contains cat.Name c.ParentNames) + |> Seq.map (fun c -> CategoryId c.Id) |> List.ofSeq open System diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 23f622a..26fc054 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" @@ -28,7 +28,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { match pgId with | "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 } @@ -41,7 +41,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { page_title = title csrf = ctx.CsrfTokenSet model = model - metadata = Array.zip model.metaNames model.metaValues + metadata = Array.zip model.MetaNames model.MetaValues |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) templates = templates |} @@ -52,17 +52,17 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task { // 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" } - | false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" } + do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" } + | false -> do! addMessage ctx { UserMessage.error with Message = "Page not found; nothing deleted" } return! redirectToGet "admin/pages" next ctx } // 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 + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with | Some pg when canEdit pg.authorId ctx -> return! Hash.FromAnonymousObject {| @@ -78,14 +78,14 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> // POST /admin/page/permalinks 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 + let pageId = PageId model.Id + 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 + let links = model.Prior |> Array.map Permalink |> List.ofArray + 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 + do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" } + return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx | false -> return! Error.notFound next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx @@ -93,7 +93,7 @@ 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 + match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.id with | Some pg when canEdit pg.authorId ctx -> return! Hash.FromAnonymousObject {| @@ -109,10 +109,10 @@ 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! addMessage ctx { UserMessage.success with message = "Prior revisions purged successfully" } + 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,7 +121,7 @@ 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) @@ -148,12 +148,12 @@ open System 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 -> - do! ctx.Data.Page.update + do! ctx.Data.Page.Update { pg with 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" } + do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } return! redirectToGet $"admin/page/{pgId}/revisions" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ @@ -164,52 +164,54 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun 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) } - do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" } + 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 = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } -#nowarn "3511" +//#nowarn "3511" + +open System.Threading.Tasks // POST /admin/page/save let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let data = ctx.Data let now = DateTime.UtcNow - let! pg = task { - match model.pageId with + let pg = + match model.PageId with | "new" -> - return Some - { Page.empty with - id = PageId.create () - webLogId = ctx.WebLog.id - authorId = ctx.UserId - publishedOn = now - } - | pgId -> return! data.Page.findFullById (PageId pgId) ctx.WebLog.id - } - match pg with + Task.FromResult ( + Some + { Page.empty with + id = PageId.create () + webLogId = ctx.WebLog.id + authorId = ctx.UserId + publishedOn = now + }) + | 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}" } + let updateList = page.showInPageList <> 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 | "" -> page - | link when link = model.permalink -> page + | link when link = model.Permalink -> page | _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks } let page = { page with - title = model.title - permalink = Permalink model.permalink + title = model.Title + permalink = Permalink model.Permalink updatedOn = now - showInPageList = model.isShownInPageList - template = match model.template with "" -> None | tmpl -> Some tmpl + showInPageList = model.IsShownInPageList + template = match model.Template with "" -> None | tmpl -> Some tmpl text = MarkupText.toHtml revision.text - metadata = Seq.zip model.metaNames model.metaValues + 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 ()}") @@ -218,9 +220,9 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { | 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 + 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" } + do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } 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 cc506d8..68f996d 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -16,8 +16,7 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) = || (webLog.rss.tagEnabled && fullPath.StartsWith "/tag/" )) && slugPath.EndsWith feedName then notBlank (slugPath.Replace(feedName, "").Split "/"), true - else - notBlank (slugPath.Split "/"), false + else notBlank (slugPath.Split "/"), false let pageIdx = Array.IndexOf (slugs, "page") let pageNbr = match pageIdx with @@ -56,7 +55,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da | SinglePost -> let post = List.head posts let dateTime = defaultArg post.publishedOn post.updatedOn - data.Post.findSurroundingPosts webLog.id dateTime + data.Post.FindSurroundingPosts webLog.id dateTime | _ -> Task.FromResult (None, None) let newerLink = match listType, pageNbr with @@ -68,7 +67,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" | TagList, 2 -> relUrl $"tag/{url}/" | TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}" - | AdminList, 2 -> relUrl "admin/posts" + | AdminList, 2 -> relUrl "admin/posts" | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}" let olderLink = match listType, List.length posts > perPage with @@ -79,13 +78,13 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (da | TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}" | AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}" let model = - { posts = postItems - authors = authors - subtitle = None - newerLink = newerLink - newerName = newerPost |> Option.map (fun p -> p.title) - olderLink = olderLink - olderName = olderPost |> Option.map (fun p -> p.title) + { Posts = postItems + Authors = authors + Subtitle = None + NewerLink = newerLink + NewerName = newerPost |> Option.map (fun p -> p.title) + OlderLink = olderLink + OlderName = olderPost |> Option.map (fun p -> p.title) } return Hash.FromAnonymousObject {| model = model @@ -101,7 +100,7 @@ open Giraffe let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { 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 @@ -124,23 +123,24 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task { let data = ctx.Data match parseSlugAndPage webLog slugAndPage with | Some pageNbr, slug, isFeed -> - match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = slug) with + 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}")) + 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})""" - hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}") - hash.Add ("subtitle", defaultArg cat.description "") - hash.Add ("is_category", true) - hash.Add ("is_category_home", (pageNbr = 1)) - hash.Add ("slug", slug) - return! themedView "index" next ctx hash + return! + addToHash "page_title" $"{cat.Name}: Category Archive{pgTitle}" hash + |> addToHash "subtitle" (defaultArg cat.Description "") + |> addToHash "is_category" true + |> addToHash "is_category_home" (pageNbr = 1) + |> addToHash "slug" slug + |> themedView "index" next ctx | _ -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx @@ -157,7 +157,7 @@ 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 + match! data.TagMap.FindByUrlValue urlTag webLog.id with | Some m -> return m.tag | None -> return urlTag } @@ -165,19 +165,20 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { 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 pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" - hash.Add ("page_title", $"Posts Tagged “{tag}”{pgTitle}") - hash.Add ("is_tag", true) - hash.Add ("is_tag_home", (pageNbr = 1)) - hash.Add ("slug", rawTag) - return! themedView "index" next ctx hash + return! + addToHash "page_title" $"Posts Tagged “{tag}”{pgTitle}" hash + |> addToHash "is_tag" true + |> addToHash "is_tag_home" (pageNbr = 1) + |> addToHash "slug" rawTag + |> themedView "index" next ctx // 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! @@ -194,7 +195,7 @@ let home : HttpHandler = fun next ctx -> task { 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 {| @@ -211,11 +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 - hash.Add ("page_title", "Posts") - hash.Add ("csrf", ctx.CsrfTokenSet) - return! viewForTheme "admin" "post-list" next ctx hash + return! + addToHash "page_title" "Posts" hash + |> addToHash "csrf" ctx.CsrfTokenSet + |> viewForTheme "admin" "post-list" next ctx } // GET /admin/post/{id}/edit @@ -225,13 +227,13 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { match postId with | "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 + let! cats = data.Category.FindAllForView ctx.WebLog.id let! templates = templatesForTheme ctx "post" let model = EditPostModel.fromPost ctx.WebLog post return! @@ -239,7 +241,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { page_title = title csrf = ctx.CsrfTokenSet model = model - metadata = Array.zip model.metaNames model.metaValues + metadata = Array.zip model.MetaNames model.MetaValues |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) templates = templates categories = cats @@ -257,15 +259,15 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { // 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 - | true -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" } - | false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" } + 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 } // 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 + match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with | Some post when canEdit post.authorId ctx -> return! Hash.FromAnonymousObject {| @@ -281,14 +283,14 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx // POST /admin/post/permalinks 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 + let postId = PostId model.Id + 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 model.id) ctx.WebLog.id links with + let links = model.Prior |> Array.map Permalink |> List.ofArray + 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 + do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" } + return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx | false -> return! Error.notFound next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx @@ -296,7 +298,7 @@ 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 + match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.id with | Some post when canEdit post.authorId ctx -> return! Hash.FromAnonymousObject {| @@ -312,10 +314,10 @@ 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 + 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" } + 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 | None -> return! Error.notFound next ctx @@ -325,7 +327,7 @@ 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) @@ -350,12 +352,12 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f 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 -> - do! ctx.Data.Post.update + do! ctx.Data.Post.Update { post with 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" } + do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ @@ -366,64 +368,62 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f 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) } - do! addMessage ctx { UserMessage.success with message = "Revision deleted successfully" } + 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 = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } -#nowarn "3511" +//#nowarn "3511" // POST /admin/post/save let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () - let data = ctx.Data - let now = DateTime.UtcNow - let! pst = task { - match model.postId with - | "new" -> - return Some - { Post.empty with - id = PostId.create () - webLogId = ctx.WebLog.id - authorId = ctx.UserId - } - | postId -> return! data.Post.findFullById (PostId postId) ctx.WebLog.id - } - match pst with + let! model = ctx.BindFormAsync () + let data = ctx.Data + let now = DateTime.UtcNow + let tryPost = + if model.PostId = "new" then + Task.FromResult ( + Some + { Post.empty with + id = PostId.create () + webLogId = ctx.WebLog.id + authorId = ctx.UserId + }) + else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.id + match! tryPost with | Some post when canEdit post.authorId ctx -> - let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } + 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 | "" -> post - | link when link = model.permalink -> post + | link when link = model.Permalink -> post | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } let post = model.updatePost post revision now let post = - match model.setPublished with - | true -> - let dt = parseToUtc (model.pubOverride.Value.ToString "o") - match model.setUpdated with - | true -> + 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 } ] } - | false -> { post with publishedOn = Some dt } - | false -> post - do! (if model.postId = "new" then data.Post.add else data.Post.update) post + 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 (pst.Value.categoryIds + if model.DoPublish + || not (priorCats |> List.append post.categoryIds |> List.distinct - |> List.length = List.length pst.Value.categoryIds) then + |> List.length = List.length priorCats) then do! CategoryCache.update ctx - do! addMessage ctx { UserMessage.success with message = "Post saved successfully" } + do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" } 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 a746563..b11d5ce 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -27,7 +27,7 @@ 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 @@ -35,7 +35,7 @@ module CatchAll = 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 -> @@ -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) | 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) | 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) @@ -83,11 +83,8 @@ module CatchAll = } // GET {all-of-the-above} - let route : HttpHandler = fun next ctx -> task { - match deriveAction ctx |> Seq.tryHead with - | Some handler -> return! handler next ctx - | None -> return! Error.notFound next ctx - } + let route : HttpHandler = fun next ctx -> + match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx /// Serve theme assets @@ -96,7 +93,7 @@ module Asset = // GET /theme/{theme}/{**path} let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { let path = urlParts |> Seq.skip 1 |> Seq.head - match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with + match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with | Some asset -> match Upload.checkModified asset.updatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx @@ -219,10 +216,10 @@ let routerWithPath extraPath : HttpHandler = subRoute extraPath router /// Handler to apply Giraffe routing with a possible sub-route -let handleRoute : HttpHandler = fun next ctx -> task { +let handleRoute : HttpHandler = fun next ctx -> let _, extraPath = WebLog.hostAndPath ctx.WebLog - return! (if extraPath = "" then router else routerWithPath extraPath) next ctx -} + (if extraPath = "" then router else routerWithPath extraPath) next ctx + open Giraffe.EndpointRouting diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 91eeefc..8c733e8 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -45,13 +45,13 @@ let deriveMimeType path = match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream" /// Send a file, caching the response for 30 days -let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> task { +let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> let headers = ResponseHeaders ctx.Response.Headers headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path headers.CacheControl <- cacheForThirtyDays let stream = new MemoryStream (data) - return! streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx -} + streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx + // GET /upload/{web-log-slug}/{**path} let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { @@ -65,7 +65,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { 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 | Some threeOhFour -> return! threeOhFour next ctx @@ -87,7 +87,7 @@ 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) try @@ -98,11 +98,11 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { match File.GetCreationTime (Path.Combine (path, file)) with | dt when dt > DateTime.UnixEpoch -> Some dt | _ -> None - { DisplayUpload.id = "" - name = name - path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/') - updatedOn = create - source = UploadDestination.toString Disk + { DisplayUpload.Id = "" + Name = name + Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/') + UpdatedOn = create + Source = UploadDestination.toString Disk }) |> List.ofSeq with @@ -114,7 +114,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { dbUploads |> List.map (DisplayUpload.fromUpload webLog Database) |> List.append diskUploads - |> List.sortByDescending (fun file -> file.updatedOn, file.path) + |> List.sortByDescending (fun file -> file.UpdatedOn, file.Path) return! Hash.FromAnonymousObject {| @@ -126,15 +126,14 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { } // GET /admin/upload/new -let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> task { - return! - Hash.FromAnonymousObject {| - page_title = "Upload a File" - csrf = ctx.CsrfTokenSet - destination = UploadDestination.toString ctx.WebLog.uploads - |} - |> viewForTheme "admin" "upload-new" next ctx -} +let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> + Hash.FromAnonymousObject {| + page_title = "Upload a File" + csrf = ctx.CsrfTokenSet + destination = UploadDestination.toString ctx.WebLog.uploads + |} + |> viewForTheme "admin" "upload-new" next ctx + /// Redirect to the upload list let showUploads : HttpHandler = @@ -151,7 +150,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let month = localNow.ToString "MM" let! form = ctx.BindFormAsync () - match UploadDestination.parse form.destination with + match UploadDestination.parse form.Destination with | Database -> use stream = new MemoryStream () do! upload.CopyToAsync stream @@ -162,14 +161,14 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { updatedOn = DateTime.UtcNow data = stream.ToArray () } - do! ctx.Data.Upload.add file + do! ctx.Data.Upload.Add file | Disk -> 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 - do! addMessage ctx { UserMessage.success with message = $"File uploaded to {form.destination} successfully" } + do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" } return! showUploads next ctx else return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx @@ -177,9 +176,9 @@ 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" } + do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" } return! showUploads next ctx | Error _ -> return! Error.notFound next ctx } @@ -193,8 +192,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) = if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then Directory.Delete fullPath path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) - else - finished <- true + else finished <- true // POST /admin/upload/delete/{**path} let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { @@ -203,8 +201,7 @@ let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun ne if File.Exists path then File.Delete path removeEmptyDirectories ctx.WebLog filePath - do! addMessage ctx { UserMessage.success with message = $"{filePath} deleted successfully" } + do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" } return! showUploads next ctx - else - return! Error.notFound next ctx + else return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 941eff4..5888e43 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -17,22 +17,18 @@ open MyWebLog open MyWebLog.ViewModels // GET /user/log-on -let logOn returnUrl : HttpHandler = fun next ctx -> task { +let logOn returnUrl : HttpHandler = fun next ctx -> let returnTo = match returnUrl with | Some _ -> returnUrl - | None -> - match ctx.Request.Query.ContainsKey "returnUrl" with - | true -> Some ctx.Request.Query["returnUrl"].[0] - | false -> None - return! - Hash.FromAnonymousObject {| - page_title = "Log On" - csrf = ctx.CsrfTokenSet - model = { LogOnModel.empty with returnTo = returnTo } - |} - |> viewForTheme "admin" "log-on" next ctx -} + | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None + Hash.FromAnonymousObject {| + page_title = "Log On" + csrf = ctx.CsrfTokenSet + model = { LogOnModel.empty with ReturnTo = returnTo } + |} + |> viewForTheme "admin" "log-on" next ctx + open System.Security.Claims open Microsoft.AspNetCore.Authentication @@ -41,8 +37,9 @@ open Microsoft.AspNetCore.Authentication.Cookies // POST /user/log-on let doLogOn : HttpHandler = fun next ctx -> task { let! model = ctx.BindFormAsync () - match! ctx.Data.WebLogUser.findByEmail model.emailAddress ctx.WebLog.id with - | Some user when user.passwordHash = hashedPassword model.password user.userName user.salt -> + 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 -> let claims = seq { Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}") @@ -53,34 +50,35 @@ let doLogOn : HttpHandler = fun next ctx -> task { do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity, AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow)) + 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 + match model.ReturnTo with | Some url -> redirectTo false url next ctx | None -> redirectToGet "admin/dashboard" next ctx | _ -> - do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" } - return! logOn model.returnTo next ctx + do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" } + return! logOn model.ReturnTo next ctx } // GET /user/log-off let logOff : HttpHandler = fun next ctx -> task { do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme - do! addMessage ctx { UserMessage.info with message = "Log off successful" } + do! addMessage ctx { UserMessage.info with Message = "Log off successful" } return! redirectToGet "" next ctx } /// Display the user edit page, with information possibly filled in -let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task { - hash.Add ("page_title", "Edit Your Information") - hash.Add ("csrf", ctx.CsrfTokenSet) - return! viewForTheme "admin" "user-edit" next ctx hash -} +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 + // GET /admin/user/edit let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task { - match! ctx.Data.WebLogUser.findById ctx.UserId ctx.WebLog.id with + match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with | Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx | None -> return! Error.notFound next ctx } @@ -88,32 +86,32 @@ let edit : HttpHandler = requireAccess Author >=> fun next ctx -> task { // POST /admin/user/save let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () - if model.newPassword = model.newPasswordConfirm then + if model.NewPassword = model.NewPasswordConfirm then let data = ctx.Data - match! data.WebLogUser.findById ctx.UserId ctx.WebLog.id with + match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.id with | Some user -> let pw, salt = - if model.newPassword = "" then + if model.NewPassword = "" then user.passwordHash, user.salt else let newSalt = Guid.NewGuid () - hashedPassword model.newPassword user.userName newSalt, newSalt + hashedPassword model.NewPassword user.userName newSalt, newSalt let user = { user with - firstName = model.firstName - lastName = model.lastName - preferredName = model.preferredName + 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" } + 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" } + do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" } return! showEdit (Hash.FromAnonymousObject {| - model = { model with newPassword = ""; newPasswordConfirm = "" } + model = { model with NewPassword = ""; NewPasswordConfirm = "" } |}) next ctx } diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index fdf11c0..5540bdd 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -27,10 +27,10 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { // If this is the first web log being created, the user will be an installation admin; otherwise, they will be an // admin just over their web log - let! webLogs = data.WebLog.all () + let! webLogs = data.WebLog.All () let accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin - do! data.WebLog.add + do! data.WebLog.Add { WebLog.empty with id = webLogId name = args[2] @@ -42,8 +42,9 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { // Create the admin user let salt = Guid.NewGuid () + let now = DateTime.UtcNow - do! data.WebLogUser.add + do! data.WebLogUser.Add { WebLogUser.empty with id = userId webLogId = webLogId @@ -54,21 +55,22 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { passwordHash = Handlers.User.hashedPassword args[4] args[3] salt salt = salt accessLevel = accessLevel + createdOn = now } // Create the default home page - do! data.Page.add + do! data.Page.Add { Page.empty with id = homePageId webLogId = webLogId authorId = userId title = "Welcome to myWebLog!" permalink = Permalink "welcome-to-myweblog.html" - publishedOn = DateTime.UtcNow - updatedOn = DateTime.UtcNow + publishedOn = now + updatedOn = now text = "

      This is your default home page.

      " revisions = [ - { asOf = DateTime.UtcNow + { asOf = now text = Html "

      This is your default home page.

      " } ] @@ -94,7 +96,7 @@ let createWebLog args sp = task { let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task { let data = sp.GetRequiredService () - match! data.WebLog.findByHost urlBase with + match! data.WebLog.FindByHost urlBase with | Some webLog -> let mapping = @@ -105,10 +107,10 @@ 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 + 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}" @@ -285,24 +287,24 @@ module Backup = 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 themeId + let! assets = data.ThemeAsset.FindByThemeWithData 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 = { @@ -329,9 +331,9 @@ module Backup = let private doRestore archive newUrlBase (data : IData) = task { let! restore = task { - match! data.WebLog.findById archive.webLog.id with + match! data.WebLog.FindById archive.webLog.id with | Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase -> - do! data.WebLog.delete webLog.id + do! data.WebLog.Delete webLog.id return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } } | Some _ -> // Err'body gets new IDs... @@ -379,31 +381,31 @@ module Backup = // 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.fromEncoded >> 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.fromEncoded) displayStats "Restored for <>NAME<>:" restore.webLog restore } @@ -436,7 +438,7 @@ module Backup = let generateBackup (args : string[]) (sp : IServiceProvider) = task { if args.Length > 1 && args.Length < 5 then let data = sp.GetRequiredService () - match! data.WebLog.findByHost args[1] with + match! data.WebLog.FindByHost args[1] with | Some webLog -> let fileName = if args.Length = 2 || (args.Length = 3 && args[2] = "pretty") then @@ -469,13 +471,13 @@ module Backup = /// Upgrade a WebLogAdmin user to an Administrator user let private doUserUpgrade urlBase email (data : IData) = task { - match! data.WebLog.findByHost urlBase with + 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 | 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 4339fea..12d7063 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -90,7 +90,7 @@ let rec main args = let data = DataImplementation.get sp task { - do! data.startUp () + do! data.StartUp () do! WebLogCache.fill data do! ThemeAssetCache.fill data } |> Async.AwaitTask |> Async.RunSynchronously diff --git a/src/admin-theme/category-edit.liquid b/src/admin-theme/category-edit.liquid index cb402fa..2b80c5d 100644 --- a/src/admin-theme/category-edit.liquid +++ b/src/admin-theme/category-edit.liquid @@ -3,25 +3,25 @@
      - +
      -
      -
      - @@ -38,7 +38,7 @@
      -
      diff --git a/src/admin-theme/custom-feed-edit.liquid b/src/admin-theme/custom-feed-edit.liquid index 0a2f3fc..a1733ef 100644 --- a/src/admin-theme/custom-feed-edit.liquid +++ b/src/admin-theme/custom-feed-edit.liquid @@ -2,7 +2,7 @@
      - + {%- assign typ = model.source_type -%}
      @@ -17,7 +17,7 @@
      - Appended to {{ web_log.url_base }}/ @@ -27,7 +27,7 @@
      -
      @@ -41,7 +41,7 @@
      - @@ -49,7 +49,7 @@
      -
      - @@ -88,21 +88,21 @@
      -
      -
      -
      @@ -111,7 +111,7 @@
      - @@ -124,14 +124,14 @@
      -
      -