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

Edit formatting for handlers

Browse Source
This commit is contained in:
Daniel J. Summers
2026-07-03 19:23:45 -04:00
parent 0de1bff190
commit 84444e4789
6 changed files with 1109 additions and 954 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Handlers/Admin.fs
+93 -30
View File
@@ -12,7 +12,9 @@ open NodaTime
module Dashboard =
// GET /admin/dashboard
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let user : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let getCount (f: WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let! posts = getCount (data.Post.CountByStatus Published)
@@ -32,7 +34,9 @@ module Dashboard =
}
// GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let admin : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
}
@@ -45,7 +49,10 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
module Cache =
// POST /admin/cache/web-log/{id}/refresh
let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let refreshWebLog webLogId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
if webLogId = "all" then
do! WebLogCache.fill data
@@ -61,14 +68,18 @@ module Cache =
do! PageListCache.refresh webLog data
do! CategoryCache.refresh webLog.Id data
do! addMessage ctx
{ UserMessage.Success with Message = $"Successfully refreshed web log cache for {webLog.Name}" }
{ UserMessage.Success with
Message = $"Successfully refreshed web log cache for {webLog.Name}" }
| None ->
do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
return! toAdminDashboard next ctx
}
// POST /admin/cache/theme/{id}/refresh
let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let refreshTheme themeId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
if themeId = "all" then
Template.Cache.empty ()
@@ -96,13 +107,17 @@ module Category =
open MyWebLog.Data
// GET /admin/categories
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let response = fun next ctx ->
adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
// GET /admin/category/{id}/edit
let edit catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit catId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
@@ -120,7 +135,10 @@ module Category =
}
// POST /admin/category/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel>()
let category =
@@ -142,7 +160,9 @@ module Category =
}
// DELETE /admin/category/{id}
let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete catId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
match result with
| CategoryDeleted
@@ -153,7 +173,8 @@ module Category =
| ReassignedChildCategories ->
Some "<em>(Its child categories were reassigned to its parent category)</em>"
| _ -> None
do! addMessage ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
do! addMessage
ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
| CategoryNotFound ->
do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
return! all next ctx
@@ -166,11 +187,15 @@ module RedirectRules =
open Microsoft.AspNetCore.Http
// GET /admin/settings/redirect-rules
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let edit idx : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let titleAndView =
if idx = -1 then
Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
@@ -179,8 +204,8 @@ module RedirectRules =
if rules.Length < idx || idx < 0 then
None
else
Some
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
Some ("Edit",
Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))
match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
| None -> Error.notFound next ctx
@@ -193,7 +218,10 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let save idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let rule = model.ToRule()
let rules =
@@ -208,7 +236,10 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]/up
let moveUp idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let moveUp idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
@@ -219,7 +250,10 @@ module RedirectRules =
}
// POST /admin/settings/redirect-rules/[index]/down
let moveDown idx : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let moveDown idx : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx
else
@@ -230,7 +264,9 @@ module RedirectRules =
}
// DELETE /admin/settings/redirect-rules/[index]
let delete idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete idx : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
@@ -245,13 +281,17 @@ module RedirectRules =
module TagMapping =
// GET /admin/settings/tag-mappings
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
}
// GET /admin/settings/tag-mapping/{id}/edit
let edit tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit tagMapId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
@@ -265,7 +305,10 @@ module TagMapping =
}
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap =
@@ -280,7 +323,9 @@ module TagMapping =
}
// DELETE /admin/settings/tag-mapping/{id}
let delete tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete 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" }
@@ -298,7 +343,9 @@ module Theme =
open MyWebLog.Data
// GET /admin/theme/list
let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let all : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
@@ -306,8 +353,9 @@ module Theme =
}
// GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
let add : HttpHandler =
requireAccess Administrator
>=> fun next ctx -> adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
@@ -383,7 +431,10 @@ module Theme =
}
// POST /admin/theme/new
let save : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files
match deriveIdFromFileName themeFile.FileName with
@@ -424,7 +475,10 @@ module Theme =
}
// POST /admin/theme/{id}/delete
let delete themeId : HttpHandler = requireAccess Administrator >=> validateCsrf >=> fun next ctx -> task {
let delete themeId : HttpHandler =
requireAccess Administrator
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match themeId with
| "admin" | "default" ->
@@ -452,7 +506,9 @@ module WebLog =
open System.IO
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let settings : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id
let pages =
@@ -463,12 +519,19 @@ module WebLog =
let uploads = [ Database; Disk ]
return!
Views.WebLog.webLogSettings
(SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
(SettingsModel.FromWebLog ctx.WebLog)
themes
pages
uploads
(EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> adminPage "Web Log Settings" next ctx
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let saveSettings : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
src/MyWebLog/Handlers/Feed.fs
+15 -5
View File
@@ -416,7 +416,10 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back
// ~~ FEED ADMINISTRATION ~~
// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let saveSettings : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel>()
match! data.WebLog.FindById ctx.WebLog.Id with
@@ -430,7 +433,9 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=>
}
// GET /admin/settings/rss/{id}/edit
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let editCustomFeed feedId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
@@ -457,7 +462,10 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| None -> Error.notFound next ctx
// POST /admin/settings/rss/save
let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let saveCustomFeed : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
@@ -468,7 +476,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string 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 feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> feed.Id))
let webLog = { webLog with Rss.CustomFeeds = feeds }
do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog
@@ -481,7 +489,9 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=
}
// DELETE /admin/settings/rss/{id}
let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let deleteCustomFeed feedId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog ->
src/MyWebLog/Handlers/Page.fs
+36 -11
View File
@@ -7,7 +7,9 @@ open MyWebLog.ViewModels
// GET /admin/pages
// GET /admin/pages/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let all pageNbr : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
let displayPages =
pages
@@ -21,7 +23,9 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// GET /admin/page/{id}/edit
let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let edit pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let! result = task {
match pgId with
| "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
@@ -40,7 +44,9 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// DELETE /admin/page/{id}
let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete pgId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true ->
do! PageListCache.update ctx
@@ -50,7 +56,9 @@ let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
}
// GET /admin/page/{id}/permalinks
let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let editPermalinks pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
@@ -62,7 +70,10 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
}
// POST /admin/page/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let savePermalinks : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
@@ -78,7 +89,9 @@ let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun
}
// GET /admin/page/{id}/revisions
let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let editRevisions pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
@@ -90,7 +103,9 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
}
// DELETE /admin/page/{id}/revisions
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let purgeRevisions pgId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg ->
@@ -112,7 +127,9 @@ let private findPageRevision pgId revDate (ctx: HttpContext) = task {
}
// GET /admin/page/{id}/revision/{revision-date}/preview
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let previewRevision (pgId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
@@ -121,7 +138,10 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
}
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let restoreRevision (pgId, revDate) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
@@ -136,7 +156,9 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> val
}
// DELETE /admin/page/{id}/revision/{revision-date}
let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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) }
@@ -148,7 +170,10 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
}
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data
let now = Noda.now ()
src/MyWebLog/Handlers/Post.fs
+50 -19
View File
@@ -97,6 +97,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
open Giraffe
// GET /page/{pageNbr}[/]
// (also served with pageNbr = 1 when default page is recent posts)
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then
return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
@@ -117,10 +118,6 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|> themedView "index" next ctx
}
// GET /page/{pageNbr}/
let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx ->
redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
// GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
@@ -255,7 +252,9 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
@@ -263,7 +262,9 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let edit postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
@@ -289,7 +290,9 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// DELETE /admin/post/{id}
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
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" }
@@ -298,7 +301,9 @@ let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
}
// GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let editPermalinks postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
@@ -310,7 +315,10 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let savePermalinks : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
@@ -326,7 +334,9 @@ let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun
}
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let editRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
@@ -338,7 +348,9 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
}
// DELETE /admin/post/{id}/revisions
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let purgeRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
@@ -361,7 +373,9 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let previewRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
return! adminBarePage "" next ctx (commonPreview rev)
@@ -370,7 +384,10 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let restoreRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
@@ -385,7 +402,9 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> v
}
// DELETE /admin/post/{id}/revision/{revision-date}
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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) }
@@ -397,7 +416,9 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
}
// GET /admin/post/{id}/chapters
let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let manageChapters postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
@@ -410,7 +431,9 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx
}
// GET /admin/post/{id}/chapter/{idx}
let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let editChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
@@ -431,7 +454,10 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
}
// POST /admin/post/{id}/chapter/{idx}
let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let saveChapter (postId, index) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
@@ -461,7 +487,9 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validat
}
// DELETE /admin/post/{id}/chapter/{idx}
let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let deleteChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
@@ -483,7 +511,10 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
src/MyWebLog/Handlers/Upload.fs
+18 -7
View File
@@ -90,7 +90,9 @@ open MyWebLog.ViewModels
let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant()
// GET /admin/uploads
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let list : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads =
@@ -124,11 +126,15 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
adminPage "Upload a File" next ctx Views.WebLog.uploadNew
let showNew : HttpHandler =
requireAccess Author
>=> fun next ctx -> adminPage "Upload a File" next ctx Views.WebLog.uploadNew
// POST /admin/upload/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
@@ -156,14 +162,17 @@ let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx
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! redirectToGet "admin/uploads" next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
// DELETE /admin/upload/{id}
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let deleteFromDb upId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
@@ -183,7 +192,9 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
else finished <- true
// DELETE /admin/upload/disk/{**path}
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let deleteFromDisk urlParts : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then
src/MyWebLog/Handlers/User.fs
+25 -10
View File
@@ -43,7 +43,9 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
let doLogOn : HttpHandler =
validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
@@ -74,7 +76,7 @@ let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
return! logOn model.ReturnTo next ctx
}
// GET /user/log-off
// POST /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" }
@@ -89,7 +91,9 @@ open Giraffe.Htmx
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" next ctx (Views.User.userList users)
}
@@ -99,7 +103,9 @@ let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit usrId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
@@ -111,7 +117,9 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
}
// DELETE /admin/settings/user/{id}
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete userId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->
@@ -121,8 +129,7 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ ->
do! addMessage ctx
{ UserMessage.Success with
Message = $"User {user.DisplayName} deleted successfully" }
{ UserMessage.Success with Message = $"User {user.DisplayName} deleted successfully" }
return! all next ctx
| Error msg ->
do! addMessage ctx
@@ -134,7 +141,9 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
}
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let myInfo : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user ->
return!
@@ -144,7 +153,10 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
}
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let saveMyInfo : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel>()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
@@ -172,7 +184,10 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun nex
#nowarn "3511"
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next ctx -> task {
let save : HttpHandler =
requireAccess WebLogAdmin
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel>()
let data = ctx.Data
let tryUser =