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

WIP on chapter flow (#6)

Browse Source 
- WIP with Giraffe View Engine for admin views
- Added app context to DotLiquid hash; will remove individual fields in v3
This commit is contained in:
Daniel J. Summers
2024-03-09 22:58:55 -05:00
parent 6a5285ca54
commit 43a700eead
15 changed files with 698 additions and 312 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -20,17 +20,14 @@ module Dashboard =
let! listed = getCount data.Page.CountListed
let! cats = getCount data.Category.CountAll
let! topCats = getCount data.Category.CountTopLevel
return!
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats
}
|> adminView "dashboard" next ctx
let model =
{ Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats }
return! adminPage "Dashboard" false (AdminViews.Admin.dashboard model) next ctx
}
// GET /admin/administration

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

@@ -3,6 +3,8 @@ module private MyWebLog.Handlers.Helpers
open System.Text.Json
open Microsoft.AspNetCore.Http
open MyWebLog.AdminViews
open MyWebLog.AdminViews.Helpers
/// Session extensions to get and set objects
type ISession with
@@ -25,6 +27,10 @@ module ViewContext =
[<Literal>]
let AntiCsrfTokens = "csrf"
/// The unified application view context
[<Literal>]
let AppViewContext = "app"
/// The categories for this web log
[<Literal>]
let Categories = "categories"
@@ -185,32 +191,62 @@ open Giraffe.ViewEngine
/// htmx script tag
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
/// Populate the DotLiquid hash with standard information
let addViewContext ctx (hash: Hash) = task {
/// Get the current user messages, and commit the session so that they are preserved
let private getCurrentMessages ctx = task {
let! messages = messages ctx
do! commitSession ctx
return
if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
// We have already populated everything; just update messages
hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage array; messages ]
return messages
}
/// Generate the view context for a response
let private generateViewContext pageTitle messages includeCsrf (ctx: HttpContext) =
{ WebLog = ctx.WebLog
UserId = ctx.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|> Option.map (fun claim -> WebLogUserId claim.Value)
PageTitle = pageTitle
Csrf = if includeCsrf then Some ctx.CsrfTokenSet else None
PageList = PageListCache.get ctx
Categories = CategoryCache.get ctx
CurrentPage = ctx.Request.Path.Value[1..]
Messages = messages
Generator = ctx.Generator
HtmxScript = htmxScript
IsAuthor = ctx.HasAccessLevel Author
IsEditor = ctx.HasAccessLevel Editor
IsWebLogAdmin = ctx.HasAccessLevel WebLogAdmin
IsAdministrator = ctx.HasAccessLevel Administrator }
/// Populate the DotLiquid hash with standard information
let addViewContext ctx (hash: Hash) = task {
let! messages = getCurrentMessages ctx
if hash.ContainsKey ViewContext.AppViewContext then
let oldApp = hash[ViewContext.AppViewContext] :?> AppViewContext
let newApp = { oldApp with Messages = Array.concat [ oldApp.Messages; messages ] }
return
hash
else
ctx.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|> Option.map (fun claim -> addToHash ViewContext.UserId claim.Value hash)
|> Option.defaultValue hash
|> addToHash ViewContext.WebLog ctx.WebLog
|> addToHash ViewContext.PageList (PageListCache.get ctx)
|> addToHash ViewContext.Categories (CategoryCache.get ctx)
|> addToHash ViewContext.CurrentPage ctx.Request.Path.Value[1..]
|> addToHash ViewContext.Messages messages
|> addToHash ViewContext.Generator ctx.Generator
|> addToHash ViewContext.HtmxScript htmxScript
|> addToHash ViewContext.IsLoggedOn ctx.User.Identity.IsAuthenticated
|> addToHash ViewContext.IsAuthor (ctx.HasAccessLevel Author)
|> addToHash ViewContext.IsEditor (ctx.HasAccessLevel Editor)
|> addToHash ViewContext.IsWebLogAdmin (ctx.HasAccessLevel WebLogAdmin)
|> addToHash ViewContext.IsAdministrator (ctx.HasAccessLevel Administrator)
|> addToHash ViewContext.AppViewContext newApp
|> addToHash ViewContext.Messages newApp.Messages
else
let app =
generateViewContext (string hash[ViewContext.PageTitle]) messages
(hash.ContainsKey ViewContext.AntiCsrfTokens) ctx
return
hash
|> addToHash ViewContext.UserId (app.UserId |> Option.map string |> Option.defaultValue "")
|> addToHash ViewContext.WebLog app.WebLog
|> addToHash ViewContext.PageList app.PageList
|> addToHash ViewContext.Categories app.Categories
|> addToHash ViewContext.CurrentPage app.CurrentPage
|> addToHash ViewContext.Messages app.Messages
|> addToHash ViewContext.Generator app.Generator
|> addToHash ViewContext.HtmxScript app.HtmxScript
|> addToHash ViewContext.IsLoggedOn app.IsLoggedOn
|> addToHash ViewContext.IsAuthor app.IsAuthor
|> addToHash ViewContext.IsEditor app.IsEditor
|> addToHash ViewContext.IsWebLogAdmin app.IsWebLogAdmin
|> addToHash ViewContext.IsAdministrator app.IsAdministrator
}
/// Is the request from htmx?
@@ -258,7 +294,7 @@ module Error =
(messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
/// Handle 404s
let notFound : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
@@ -334,6 +370,21 @@ let adminView template =
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! messages = getCurrentMessages ctx
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
let layout = if isHtmx ctx then Layout.partial else Layout.full
return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx
}
/// Display a bare page for an admin endpoint
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
}
/// Validate the anti cross-site request forgery token in the current request
let validateCsrf : HttpHandler = fun next ctx -> task {
match! ctx.AntiForgery.IsRequestValidAsync ctx with

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

@@ -379,10 +379,7 @@ let chapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> tas
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
hashForPage "Manage Chapters"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageChaptersModel.Create post)
|> adminView "chapters" next ctx
adminPage "Manage Chapters" true (AdminViews.Post.chapters false (ManageChaptersModel.Create post)) next ctx
| Some _ | None -> return! Error.notFound next ctx
}
@@ -401,10 +398,9 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
match chapter with
| Some chap ->
return!
hashForPage (if index = -1 then "Add a Chapter" else "Edit Chapter")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditChapterModel.FromChapter post.Id index chap)
|> adminBareView "chapter-edit" next ctx
adminPage
(if index = -1 then "Add a Chapter" else "Edit Chapter") true
(AdminViews.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)) next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
@@ -419,23 +415,23 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
&& canEdit post.AuthorId ctx ->
let! form = ctx.BindFormAsync<EditChapterModel>()
let chapters = post.Episode.Value.Chapters.Value
if index = -1 || (index >= 0 && index < List.length chapters) then
let updatedPost =
{ post with
Episode = Some {
post.Episode.Value with
Chapters =
form.ToChapter() :: (if index = -1 then chapters else chapters |> List.removeAt index)
|> List.sortBy _.StartTime
|> Some } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
// TODO: handle "add another", only return chapter list vs. entire page with title
return!
hashForPage "Manage Chapters"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (ManageChaptersModel.Create updatedPost)
|> adminView "chapters" next ctx
if index >= -1 && index < List.length chapters then
try
let chapter = form.ToChapter()
let existing = if index = -1 then chapters else chapters |> List.removeAt index
let updatedPost =
{ post with
Episode = Some
{ post.Episode.Value with
Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
adminPage
"Manage Chapters" true
(AdminViews.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)) next ctx
with
| ex -> return! Error.notFound next ctx // TODO: return error
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}

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

@@ -36,10 +36,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
hashForPage "Log On"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model { LogOnModel.Empty with ReturnTo = returnTo }
|> adminView "log-on" next ctx
adminPage "Log On" true (AdminViews.User.logOn { LogOnModel.Empty with ReturnTo = returnTo }) next ctx
open System.Security.Claims
@@ -96,11 +93,7 @@ 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!
hashForPage "User Administration"
|> withAntiCsrf ctx
|> addToHash "users" (users |> List.map (DisplayUser.FromUser ctx.WebLog) |> Array.ofList)
|> adminBareView "user-list-body" next ctx
return! adminBarePage "User Administration" true (AdminViews.User.userList users) next ctx
}
/// Show the edit user page