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

Migrate more templates to GVE

Browse Source
This commit is contained in:
Daniel J. Summers
2024-03-12 22:57:47 -04:00
parent 5f114c7955
commit b99cd5b94b
20 changed files with 387 additions and 417 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -27,45 +27,35 @@ module Dashboard =
ListedPages = listed
Categories = cats
TopLevelCategories = topCats }
return! adminPage "Dashboard" false (Views.Admin.dashboard model) next ctx
return! adminPage "Dashboard" false next ctx (Views.Admin.dashboard model)
}
// GET /admin/administration
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames ()
let! hash =
hashForPage "myWebLog Administration"
|> withAntiCsrf ctx
|> addToHash "themes" (
themes
|> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse)
|> Array.ofList)
|> addToHash "cached_themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> [|
string it.Id
it.Name
cachedTemplates
|> List.filter _.StartsWith(string it.Id)
|> List.length
|> string
|])
|> Array.ofSeq)
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy _.Name
|> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> addViewContext ctx
return!
addToHash "theme_list" (bodyTemplate.Render hash) hash
|> adminView "admin-dashboard" next ctx
| Error message -> return! Error.server message next ctx
let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames ()
return!
hashForPage "myWebLog Administration"
|> withAntiCsrf ctx
|> addToHash "cached_themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> [|
string it.Id
it.Name
cachedTemplates
|> List.filter _.StartsWith(string it.Id)
|> List.length
|> string
|])
|> Array.ofSeq)
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy _.Name
|> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> adminView "admin-dashboard" next ctx
}
/// Redirect the user to the admin dashboard
@@ -215,11 +205,11 @@ module RedirectRules =
// GET /admin/settings/redirect-rules
let all : HttpHandler = fun next ctx ->
adminPage "Redirect Rules" true (Views.Admin.redirectList ctx.WebLog.RedirectRules) next ctx
adminPage "Redirect Rules" true next ctx (Views.Admin.redirectList ctx.WebLog.RedirectRules)
// GET /admin/settings/redirect-rules/[index]
let edit idx : HttpHandler = fun next ctx ->
let titleAndModel =
let titleAndView =
if idx = -1 then
Some ("Add", Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
else
@@ -228,8 +218,8 @@ module RedirectRules =
None
else
Some ("Edit", (Views.Admin.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
match titleAndModel with
| Some (title, model) -> adminBarePage $"{title} Redirect Rule" true model next ctx
match titleAndView with
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" true next ctx view
| None -> Error.notFound next ctx
/// Update the web log's redirect rules in the database, the request web log, and the web log cache
@@ -294,7 +284,7 @@ module TagMapping =
// GET /admin/settings/tag-mappings
let all : HttpHandler = fun next ctx -> task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return! adminBarePage "Tag Mapping List" true (Views.Admin.tagMapList mappings) next ctx
return! adminBarePage "Tag Mapping List" true next ctx (Views.Admin.tagMapList mappings)
}
// GET /admin/settings/tag-mapping/{id}/edit
@@ -306,9 +296,8 @@ module TagMapping =
match! tagMap with
| Some tm ->
return!
adminBarePage
(if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true
(Views.Admin.tagMapEdit (EditTagMapModel.FromMapping tm)) next ctx
Views.Admin.tagMapEdit (EditTagMapModel.FromMapping tm)
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx
| None -> return! Error.notFound next ctx
}
@@ -349,17 +338,13 @@ module Theme =
let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
return!
hashForPage "Themes"
|> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) |> Array.ofList)
|> adminBareView "theme-list-body" next ctx
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
|> adminBarePage "Themes" true next ctx
}
// GET /admin/theme/new
let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
hashForPage "Upload a Theme File"
|> withAntiCsrf ctx
|> adminBareView "theme-upload" next ctx
adminBarePage "Upload a Theme File" true 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 {

16
src/MyWebLog/Handlers/Helpers.fs
View File

@@ -282,8 +282,9 @@ module Error =
let notAuthorized : HttpHandler = fun next ctx ->
if ctx.Request.Method = "GET" then
let redirectUrl = $"user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectToGet redirectUrl) next ctx
else redirectToGet redirectUrl next ctx
(next, ctx)
||> if isHtmx ctx then withHxRedirect redirectUrl >=> withHxRetarget "body" >=> redirectToGet redirectUrl
else redirectToGet redirectUrl
else
if isHtmx ctx then
let messages = [|
@@ -370,7 +371,7 @@ let adminBareView template =
bareForTheme adminTheme template
/// Display a page for an admin endpoint
let adminPage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : HttpHandler = fun next ctx -> task {
let adminPage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
let! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
let layout = if isHtmx ctx then Layout.partial else Layout.full
@@ -378,7 +379,7 @@ let adminPage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) :
}
/// Display a bare page for an admin endpoint
let adminBarePage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : HttpHandler = fun next ctx -> task {
let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
let! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
return!
@@ -471,13 +472,12 @@ let getCategoryIds slug ctx =
|> Seq.map (fun c -> CategoryId c.Id)
|> List.ofSeq
open System
open System.Globalization
open NodaTime
/// Parse a date/time to UTC
let parseToUtc (date: string) =
Instant.FromDateTimeUtc(DateTime.Parse(date, null, DateTimeStyles.AdjustToUniversal))
let parseToUtc (date: string) : Instant =
let result = roundTrip.Parse date
if result.Success then result.Value else raise result.Exception
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging

18
src/MyWebLog/Handlers/Page.fs
View File

@@ -66,10 +66,9 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.FromPage pg)
|> adminView "permalinks" next ctx
ManagePermalinksModel.FromPage pg
|> Views.Helpers.managePermalinks
|> adminPage "Manage Prior Permalinks" true next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@@ -95,15 +94,14 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
| Some pg when canEdit pg.AuthorId ctx ->
return!
hashForPage "Manage Page Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.FromPage ctx.WebLog pg)
|> adminView "revisions" next ctx
ManageRevisionsModel.FromPage pg
|> Views.Helpers.manageRevisions
|> adminPage "Manage Page Revisions" true next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/page/{id}/revisions/purge
// DELETE /admin/page/{id}/revisions
let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
@@ -158,7 +156,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| _, None -> return! Error.notFound next ctx
}
// POST /admin/page/{id}/revision/{revision-date}/delete
// DELETE /admin/page/{id}/revision/{revision-date}
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 ->

38
src/MyWebLog/Handlers/Post.fs
View File

@@ -254,7 +254,7 @@ 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! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" true (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay)) next ctx
return! adminPage "Posts" true next ctx (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay))
}
// GET /admin/post/{id}/edit
@@ -305,10 +305,9 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
hashForPage "Manage Prior Permalinks"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManagePermalinksModel.FromPost post)
|> adminView "permalinks" next ctx
ManagePermalinksModel.FromPost post
|> Views.Helpers.managePermalinks
|> adminPage "Manage Prior Permalinks" true next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
@@ -334,15 +333,14 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
hashForPage "Manage Post Revisions"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageRevisionsModel.FromPost ctx.WebLog post)
|> adminView "revisions" next ctx
ManageRevisionsModel.FromPost post
|> Views.Helpers.manageRevisions
|> adminPage "Manage Post Revisions" true next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions/purge
// DELETE /admin/post/{id}/revisions
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
@@ -398,7 +396,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
| _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/delete
// DELETE /admin/post/{id}/revision/{revision-date}
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 ->
@@ -418,7 +416,8 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
adminPage "Manage Chapters" true (Views.Post.chapters false (ManageChaptersModel.Create post)) next ctx
Views.Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" true next ctx
| Some _ | None -> return! Error.notFound next ctx
}
@@ -437,9 +436,8 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
match chapter with
| Some chap ->
return!
adminBarePage
(if index = -1 then "Add a Chapter" else "Edit Chapter") true
(Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)) next ctx
Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
@@ -466,9 +464,8 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
adminPage
"Manage Chapters" true
(Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)) next ctx
Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" true next ctx
with
| ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx
@@ -491,9 +488,8 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return!
adminPage
"Manage Chapters" true (Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)) next
ctx
Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" true next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}

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

@@ -176,17 +176,13 @@ let router : HttpHandler = choose [
route "/save" >=> Page.save
route "/permalinks" >=> Page.savePermalinks
routef "/%s/delete" Page.delete
routef "/%s/revision/%s/delete" Page.deleteRevision
routef "/%s/revision/%s/restore" Page.restoreRevision
routef "/%s/revisions/purge" Page.purgeRevisions
])
subRoute "/post" (choose [
route "/save" >=> Post.save
route "/permalinks" >=> Post.savePermalinks
routef "/%s/chapter/%i" Post.saveChapter
routef "/%s/revision/%s/delete" Post.deleteRevision
routef "/%s/revision/%s/restore" Post.restoreRevision
routef "/%s/revisions/purge" Post.purgeRevisions
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.saveSettings
@@ -214,9 +210,15 @@ let router : HttpHandler = choose [
])
]
DELETE >=> validateCsrf >=> choose [
subRoute "/page" (choose [
routef "/%s/revision/%s" Page.deleteRevision
routef "/%s/revisions" Page.purgeRevisions
])
subRoute "/post" (choose [
routef "/%s" Post.delete
routef "/%s/chapter/%i" Post.deleteChapter
routef "/%s" Post.delete
routef "/%s/chapter/%i" Post.deleteChapter
routef "/%s/revision/%s" Post.deleteRevision
routef "/%s/revisions" Post.purgeRevisions
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
routef "/user/%s" User.delete

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

@@ -35,7 +35,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
match returnUrl with
| Some _ -> returnUrl
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
adminPage "Log On" true (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo }) next ctx
adminPage "Log On" true next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo })
open System.Security.Claims
@@ -91,12 +91,12 @@ let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = fun next ctx -> task {
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
return! adminBarePage "User Administration" true (Views.User.userList users) next ctx
return! adminBarePage "User Administration" true next ctx (Views.User.userList users)
}
/// Show the edit user page
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true (Views.User.edit model) next ctx
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true next ctx (Views.User.edit model)
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = fun next ctx -> task {
@@ -137,7 +137,9 @@ let delete userId : HttpHandler = 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! adminPage "Edit Your Information" true (Views.User.myInfo (EditMyInfoModel.FromUser user) user) next ctx
return!
Views.User.myInfo (EditMyInfoModel.FromUser user) user
|> adminPage "Edit Your Information" true next ctx
| None -> return! Error.notFound next ctx
}
@@ -161,9 +163,8 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some user ->
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return!
adminPage
"Edit Your Information" true
(Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user) next ctx
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|> adminPage "Edit Your Information" true next ctx
| None -> return! Error.notFound next ctx
}