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 = module Dashboard =
// GET /admin/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 getCount (f: WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data let data = ctx.Data
let! posts = getCount (data.Post.CountByStatus Published) let! posts = getCount (data.Post.CountByStatus Published)
@@ -32,7 +34,9 @@ module Dashboard =
} }
// GET /admin/administration // 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() let! themes = ctx.Data.Theme.All()
return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes) return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
} }
@@ -45,7 +49,10 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
module Cache = module Cache =
// POST /admin/cache/web-log/{id}/refresh // 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 let data = ctx.Data
if webLogId = "all" then if webLogId = "all" then
do! WebLogCache.fill data do! WebLogCache.fill data
@@ -61,14 +68,18 @@ module Cache =
do! PageListCache.refresh webLog data do! PageListCache.refresh webLog data
do! CategoryCache.refresh webLog.Id data do! CategoryCache.refresh webLog.Id data
do! addMessage ctx 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 -> | None ->
do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" } do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
return! toAdminDashboard next ctx return! toAdminDashboard next ctx
} }
// POST /admin/cache/theme/{id}/refresh // 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 let data = ctx.Data
if themeId = "all" then if themeId = "all" then
Template.Cache.empty () Template.Cache.empty ()
@@ -96,13 +107,17 @@ module Category =
open MyWebLog.Data open MyWebLog.Data
// GET /admin/categories // GET /admin/categories
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let all : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx ->
let response = fun next ctx -> let response = fun next ctx ->
adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new")) adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx (withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
// GET /admin/category/{id}/edit // 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 { let! result = task {
match catId with match catId with
| "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" }) | "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
@@ -120,7 +135,10 @@ module Category =
} }
// POST /admin/category/save // 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 data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel>() let! model = ctx.BindFormAsync<EditCategoryModel>()
let category = let category =
@@ -142,7 +160,9 @@ module Category =
} }
// DELETE /admin/category/{id} // 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 let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
match result with match result with
| CategoryDeleted | CategoryDeleted
@@ -153,7 +173,8 @@ module Category =
| ReassignedChildCategories -> | ReassignedChildCategories ->
Some "<em>(Its child categories were reassigned to its parent category)</em>" Some "<em>(Its child categories were reassigned to its parent category)</em>"
| _ -> None | _ -> 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 -> | CategoryNotFound ->
do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" } do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
return! all next ctx return! all next ctx
@@ -166,11 +187,15 @@ module RedirectRules =
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
// GET /admin/settings/redirect-rules // 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) adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index] // 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 = let titleAndView =
if idx = -1 then if idx = -1 then
Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty)) Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
@@ -179,8 +204,8 @@ module RedirectRules =
if rules.Length < idx || idx < 0 then if rules.Length < idx || idx < 0 then
None None
else else
Some Some ("Edit",
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))) Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules)))
match titleAndView with match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view | Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
| None -> Error.notFound next ctx | None -> Error.notFound next ctx
@@ -193,7 +218,10 @@ module RedirectRules =
} }
// POST /admin/settings/redirect-rules/[index] // 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! model = ctx.BindFormAsync<EditRedirectRuleModel>()
let rule = model.ToRule() let rule = model.ToRule()
let rules = let rules =
@@ -208,7 +236,10 @@ module RedirectRules =
} }
// POST /admin/settings/redirect-rules/[index]/up // 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 if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx return! Error.notFound next ctx
else else
@@ -219,7 +250,10 @@ module RedirectRules =
} }
// POST /admin/settings/redirect-rules/[index]/down // 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 if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx return! Error.notFound next ctx
else else
@@ -230,7 +264,9 @@ module RedirectRules =
} }
// DELETE /admin/settings/redirect-rules/[index] // 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 if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx return! Error.notFound next ctx
else else
@@ -245,13 +281,17 @@ module RedirectRules =
module TagMapping = module TagMapping =
// GET /admin/settings/tag-mappings // 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 let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings) return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
} }
// GET /admin/settings/tag-mapping/{id}/edit // 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 isNew = tagMapId = "new"
let tagMap = let tagMap =
if isNew then someTask { TagMap.Empty with Id = TagMapId "new" } if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
@@ -265,7 +305,10 @@ module TagMapping =
} }
// POST /admin/settings/tag-mapping/save // 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 data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel>() let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap = let tagMap =
@@ -280,7 +323,9 @@ module TagMapping =
} }
// DELETE /admin/settings/tag-mapping/{id} // 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 match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Tag mapping deleted successfully" } | 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" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Tag mapping not found; nothing deleted" }
@@ -298,7 +343,9 @@ module Theme =
open MyWebLog.Data open MyWebLog.Data
// GET /admin/theme/list // 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 () let! themes = ctx.Data.Theme.All ()
return! return!
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes) Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
@@ -306,8 +353,9 @@ module Theme =
} }
// GET /admin/theme/new // GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx -> let add : HttpHandler =
adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload 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 /// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask { let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
@@ -383,7 +431,10 @@ module Theme =
} }
// POST /admin/theme/new // 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 if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let themeFile = Seq.head ctx.Request.Form.Files let themeFile = Seq.head ctx.Request.Form.Files
match deriveIdFromFileName themeFile.FileName with match deriveIdFromFileName themeFile.FileName with
@@ -424,7 +475,10 @@ module Theme =
} }
// POST /admin/theme/{id}/delete // 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 let data = ctx.Data
match themeId with match themeId with
| "admin" | "default" -> | "admin" | "default" ->
@@ -452,7 +506,9 @@ module WebLog =
open System.IO open System.IO
// GET /admin/settings // 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 data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id let! allPages = data.Page.All ctx.WebLog.Id
let pages = let pages =
@@ -463,12 +519,19 @@ module WebLog =
let uploads = [ Database; Disk ] let uploads = [ Database; Disk ]
return! return!
Views.WebLog.webLogSettings 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 |> adminPage "Web Log Settings" next ctx
} }
// POST /admin/settings // 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 data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel>() let! model = ctx.BindFormAsync<SettingsModel>()
match! data.WebLog.FindById ctx.WebLog.Id with match! data.WebLog.FindById ctx.WebLog.Id with
src/MyWebLog/Handlers/Feed.fs
+18 -8
View File
@@ -416,7 +416,10 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back
// ~~ FEED ADMINISTRATION ~~ // ~~ FEED ADMINISTRATION ~~
// POST /admin/settings/rss // 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 data = ctx.Data
let! model = ctx.BindFormAsync<EditRssModel>() let! model = ctx.BindFormAsync<EditRssModel>()
match! data.WebLog.FindById ctx.WebLog.Id with match! data.WebLog.FindById ctx.WebLog.Id with
@@ -427,10 +430,12 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=>
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-settings" next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /admin/settings/rss/{id}/edit // 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 = let customFeed =
match feedId with match feedId with
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" } | "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 | None -> Error.notFound next ctx
// POST /admin/settings/rss/save // 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 let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
@@ -468,7 +476,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id) | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with match theFeed with
| Some feed -> | 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 } let webLog = { webLog with Rss.CustomFeeds = feeds }
do! data.WebLog.UpdateRssOptions webLog do! data.WebLog.UpdateRssOptions webLog
WebLogCache.set webLog WebLogCache.set webLog
@@ -478,10 +486,12 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/settings/rss/{id} // 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 let data = ctx.Data
match! data.WebLog.FindById ctx.WebLog.Id with match! data.WebLog.FindById ctx.WebLog.Id with
| Some webLog -> | Some webLog ->
@@ -499,4 +509,4 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne
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-settings" next ctx return! redirectToGet "admin/settings#rss-settings" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
src/MyWebLog/Handlers/Page.fs
+47 -22
View File
@@ -7,7 +7,9 @@ open MyWebLog.ViewModels
// GET /admin/pages // GET /admin/pages
// GET /admin/pages/page/{pageNbr} // 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! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
let displayPages = let displayPages =
pages pages
@@ -18,10 +20,12 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! return!
Views.Page.pageList displayPages pageNbr (pages.Length > 25) Views.Page.pageList displayPages pageNbr (pages.Length > 25)
|> adminPage "Pages" next ctx |> adminPage "Pages" next ctx
} }
// GET /admin/page/{id}/edit // 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 { let! result = task {
match pgId with match pgId with
| "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId }) | "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
@@ -37,20 +41,24 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! adminPage title next ctx (Views.Page.pageEdit model templates) return! adminPage title next ctx (Views.Page.pageEdit model templates)
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/page/{id} // 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 match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
| true -> | true ->
do! PageListCache.update ctx do! PageListCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
return! all 1 next ctx return! all 1 next ctx
} }
// GET /admin/page/{id}/permalinks // 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 match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx -> | Some pg when canEdit pg.AuthorId ctx ->
return! return!
@@ -59,10 +67,13 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
|> adminPage "Manage Prior Permalinks" next ctx |> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/page/permalinks // 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! model = ctx.BindFormAsync<ManagePermalinksModel>()
let pageId = PageId model.Id let pageId = PageId model.Id
match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
@@ -75,10 +86,12 @@ let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /admin/page/{id}/revisions // 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 match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx -> | Some pg when canEdit pg.AuthorId ctx ->
return! return!
@@ -87,10 +100,12 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
|> adminPage "Manage Page Revisions" next ctx |> adminPage "Manage Page Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/page/{id}/revisions // 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 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 -> | Some pg ->
@@ -98,7 +113,7 @@ let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" } do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions pgId next ctx return! editRevisions pgId next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
@@ -112,16 +127,21 @@ let private findPageRevision pgId revDate (ctx: HttpContext) = task {
} }
// GET /admin/page/{id}/revision/{revision-date}/preview // 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 match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev) return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx | None, _ | _, None -> return! Error.notFound next ctx
} }
// POST /admin/page/{id}/revision/{revision-date}/restore // 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 match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update do! ctx.Data.Page.Update
@@ -133,10 +153,12 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> val
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
} }
// DELETE /admin/page/{id}/revision/{revision-date} // 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 match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx -> | Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
@@ -145,10 +167,13 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
} }
// POST /admin/page/save // 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! model = ctx.BindFormAsync<EditPageModel>()
let data = ctx.Data let data = ctx.Data
let now = Noda.now () let now = Noda.now ()
@@ -171,4 +196,4 @@ let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
src/MyWebLog/Handlers/Post.fs
+65 -34
View File
@@ -97,6 +97,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
open Giraffe open Giraffe
// GET /page/{pageNbr}[/] // GET /page/{pageNbr}[/]
// (also served with pageNbr = 1 when default page is recent posts)
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then
return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx 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 |> 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}/
// GET /category/{slug}/page/{pageNbr} // GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task { let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
@@ -255,15 +252,19 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
// GET /admin/posts // GET /admin/posts
// GET /admin/posts/page/{pageNbr} // 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 data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25 let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts) return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
} }
// GET /admin/post/{id}/edit // 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 data = ctx.Data
let! result = task { let! result = task {
match postId with match postId with
@@ -286,19 +287,23 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! adminPage title next ctx (Post.postEdit model templates ratings) return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/post/{id} // 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 match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" } | true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
//return! redirectToGet "admin/posts" next ctx //return! redirectToGet "admin/posts" next ctx
return! all 1 next ctx return! all 1 next ctx
} }
// GET /admin/post/{id}/permalinks // 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 match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
@@ -307,10 +312,13 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
|> adminPage "Manage Prior Permalinks" next ctx |> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/post/permalinks // 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! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
@@ -323,10 +331,12 @@ let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /admin/post/{id}/revisions // 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 match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
return! return!
@@ -335,10 +345,12 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
|> adminPage "Manage Post Revisions" next ctx |> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/post/{id}/revisions // 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 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 -> | Some post when canEdit post.AuthorId ctx ->
@@ -347,7 +359,7 @@ let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx
return! editRevisions postId next ctx return! editRevisions postId next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
@@ -361,16 +373,21 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
} }
// GET /admin/post/{id}/revision/{revision-date}/preview // 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 match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
return! adminBarePage "" next ctx (commonPreview rev) return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx | None, _ | _, None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/revision/{revision-date}/restore // 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 match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update do! ctx.Data.Post.Update
@@ -382,10 +399,12 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> v
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
} }
// DELETE /admin/post/{id}/revision/{revision-date} // 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 match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx -> | Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
@@ -394,10 +413,12 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
| Some _, Some _ -> return! Error.notAuthorized next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | None, _
| _, None -> return! Error.notFound next ctx | _, None -> return! Error.notFound next ctx
} }
// GET /admin/post/{id}/chapters // 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 match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post | Some post
when Option.isSome post.Episode when Option.isSome post.Episode
@@ -407,10 +428,12 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx
Post.chapters false (ManageChaptersModel.Create post) Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" next ctx |> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
// GET /admin/post/{id}/chapter/{idx} // 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 match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post | Some post
when Option.isSome post.Episode when Option.isSome post.Episode
@@ -428,10 +451,13 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx |> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
// POST /admin/post/{id}/chapter/{idx} // 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 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 | Some post
@@ -458,10 +484,12 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validat
| ex -> return! Error.server ex.Message next ctx | ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
// DELETE /admin/post/{id}/chapter/{idx} // 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 let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post | Some post
@@ -480,10 +508,13 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
|> adminPage "Manage Chapters" next ctx |> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx
} }
// POST /admin/post/save // 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! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data let data = ctx.Data
let tryPost = let tryPost =
@@ -522,4 +553,4 @@ let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
src/MyWebLog/Handlers/Upload.fs
+22 -11
View File
@@ -90,7 +90,9 @@ open MyWebLog.ViewModels
let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant() let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant()
// GET /admin/uploads // 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 webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
let diskUploads = let diskUploads =
@@ -121,14 +123,18 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path) |> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|> Views.WebLog.uploadList |> Views.WebLog.uploadList
|> adminPage "Uploaded Files" next ctx |> adminPage "Uploaded Files" next ctx
} }
// GET /admin/upload/new // GET /admin/upload/new
let showNew : HttpHandler = requireAccess Author >=> fun next ctx -> let showNew : HttpHandler =
adminPage "Upload a File" next ctx Views.WebLog.uploadNew requireAccess Author
>=> fun next ctx -> adminPage "Upload a File" next ctx Views.WebLog.uploadNew
// POST /admin/upload/save // 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 if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName), let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
@@ -156,20 +162,23 @@ let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create) use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream 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 return! redirectToGet "admin/uploads" next ctx
else else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
} }
// DELETE /admin/upload/{id} // 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 match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
| Ok fileName -> | Ok fileName ->
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
return! list next ctx return! list next ctx
| Error _ -> return! Error.notFound next ctx | Error _ -> return! Error.notFound next ctx
} }
/// Remove a directory tree if it is empty /// Remove a directory tree if it is empty
let removeEmptyDirectories (webLog: WebLog) (filePath: string) = let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
@@ -183,7 +192,9 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
else finished <- true else finished <- true
// DELETE /admin/upload/disk/{**path} // 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 filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath) let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
if File.Exists path then if File.Exists path then
@@ -192,4 +203,4 @@ let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun ne
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" } do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
return! list next ctx return! list next ctx
else return! Error.notFound next ctx else return! Error.notFound next ctx
} }
src/MyWebLog/Handlers/User.fs
+32 -17
View File
@@ -43,7 +43,9 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on // 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! model = ctx.BindFormAsync<LogOnModel>()
let data = ctx.Data let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
@@ -72,9 +74,9 @@ let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
| Error msg -> | Error msg ->
do! addMessage ctx { UserMessage.Error with Message = msg } do! addMessage ctx { UserMessage.Error with Message = msg }
return! logOn model.ReturnTo next ctx return! logOn model.ReturnTo next ctx
} }
// GET /user/log-off // POST /user/log-off
let logOff : HttpHandler = fun next ctx -> task { let logOff : HttpHandler = fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme 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" }
@@ -89,17 +91,21 @@ open Giraffe.Htmx
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?" let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users // 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 let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" next ctx (Views.User.userList users) return! adminBarePage "User Administration" next ctx (Views.User.userList users)
} }
/// Show the edit user page /// Show the edit user page
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx -> 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) adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
// GET /admin/settings/user/{id}/edit // 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 isNew = usrId = "new"
let userId = WebLogUserId usrId let userId = WebLogUserId usrId
let tryUser = let tryUser =
@@ -108,10 +114,12 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
match! tryUser with match! tryUser with
| Some user -> return! showEdit (EditUserModel.FromUser user) next ctx | Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE /admin/settings/user/{id} // 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 let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user -> | Some user ->
@@ -121,8 +129,7 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
match! data.WebLogUser.Delete user.Id user.WebLogId with match! data.WebLogUser.Delete user.Id user.WebLogId with
| Ok _ -> | Ok _ ->
do! addMessage ctx do! addMessage ctx
{ UserMessage.Success with { UserMessage.Success with Message = $"User {user.DisplayName} deleted successfully" }
Message = $"User {user.DisplayName} deleted successfully" }
return! all next ctx return! all next ctx
| Error msg -> | Error msg ->
do! addMessage ctx do! addMessage ctx
@@ -131,20 +138,25 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
Detail = Some msg } Detail = Some msg }
return! all next ctx return! all next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /admin/my-info // 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 match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> | Some user ->
return! return!
Views.User.myInfo (EditMyInfoModel.FromUser user) user Views.User.myInfo (EditMyInfoModel.FromUser user) user
|> adminPage "Edit Your Information" next ctx |> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// POST /admin/my-info // 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! model = ctx.BindFormAsync<EditMyInfoModel>()
let data = ctx.Data let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
@@ -166,13 +178,16 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> validateCsrf >=> fun nex
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|> adminPage "Edit Your Information" next ctx |> adminPage "Edit Your Information" next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// User save is not statically compilable; not sure why, but we'll revisit it at some point // User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511" #nowarn "3511"
// POST /admin/settings/user/save // 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! model = ctx.BindFormAsync<EditUserModel>()
let data = ctx.Data let data = ctx.Data
let tryUser = let tryUser =
@@ -203,4 +218,4 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> validateCsrf >=> fun next
(withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" }) (withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
next ctx next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }