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

Rule add/edit/move/delete works (#39)

Browse Source 
- Begin moving auth to route definition where practical
- Fix typo on post list page
This commit is contained in:
Daniel J. Summers
2023-07-30 21:00:31 -04:00
parent 3ef4499a90
commit dc6b066e79
15 changed files with 322 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/MyWebLog/DotLiquidBespoke.fs
View File

@@ -224,15 +224,17 @@ let register () =
Template.RegisterTag<UserLinksTag> "user_links"
[ // Domain types
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>
typeof<RedirectRule>; typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
// View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayRevision>; typeof<DisplayTheme>; typeof<DisplayUpload>; typeof<DisplayUser>
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>
typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>
typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>
typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>
typeof<DisplayPage>; typeof<DisplayRevision>; typeof<DisplayTheme>
typeof<DisplayUpload>; typeof<DisplayUser>; typeof<EditCategoryModel>
typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>
typeof<EditPostModel>; typeof<EditRedirectRuleModel>; typeof<EditRssModel>
typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>
typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>

104
src/MyWebLog/Handlers/Admin.fs
View File

@@ -132,7 +132,7 @@ module Category =
open MyWebLog.Data
// GET /admin/categories
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let all : HttpHandler = fun next ctx -> task {
match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
| Ok catListTemplate ->
let! hash =
@@ -146,14 +146,14 @@ module Category =
}
// GET /admin/categories/bare
let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let bare : HttpHandler = fun next ctx ->
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx
// GET /admin/category/{id}/edit
let edit catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit catId : HttpHandler = fun next ctx -> task {
let! result = task {
match catId with
| "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
@@ -173,7 +173,7 @@ module Category =
}
// POST /admin/category/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let save : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
@@ -196,7 +196,7 @@ module Category =
}
// POST /admin/category/{id}/delete
let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete catId : HttpHandler = fun next ctx -> task {
let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
match result with
| CategoryDeleted
@@ -217,8 +217,10 @@ module Category =
/// ~~~ REDIRECT RULES ~~~
module RedirectRules =
// GET /admin/redirect-rules
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
open Microsoft.AspNetCore.Http
// GET /admin/settings/redirect-rules
let all : HttpHandler = fun next ctx -> task {
return!
hashForPage "Redirect Rules"
|> withAntiCsrf ctx
@@ -226,6 +228,82 @@ module RedirectRules =
|> adminView "redirect-list" next ctx
}
// GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = fun next ctx -> task {
if idx = -1 then
return!
hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.empty)
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
else
let rules = ctx.WebLog.RedirectRules
if rules.Length < idx || idx < 0 then
return! Error.notFound next ctx
else
return!
hashForPage "Edit Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule idx (List.item idx rules))
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
}
/// Update the web log's redirect rules in the database, the request web log, and the web log cache
let private updateRedirectRules (ctx : HttpContext) webLog = backgroundTask {
do! ctx.Data.WebLog.UpdateRedirectRules webLog
ctx.Items["webLog"] <- webLog
WebLogCache.set webLog
}
// POST /admin/settings/redirect-rules/[index]
let save idx : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<EditRedirectRuleModel> ()
let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.empty else List.item idx rules)
let newRules =
match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules
| true -> List.insertAt (rules.Length) rule rules
| false -> rules |> List.removeAt idx |> List.insertAt idx rule
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule saved successfully" }
return! all next ctx
}
// POST /admin/settings/redirect-rules/[index]/up
let moveUp idx : HttpHandler = fun next ctx -> task {
if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx - 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
// POST /admin/settings/redirect-rules/[index]/down
let moveDown idx : HttpHandler = fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
return! Error.notFound next ctx
else
let toMove = List.item idx ctx.WebLog.RedirectRules
let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx + 1) toMove
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
return! all next ctx
}
// POST /admin/settings/redirect-rules/[index]/delete
let delete idx : HttpHandler = fun next ctx -> task {
if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
return! Error.notFound next ctx
else
let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
do! addMessage ctx { UserMessage.success with Message = "Redirect rule deleted successfully" }
return! all next ctx
}
/// ~~~ TAG MAPPINGS ~~~
module TagMapping =
@@ -243,7 +321,7 @@ module TagMapping =
}
// GET /admin/settings/tag-mappings
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let all : HttpHandler = fun next ctx -> task {
let! hash =
hashForPage ""
|> withAntiCsrf ctx
@@ -252,7 +330,7 @@ module TagMapping =
}
// GET /admin/settings/tag-mapping/{id}/edit
let edit tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit tagMapId : HttpHandler = fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
@@ -268,7 +346,7 @@ module TagMapping =
}
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let save : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let tagMap =
@@ -283,7 +361,7 @@ module TagMapping =
}
// POST /admin/settings/tag-mapping/{id}/delete
let delete tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete tagMapId : HttpHandler = 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" }
@@ -460,7 +538,7 @@ module WebLog =
open System.IO
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let settings : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! TemplateCache.get adminTheme "user-list-body" data with
| Ok userTemplate ->
@@ -508,7 +586,7 @@ module WebLog =
}
// POST /admin/settings
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let saveSettings : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<SettingsModel> ()
match! data.WebLog.FindById ctx.WebLog.Id with

31
src/MyWebLog/Handlers/Routes.fs
View File

@@ -107,7 +107,7 @@ let router : HttpHandler = choose [
subRoute "/admin" (requireUser >=> choose [
GET_HEAD >=> choose [
route "/administration" >=> Admin.Dashboard.admin
subRoute "/categor" (choose [
subRoute "/categor" (requireAccess WebLogAdmin >=> choose [
route "ies" >=> Admin.Category.all
route "ies/bare" >=> Admin.Category.bare
routef "y/%s/edit" Admin.Category.edit
@@ -130,20 +130,21 @@ let router : HttpHandler = choose [
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
])
subRoute "/redirect-rules" (choose [
route "" >=> Admin.RedirectRules.all
])
subRoute "/settings" (choose [
route "" >=> Admin.WebLog.settings
routef "/rss/%s/edit" Feed.editCustomFeed
subRoute "/user" (choose [
route "s" >=> User.all
routef "/%s/edit" User.edit
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.settings
routef "/rss/%s/edit" Feed.editCustomFeed
subRoute "/redirect-rules" (choose [
route "" >=> Admin.RedirectRules.all
routef "/%i" Admin.RedirectRules.edit
])
subRoute "/tag-mapping" (choose [
route "s" >=> Admin.TagMapping.all
routef "/%s/edit" Admin.TagMapping.edit
])
subRoute "/user" (choose [
route "s" >=> User.all
routef "/%s/edit" User.edit
])
])
subRoute "/theme" (choose [
route "/list" >=> Admin.Theme.all
@@ -159,7 +160,7 @@ let router : HttpHandler = choose [
routef "/theme/%s/refresh" Admin.Cache.refreshTheme
routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
])
subRoute "/category" (choose [
subRoute "/category" (requireAccess WebLogAdmin >=> choose [
route "/save" >=> Admin.Category.save
routef "/%s/delete" Admin.Category.delete
])
@@ -180,13 +181,19 @@ let router : HttpHandler = choose [
routef "/%s/revision/%s/restore" Post.restoreRevision
routef "/%s/revisions/purge" Post.purgeRevisions
])
subRoute "/settings" (choose [
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.saveSettings
subRoute "/rss" (choose [
route "" >=> Feed.saveSettings
route "/save" >=> Feed.saveCustomFeed
routef "/%s/delete" Feed.deleteCustomFeed
])
subRoute "/redirect-rules" (choose [
routef "/%i" Admin.RedirectRules.save
routef "/%i/up" Admin.RedirectRules.moveUp
routef "/%i/down" Admin.RedirectRules.moveDown
routef "/%i/delete" Admin.RedirectRules.delete
])
subRoute "/tag-mapping" (choose [
route "/save" >=> Admin.TagMapping.save
routef "/%s/delete" Admin.TagMapping.delete

6
src/MyWebLog/Handlers/User.fs
View File

@@ -95,7 +95,7 @@ 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 = fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return!
hashForPage "User Administration"
@@ -119,7 +119,7 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> adminBareView "user-edit" next ctx
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let edit usrId : HttpHandler = fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
let tryUser =
@@ -131,7 +131,7 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
}
// POST /admin/settings/user/{id}/delete
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let delete userId : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
| Some user ->