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

Tweak admin UI templates (#25)

Browse Source 
- Move user management under web log settings
- Move user self-update to my-info
- Return meaningful error if a template does not exist
- Tweak margins/paddings throughout
- Do not show headings on list pages if lists are empty
- Fix pagination styles for page/post list pages
This commit is contained in:
Daniel J. Summers
2022-07-26 16:28:14 -04:00
parent ff9c08842b
commit 3189681021
23 changed files with 652 additions and 586 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/MyWebLog/Caches.fs
View File

@@ -172,18 +172,34 @@ module TemplateCache =
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> ()
| true -> return Ok _cache[templatePath]
| false ->
match! data.Theme.FindById themeId with
| Some theme ->
let mutable text = (theme.Templates |> List.find (fun t -> t.Name = templateName)).Text
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText = (theme.Templates |> List.find (fun t -> t.Name = child.Groups[1].Value)).Text
text <- text.Replace (child.Value, childText)
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
| None -> ()
return _cache[templatePath]
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
| Some template ->
let mutable text = template.Text
let mutable childNotFound = ""
while hasInclude.IsMatch text do
let child = hasInclude.Match text
let childText =
match theme.Templates |> List.tryFind (fun t -> t.Name = child.Groups[1].Value) with
| Some childTemplate -> childTemplate.Text
| None ->
childNotFound <-
if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {child.Groups[1].Value}"
""
text <- text.Replace (child.Value, childText)
if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
else
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist"
}
/// Get all theme/template names currently cached

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

@@ -32,38 +32,43 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> adminView "dashboard" next ctx
}
// GET /admin/dashboard/administration
// GET /admin/administration
let adminDashboard : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data
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 -> [|
ThemeId.toString it.Id
it.Name
cachedTemplates |> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id)) |> List.length |> string
|])
|> Array.ofSeq)
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy (fun it -> it.Name)
|> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> addViewContext ctx
return!
addToHash "theme_list" (bodyTemplate.Render hash) hash
|> adminView "admin-dashboard" next ctx
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 -> [|
ThemeId.toString it.Id
it.Name
cachedTemplates
|> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id))
|> List.length
|> string
|])
|> Array.ofSeq)
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy (fun it -> it.Name)
|> Seq.map (fun it -> [| WebLogId.toString 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
}
/// Redirect the user to the admin dashboard
let toAdminDashboard : HttpHandler = redirectToGet "admin/dashboard/administration"
let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
// ~~ CACHES ~~
@@ -117,14 +122,16 @@ let refreshThemeCache themeId : HttpHandler = requireAccess Administrator >=> fu
// GET /admin/categories
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get adminTheme "category-list-body" ctx.Data
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
| Ok catListTemplate ->
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
| Error message -> return! Error.server message next ctx
}
// GET /admin/categories/bare
@@ -204,11 +211,13 @@ let private tagMappingHash (ctx : HttpContext) = task {
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> adminView "tag-mapping-list" next ctx
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok listTemplate ->
let! hash = tagMappingHash ctx
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> adminView "tag-mapping-list" next ctx
| Error message -> return! Error.server message next ctx
}
// GET /admin/settings/tag-mappings/bare
@@ -421,31 +430,39 @@ open System.Collections.Generic
// GET /admin/settings
let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
return!
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 (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|> adminView "settings" next ctx
let data = ctx.Data
match! TemplateCache.get adminTheme "user-list-body" data with
| Ok userTemplate ->
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 (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addViewContext ctx
return!
addToHash "user_list" (userTemplate.Render hash) hash
|> adminView "settings" next ctx
| Error message -> return! Error.server message next ctx
}
// POST /admin/settings

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

@@ -218,23 +218,6 @@ let addViewContext ctx (hash : Hash) = task {
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
let! contentTemplate = TemplateCache.get themeId template ctx.Data
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout
let! layoutTemplate = TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data
return! htmlString (layoutTemplate.Render hash) next ctx
}
/// Convert messages to headers (used for htmx responses)
let messagesToHeaders (messages : UserMessage array) : HttpHandler =
seq {
@@ -249,52 +232,12 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
}
|> Seq.reduce (>=>)
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
if not (hash.ContainsKey ViewContext.Content) then
let! contentTemplate = TemplateCache.get themeId template ctx.Data
addToHash ViewContext.Content (contentTemplate.Render hash) hash |> ignore
// Bare templates are rendered with layout-bare
let! layoutTemplate = TemplateCache.get themeId "layout-bare" ctx.Data
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
>=> htmlString (layoutTemplate.Render hash))
next ctx
}
/// Return a view for the web log's default theme
let themedView template next ctx hash = task {
let! hash = addViewContext ctx hash
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
}
/// The ID for the admin theme
let adminTheme = ThemeId "admin"
/// Display a view for the admin theme
let adminView template =
viewForTheme adminTheme template
/// Display a bare view for the admin theme
let adminBareView template =
bareForTheme adminTheme template
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task {
do! commitSession ctx
return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn 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
| true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
}
/// Handlers for error conditions
module Error =
@@ -324,9 +267,81 @@ module Error =
let messages = [|
{ UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
(messagesToHeaders messages >=> setStatusCode 404) earlyReturn ctx
else
(setStatusCode 404 >=> text "Not found") earlyReturn ctx)
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
let server message : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [| { UserMessage.error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
match! TemplateCache.get themeId template ctx.Data with
| Ok contentTemplate ->
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout
match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
| Ok layoutTemplate -> return! htmlString (layoutTemplate.Render hash) next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let withContent = task {
if hash.ContainsKey ViewContext.Content then return Ok hash
else
match! TemplateCache.get themeId template ctx.Data with
| Ok contentTemplate -> return Ok (addToHash ViewContext.Content (contentTemplate.Render hash) hash)
| Error message -> return Error message
}
match! withContent with
| Ok completeHash ->
// Bare templates are rendered with layout-bare
match! TemplateCache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate ->
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
>=> htmlString (layoutTemplate.Render completeHash))
next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
/// Return a view for the web log's default theme
let themedView template next ctx hash = task {
let! hash = addViewContext ctx hash
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
}
/// The ID for the admin theme
let adminTheme = ThemeId "admin"
/// Display a view for the admin theme
let adminView template =
viewForTheme adminTheme template
/// Display a bare view for the admin theme
let adminBareView template =
bareForTheme adminTheme template
/// 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
| true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
}
/// Require a user to be logged on

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

@@ -106,13 +106,14 @@ let router : HttpHandler = choose [
]
subRoute "/admin" (requireUser >=> choose [
GET_HEAD >=> choose [
route "/administration" >=> Admin.adminDashboard
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
routef "y/%s/edit" Admin.editCategory
])
route "/dashboard" >=> Admin.dashboard
route "/dashboard/administration" >=> Admin.adminDashboard
route "/dashboard" >=> Admin.dashboard
route "/my-info" >=> User.myInfo
subRoute "/page" (choose [
route "s" >=> Page.all 1
routef "s/page/%i" Page.all
@@ -134,6 +135,11 @@ let router : HttpHandler = choose [
subRoute "/rss" (choose [
route "" >=> Feed.editSettings
routef "/%s/edit" Feed.editCustomFeed
])
subRoute "/user" (choose [
route "s" >=> User.all
routef "/%s/edit" User.edit
])
subRoute "/tag-mapping" (choose [
route "s" >=> Admin.tagMappings
@@ -149,12 +155,6 @@ let router : HttpHandler = choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew
])
subRoute "/user" (choose [
route "s" >=> User.all
route "s/bare" >=> User.bare
route "/my-info" >=> User.myInfo
routef "/%s/edit" User.edit
])
]
POST >=> validateCsrf >=> choose [
subRoute "/cache" (choose [
@@ -165,6 +165,7 @@ let router : HttpHandler = choose [
route "/save" >=> Admin.saveCategory
routef "/%s/delete" Admin.deleteCategory
])
route "/my-info" >=> User.saveMyInfo
subRoute "/page" (choose [
route "/save" >=> Page.save
route "/permalinks" >=> Page.savePermalinks
@@ -192,6 +193,10 @@ let router : HttpHandler = choose [
route "/save" >=> Admin.saveMapping
routef "/%s/delete" Admin.deleteMapping
])
subRoute "/user" (choose [
route "/save" >=> User.save
routef "/%s/delete" User.delete
])
])
subRoute "/theme" (choose [
route "/new" >=> Admin.saveTheme
@@ -202,11 +207,6 @@ let router : HttpHandler = choose [
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
subRoute "/user" (choose [
route "/my-info" >=> User.saveMyInfo
route "/save" >=> User.save
routef "/%s/delete" User.delete
])
]
])
GET_HEAD >=> routexp "/category/(.*)" Post.pageOfCategorizedPosts

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

@@ -72,34 +72,18 @@ let logOff : HttpHandler = fun next ctx -> task {
open System.Collections.Generic
open Giraffe.Htmx
open Microsoft.AspNetCore.Http
/// Create the hash needed to display the user list
let private userListHash (ctx : HttpContext) = task {
/// Got no time for URL/form manipulators...
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/settings/users
let all : HttpHandler = requireAccess WebLogAdmin >=> 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)
|> addViewContext ctx
}
/// Got no time for URL/form manipulators...
let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
let! tmpl = TemplateCache.get adminTheme "user-list-body" ctx.Data
return!
addToHash "user_list" (tmpl.Render hash) hash
|> adminView "user-list" next ctx
}
// GET /admin/users/bare
let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
return! adminBareView "user-list-body" next ctx hash
|> adminBareView "user-list-body" next ctx
}
/// Show the edit user page
@@ -116,7 +100,7 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|]
|> adminBareView "user-edit" next ctx
// GET /admin/user/{id}/edit
// GET /admin/settings/user/{id}/edit
let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let isNew = usrId = "new"
let userId = WebLogUserId usrId
@@ -128,7 +112,7 @@ let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> tas
| None -> return! Error.notFound next ctx
}
// POST /admin/user/{id}/delete
// POST /admin/settings/user/{id}/delete
let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let data = ctx.Data
match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
@@ -142,14 +126,14 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
{ UserMessage.success with
Message = $"User {WebLogUser.displayName user} deleted successfully"
}
return! bare next ctx
return! all next ctx
| Error msg ->
do! addMessage ctx
{ UserMessage.error with
Message = $"User {WebLogUser.displayName user} was not deleted"
Detail = Some msg
}
return! bare next ctx
return! all next ctx
| None -> return! Error.notFound next ctx
}
@@ -164,14 +148,14 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|> adminView "my-info" next ctx
// GET /admin/user/my-info
// 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
| None -> return! Error.notFound next ctx
}
// POST /admin/user/my-info
// POST /admin/my-info
let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel> ()
let data = ctx.Data
@@ -194,7 +178,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/user/my-info" next ctx
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
@@ -204,7 +188,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// User save is not statically compilable; not sure why, but we'll revisit it at some point
#nowarn "3511"
// POST /admin/user/save
// POST /admin/settings/user/save
let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditUserModel> ()
let data = ctx.Data
@@ -232,7 +216,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
{ UserMessage.success with
Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
}
return! bare next ctx
return! all next ctx
| Some _ ->
do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
return!