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

WIP on ?chapters handler for posts (#6)

Browse Source 
- Do not show drafts if users are not logged on
- Migrate user management to Giraffe View Engine templates
This commit is contained in:
Daniel J. Summers
2024-03-10 21:07:30 -04:00
parent 641a7499cc
commit 81039579ea
11 changed files with 316 additions and 330 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -531,48 +531,43 @@ module WebLog =
// GET /admin/settings
let settings : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! TemplateCache.get adminTheme "user-list-body" data with
| Ok userTemplate ->
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All()
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let! hash =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.FromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(string p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create(string it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.FromFeed (CategoryCache.get ctx))
|> Array.ofList)
|> addViewContext ctx
let! hash' = TagMapping.withTagMappings ctx hash
return!
addToHash "user_list" (userTemplate.Render hash') hash'
|> addToHash "tag_mapping_list" (tagMapTemplate.Render hash')
|> adminView "settings" next ctx
| Error message -> return! Error.server message next ctx
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All()
let! hash =
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.FromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(string p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create(string it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk")
|]
|> addToHash "rss_model" (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.FromFeed (CategoryCache.get ctx))
|> Array.ofList)
|> addViewContext ctx
let! hash' = TagMapping.withTagMappings ctx hash
return!
hash'
|> addToHash "tag_mapping_list" (tagMapTemplate.Render hash')
|> adminView "settings" next ctx
| Error message -> return! Error.server message next ctx
}

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

@@ -381,7 +381,9 @@ let adminPage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) :
let adminBarePage pageTitle includeCsrf (content: AppViewContext -> XmlNode list) : HttpHandler = fun next ctx -> task {
let! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
return! htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument) next ctx
return!
( messagesToHeaders appCtx.Messages
>=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx
}
/// Validate the anti cross-site request forgery token in the current request

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

@@ -207,6 +207,23 @@ let home : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// GET /{post-permalink}?chapters
let chapters (post: Post) : HttpHandler =
match post.Episode with
| Some ep ->
match ep.Chapters with
| Some chapters ->
json chapters
| None ->
match ep.ChapterFile with
| Some file -> redirectTo true file
| None -> Error.notFound
| None -> Error.notFound
// ~~ ADMINISTRATION ~~
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
@@ -372,7 +389,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
}
// GET /admin/post/{id}/chapters
let chapters 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

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

@@ -29,10 +29,15 @@ module CatchAll =
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
debug (fun () -> "Found post by permalink")
let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data |> await
yield fun next ctx ->
addToHash ViewContext.PageTitle post.Title hash
|> themedView (defaultArg post.Template "single-post") next ctx
if post.Status = Published || Option.isSome ctx.UserAccessLevel then
if ctx.Request.Query.ContainsKey "chapters" then
yield Post.chapters post
else
yield fun next ctx ->
Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data
|> await
|> addToHash ViewContext.PageTitle post.Title
|> themedView (defaultArg post.Template "single-post") next ctx
| None -> ()
// Current page
match data.Page.FindByPermalink permalink webLog.Id |> await with
@@ -130,7 +135,7 @@ let router : HttpHandler = choose [
routef "/%s/revision/%s/preview" Post.previewRevision
routef "/%s/revisions" Post.editRevisions
routef "/%s/chapter/%i" Post.editChapter
routef "/%s/chapters" Post.chapters
routef "/%s/chapters" Post.manageChapters
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
route "" >=> Admin.WebLog.settings
@@ -201,10 +206,7 @@ let router : HttpHandler = choose [
route "/save" >=> Admin.TagMapping.save
routef "/%s/delete" Admin.TagMapping.delete
])
subRoute "/user" (choose [
route "/save" >=> User.save
routef "/%s/delete" User.delete
])
route "/user/save" >=> User.save
])
subRoute "/theme" (choose [
route "/new" >=> Admin.Theme.save
@@ -220,6 +222,9 @@ let router : HttpHandler = choose [
subRoute "/post" (choose [
routef "/%s/chapter/%i" Post.deleteChapter
])
subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
routef "/user/%s" User.delete
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts

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

@@ -5,7 +5,6 @@ open System
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open MyWebLog
open NodaTime
// ~~ LOG ON / LOG OFF ~~
@@ -84,7 +83,6 @@ let logOff : HttpHandler = fun next ctx -> task {
// ~~ ADMINISTRATION ~~
open System.Collections.Generic
open Giraffe.Htmx
/// Got no time for URL/form manipulators...
@@ -98,16 +96,7 @@ let all : HttpHandler = fun next ctx -> task {
/// Show the edit user page
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
hashForPage (if model.IsNew then "Add a New User" else "Edit User")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
KeyValuePair.Create(string Author, "Author")
KeyValuePair.Create(string Editor, "Editor")
KeyValuePair.Create(string WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(string Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true (Views.User.edit model) next ctx
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = fun next ctx -> task {
@@ -121,7 +110,7 @@ let edit usrId : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
// POST /admin/settings/user/{id}/delete
// DELETE /admin/settings/user/{id}
let delete userId : HttpHandler = fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
@@ -144,21 +133,11 @@ let delete userId : HttpHandler = fun next ctx -> task {
| None -> return! Error.notFound next ctx
}
/// Display the user "my info" page, with information possibly filled in
let private showMyInfo (model: EditMyInfoModel) (user: WebLogUser) : HttpHandler = fun next ctx ->
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (ctx.WebLog.LocalTime user.CreatedOn)
|> addToHash "last_seen_on" (ctx.WebLog.LocalTime (defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
// GET /admin/my-info
let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user -> return! showMyInfo (EditMyInfoModel.FromUser user) user next ctx
| Some user ->
return! adminPage "Edit Your Information" true (Views.User.myInfo (EditMyInfoModel.FromUser user) user) next ctx
| None -> return! Error.notFound next ctx
}
@@ -181,7 +160,10 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
return! redirectToGet "admin/my-info" next ctx
| Some user ->
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
return!
adminPage
"Edit Your Information" true
(Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user) next ctx
| None -> return! Error.notFound next ctx
}