From 43a700eead18a2d78fa050ff87e85336961d2a50 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 9 Mar 2024 22:58:55 -0500 Subject: [PATCH] WIP on chapter flow (#6) - WIP with Giraffe View Engine for admin views - Added app context to DotLiquid hash; will remove individual fields in v3 --- src/MyWebLog.Domain/ViewModels.fs | 4 +- src/MyWebLog/AdminViews/Admin.fs | 77 ++++++++++ src/MyWebLog/AdminViews/Helpers.fs | 222 ++++++++++++++++++++++++++++ src/MyWebLog/AdminViews/Post.fs | 185 +++++++++++++++++++++++ src/MyWebLog/AdminViews/User.fs | 91 ++++++++++++ src/MyWebLog/DotLiquidBespoke.fs | 20 +-- src/MyWebLog/Handlers/Admin.fs | 19 +-- src/MyWebLog/Handlers/Helpers.fs | 99 ++++++++++--- src/MyWebLog/Handlers/Post.fs | 46 +++--- src/MyWebLog/Handlers/User.fs | 11 +- src/MyWebLog/MyWebLog.fsproj | 4 + src/admin-theme/chapter-edit.liquid | 105 ------------- src/admin-theme/chapters.liquid | 38 ----- src/admin-theme/dashboard.liquid | 59 -------- src/admin-theme/log-on.liquid | 30 ---- 15 files changed, 698 insertions(+), 312 deletions(-) create mode 100644 src/MyWebLog/AdminViews/Admin.fs create mode 100644 src/MyWebLog/AdminViews/Helpers.fs create mode 100644 src/MyWebLog/AdminViews/Post.fs create mode 100644 src/MyWebLog/AdminViews/User.fs delete mode 100644 src/admin-theme/chapter-edit.liquid delete mode 100644 src/admin-theme/chapters.liquid delete mode 100644 src/admin-theme/dashboard.liquid delete mode 100644 src/admin-theme/log-on.liquid diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index afb672b..7f4829a 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -1112,14 +1112,14 @@ type ManageChaptersModel = { Title: string /// The chapters for the post - Chapters: DisplayChapter array + Chapters: Chapter list } with /// Create a model from a post and its episode's chapters static member Create (post: Post) = { Id = string post.Id Title = post.Title - Chapters = post.Episode.Value.Chapters.Value |> List.map DisplayChapter.FromChapter |> Array.ofList } + Chapters = post.Episode.Value.Chapters.Value } /// View model to manage permalinks diff --git a/src/MyWebLog/AdminViews/Admin.fs b/src/MyWebLog/AdminViews/Admin.fs new file mode 100644 index 0000000..e42d68f --- /dev/null +++ b/src/MyWebLog/AdminViews/Admin.fs @@ -0,0 +1,77 @@ +module MyWebLog.AdminViews.Admin + +open Giraffe.ViewEngine +open MyWebLog.ViewModels + +/// The main dashboard +let dashboard (model: DashboardModel) app = [ + h2 [ _class "my-3" ] [ txt app.WebLog.Name; raw " • Dashboard" ] + article [ _class "container" ] [ + div [ _class "row" ] [ + section [ _class "col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3" ] [ + div [ _class "card" ] [ + header [ _class "card-header text-white bg-primary" ] [ raw "Posts" ] + div [ _class "card-body" ] [ + h6 [ _class "card-subtitle text-muted pb-3" ] [ + raw "Published " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Posts) ] + raw "  Drafts " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Drafts) ] + ] + if app.IsAuthor then + a [ _href (relUrl app "admin/posts"); _class "btn btn-secondary me-2" ] [ raw "View All" ] + a [ _href (relUrl app "admin/post/new/edit"); _class "btn btn-primary" ] [ + raw "Write a New Post" + ] + ] + ] + ] + section [ _class "col-lg-5 col-xl-4 pb-3" ] [ + div [ _class "card" ] [ + header [ _class "card-header text-white bg-primary" ] [ raw "Pages" ] + div [ _class "card-body" ] [ + h6 [ _class "card-subtitle text-muted pb-3" ] [ + raw "All " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Pages) ] + raw "  Shown in Page List " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.ListedPages) ] + ] + if app.IsAuthor then + a [ _href (relUrl app "admin/pages"); _class "btn btn-secondary me-2" ] [ raw "View All" ] + a [ _href (relUrl app "admin/page/new/edit"); _class "btn btn-primary" ] [ + raw "Create a New Page" + ] + ] + ] + ] + ] + div [ _class "row" ] [ + section [ _class "col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3" ] [ + div [ _class "card" ] [ + header [ _class "card-header text-white bg-secondary" ] [ raw "Categories" ] + div [ _class "card-body" ] [ + h6 [ _class "card-subtitle text-muted pb-3"] [ + raw "All " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Categories) ] + raw "  Top Level " + span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.TopLevelCategories) ] + ] + if app.IsWebLogAdmin then + a [ _href (relUrl app "admin/categories"); _class "btn btn-secondary me-2" ] [ + raw "View All" + ] + a [ _href (relUrl app "admin/category/new/edit"); _class "btn btn-secondary" ] [ + raw "Add a New Category" + ] + ] + ] + ] + ] + if app.IsWebLogAdmin then + div [ _class "row pb-3" ] [ + div [ _class "col text-end" ] [ + a [ _href (relUrl app "admin/settings"); _class "btn btn-secondary" ] [ raw "Modify Settings" ] + ] + ] + ] +] diff --git a/src/MyWebLog/AdminViews/Helpers.fs b/src/MyWebLog/AdminViews/Helpers.fs new file mode 100644 index 0000000..7a6bcdb --- /dev/null +++ b/src/MyWebLog/AdminViews/Helpers.fs @@ -0,0 +1,222 @@ +[] +module MyWebLog.AdminViews.Helpers + +open Microsoft.AspNetCore.Antiforgery +open Giraffe.ViewEngine +open Giraffe.ViewEngine.Accessibility +open Giraffe.ViewEngine.Htmx +open MyWebLog +open MyWebLog.ViewModels +open NodaTime +open NodaTime.Text + +/// The rendering context for this application +[] +type AppViewContext = { + /// The web log for this request + WebLog: WebLog + + /// The ID of the current user + UserId: WebLogUserId option + + /// The title of the page being rendered + PageTitle: string + + /// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form + Csrf: AntiforgeryTokenSet option + + /// The page list for the web log + PageList: DisplayPage array + + /// Categories and post counts for the web log + Categories: DisplayCategory array + + /// The URL of the page being rendered + CurrentPage: string + + /// User messages + Messages: UserMessage array + + /// The generator string for the rendered page + Generator: string + + /// A string to load the minified htmx script + HtmxScript: string + + /// Whether the current user is an author + IsAuthor: bool + + /// Whether the current user is an editor (implies author) + IsEditor: bool + + /// Whether the current user is a web log administrator (implies author and editor) + IsWebLogAdmin: bool + + /// Whether the current user is an installation administrator (implies all web log rights) + IsAdministrator: bool +} with + + /// Whether there is a user logged on + member this.IsLoggedOn = Option.isSome this.UserId + + +/// Create a relative URL for the current web log +let relUrl app = + Permalink >> app.WebLog.RelativeUrl + +/// Add a hidden input with the anti-Cross Site Request Forgery (CSRF) token +let antiCsrf app = + input [ _type "hidden"; _name app.Csrf.Value.FormFieldName; _value app.Csrf.Value.RequestToken ] + +/// Shorthand for encoded text in a template +let txt = encodedText + +/// Shorthand for raw text in a template +let raw = rawText + +/// The pattern for a long date +let longDatePattern = + InstantPattern.CreateWithInvariantCulture "MMMM d, yyyy" + +/// Create a long date +let longDate = + longDatePattern.Format >> txt + +/// The pattern for a short time +let shortTimePattern = + InstantPattern.CreateWithInvariantCulture "h:mmtt" + +/// Create a short time +let shortTime instant = + txt (shortTimePattern.Format(instant).ToLower()) + +/// Functions for generating content in varying layouts +module Layout = + + /// Generate the title tag for a page + let private titleTag (app: AppViewContext) = + title [] [ txt app.PageTitle; raw " « Admin « "; txt app.WebLog.Name ] + + /// Create a navigation link + let private navLink app name url = + let extraPath = app.WebLog.ExtraPath + let path = if extraPath = "" then "" else $"{extraPath[1..]}/" + let active = if app.CurrentPage.StartsWith $"{path}{url}" then " active" else "" + li [ _class "nav-item" ] [ + a [ _class $"nav-link{active}"; _href (relUrl app url) ] [ txt name ] + ] + + /// Create a page view for the given content + let private pageView (content: AppViewContext -> XmlNode list) app = [ + header [] [ + nav [ _class "navbar navbar-dark bg-dark navbar-expand-md justify-content-start px-2 position-fixed top-0 w-100" ] [ + div [ _class "container-fluid" ] [ + a [ _class "navbar-brand"; _href (relUrl app ""); _hxNoBoost ] [ txt app.WebLog.Name ] + button [ _type "button"; _class "navbar-toggler"; _data "bs-toggle" "collapse" + _data "bs-target" "#navbarText"; _ariaControls "navbarText"; _ariaExpanded "false" + _ariaLabel "Toggle navigation" ] [ + span [ _class "navbar-toggler-icon" ] [] + ] + div [ _class "collapse navbar-collapse"; _id "navbarText" ] [ + if app.IsLoggedOn then + ul [ _class "navbar-nav" ] [ + navLink app "Dashboard" "admin/dashboard" + if app.IsAuthor then + navLink app "Pages" "admin/pages" + navLink app "Posts" "admin/posts" + navLink app "Uploads" "admin/uploads" + if app.IsWebLogAdmin then + navLink app "Categories" "admin/categories" + navLink app "Settings" "admin/settings" + if app.IsAdministrator then navLink app "Admin" "admin/administration" + ] + ul [ _class "navbar-nav flex-grow-1 justify-content-end" ] [ + if app.IsLoggedOn then navLink app "My Info" "admin/my-info" + li [ _class "nav-item" ] [ + a [ _class "nav-link" + _href "https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog" + _target "_blank" ] [ + raw "Docs" + ] + ] + if app.IsLoggedOn then + li [ _class "nav-item" ] [ + a [ _class "nav-link"; _href (relUrl app "user/log-off"); _hxNoBoost ] [ + raw "Log Off" + ] + ] + else + navLink app "Log On" "user/log-on" + ] + ] + ] + ] + ] + div [ _id "toastHost"; _class "position-fixed top-0 w-100"; _ariaLive "polite"; _ariaAtomic "true" ] [ + div [ _id "toasts"; _class "toast-container position-absolute p-3 mt-5 top-0 end-0" ] [ + for msg in app.Messages do + let textColor = if msg.Level = "warning" then "" else " text-white" + div [ _class "toast"; _roleAlert; _ariaLive "assertive"; _ariaAtomic "true" + if msg.Level <> "success" then _data "bs-autohide" "false" ] [ + div [ _class $"toast-header bg-{msg.Level}{textColor}" ] [ + strong [ _class "me-auto text-uppercase" ] [ + raw (if msg.Level = "danger" then "error" else msg.Level) + ] + button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "toast" + _ariaLabel "Close" ] [] + ] + div [ _class $"toast-body bg-{msg.Level} bg-opacity-25" ] [ + txt msg.Message + if Option.isSome msg.Detail then + hr [] + txt msg.Detail.Value + ] + ] + ] + ] + main [ _class "mx-3 mt-3" ] [ + div [ _class "load-overlay p-5"; _id "loadOverlay" ] [ h1 [ _class "p-3" ] [ raw "Loading…" ] ] + yield! content app + ] + footer [ _class "position-fixed bottom-0 w-100" ] [ + div [ _class "text-end text-white me-2" ] [ + let version = app.Generator.Split ' ' + small [ _class "me-1 align-baseline"] [ raw $"v{version[1]}" ] + img [ _src (relUrl app "themes/admin/logo-light.png"); _alt "myWebLog"; _width "120"; _height "34" ] + ] + ] + ] + + /// Render a page with a partial layout (htmx request) + let partial content app = + html [ _lang "en" ] [ + titleTag app + yield! pageView content app + ] + + /// Render a page with a full layout + let full content app = + html [ _lang "en" ] [ + meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] + meta [ _name "generator"; _content app.Generator ] + titleTag app + link [ _rel "stylesheet"; _href "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css" + _integrity "sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" + _crossorigin "anonymous" ] + link [ _rel "stylesheet"; _href (relUrl app "themes/admin/admin.css") ] + body [ _hxBoost; _hxIndicator "#loadOverlay" ] [ + yield! pageView content app + script [ _src "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js" + _integrity "sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p" + _crossorigin "anonymous" ] [] + Script.minified + script [ _src (relUrl app "themes/admin/admin.js") ] [] + ] + ] + + /// Render a bare layout + let bare (content: AppViewContext -> XmlNode list) app = + html [ _lang "en" ] [ + title [] [] + yield! content app + ] diff --git a/src/MyWebLog/AdminViews/Post.fs b/src/MyWebLog/AdminViews/Post.fs new file mode 100644 index 0000000..b1d4994 --- /dev/null +++ b/src/MyWebLog/AdminViews/Post.fs @@ -0,0 +1,185 @@ +module MyWebLog.AdminViews.Post + +open Giraffe.ViewEngine +open Giraffe.ViewEngine.Htmx +open MyWebLog +open MyWebLog.ViewModels +open NodaTime.Text + +/// The pattern for chapter start times +let startTimePattern = DurationPattern.CreateWithInvariantCulture "H:mm:ss.FF" + +let chapterEdit (model: EditChapterModel) app = [ + let postUrl = relUrl app $"admin/post/{model.PostId}/chapter/{model.Index}" + h3 [ _class "my-3" ] [ raw (if model.Index < 0 then "Add" else "Edit"); raw " Chapter" ] + p [ _class "form-text" ] [ + raw "Times may be entered as seconds; minutes and seconds; or hours, minutes and seconds. Fractional seconds " + raw "are supported to two decimal places." + ] + form [ _method "post"; _action postUrl; _hxPost postUrl; _hxTarget "#chapter_list"; _class "container" ] [ + antiCsrf app + input [ _type "hidden"; _name "PostId"; _value model.PostId ] + input [ _type "hidden"; _name "Index"; _value (string model.Index) ] + div [ _class "row" ] [ + div [ _class "col-6 col-lg-3 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "start_time"; _name "StartTime"; _class "form-control"; _required + _autofocus; _placeholder "Start Time" + if model.Index >= 0 then _value model.StartTime ] + label [ _for "start_time" ] [ raw "Start Time" ] + ] + ] + div [ _class "col-6 col-lg-3 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "end_time"; _name "EndTime"; _class "form-control"; _value model.EndTime + _placeholder "End Time" ] + label [ _for "end_time" ] [ raw "End Time" ] + span [ _class "form-text" ] [ raw "Optional; ends when next starts" ] + ] + ] + div [ _class "col-12 col-lg-6 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "title"; _name "Title"; _class "form-control"; _value model.Title + _placeholder "Title" ] + label [ _for "title" ] [ raw "Chapter Title" ] + span [ _class "form-text" ] [ raw "Optional" ] + ] + ] + div [ _class "col-12 col-lg-6 offset-xl-1 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "image_url"; _name "ImageUrl"; _class "form-control" + _value model.ImageUrl; _placeholder "Image URL" ] + label [ _for "image_url" ] [ raw "Image URL" ] + span [ _class "form-text" ] [ + raw "Optional; a separate image to display while this chapter is playing" + ] + ] + ] + div [ _class "col-12 col-lg-6 col-xl-4 mb-3 align-self-end d-flex flex-column" ] [ + div [ _class "form-check form-switch mb-3" ] [ + input [ _type "checkbox"; _id "is_hidden"; _name "IsHidden"; _class "form-check-input" + _value "true" + if model.IsHidden then _checked ] + label [ _for "is_hidden" ] [ raw "Hidden Chapter" ] + ] + span [ _class "form-text" ] [ raw "Not displayed, but may update image and location" ] + ] + ] + div [ _class "row" ] [ + let hasLoc = model.LocationName <> "" + div [ _class "col-12 col-md-4 col-lg-3 offset-lg-1 mb-3 align-self-end" ] [ + div [ _class "form-check form-switch mb-3" ] [ + input [ _type "checkbox"; _id "has_location"; _class "form-check-input"; _value "true" + if hasLoc then _checked + _onclick "Admin.checkChapterLocation()" ] + label [ _for "has_location" ] [ raw "Associate Location" ] + ] + ] + div [ _class "col-12 col-md-8 col-lg-6 offset-lg-1 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "location_name"; _name "LocationName"; _class "form-control" + _value model.LocationName; _placeholder "Location Name"; _required + if not hasLoc then _disabled ] + label [ _for "location_name" ] [ raw "Name" ] + ] + ] + div [ _class "col-6 col-lg-4 offset-lg-2 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "location_geo"; _name "LocationGeo"; _class "form-control" + _value model.LocationGeo; _placeholder "Location Geo URL" + if not hasLoc then _disabled ] + label [ _for "location_geo" ] [ raw "Geo URL" ] + em [ _class "form-text" ] [ + raw "Optional; " + a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/location/location.md#geo-recommended" + _target "_blank"; _rel "noopener" ] [ + raw "see spec" + ] + ] + ] + ] + div [ _class "col-6 col-lg-4 mb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "text"; _id "location_osm"; _name "LocationOsm"; _class "form-control" + _value model.LocationOsm; _placeholder "Location OSM Query" + if not hasLoc then _disabled ] + label [ _for "location_osm" ] [ raw "OpenStreetMap ID" ] + em [ _class "form-text" ] [ + raw "Optional; " + a [ _href "https://www.openstreetmap.org/"; _target "_blank"; _rel "noopener" ] [ raw "get ID" ] + raw ", " + a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/location/location.md#osm-recommended" + _target "_blank"; _rel "noopener" ] [ + raw "see spec" + ] + ] + ] + ] + ] + div [ _class "row" ] [ + div [ _class "col" ] [ + let cancelLink = relUrl app $"admin/post/{model.PostId}/chapters" + if model.Index < 0 then + div [ _class "form-check form-switch mb-3" ] [ + input [ _type "checkbox"; _id "add_another"; _name "AddAnother"; _class "form-check-input" + _value "true"; _checked ] + label [ _for "add_another" ] [ raw "Add Another New Chapter" ] + ] + else + input [ _type "hidden"; _name "AddAnother"; _value "false" ] + button [ _type "submit"; _class "btn btn-primary" ] [ raw "Save" ] + a [ _href cancelLink; _hxGet cancelLink; _class "btn btn-secondary"; _hxTarget "body" ] [ raw "Cancel" ] + ] + ] + ] +] + +/// Display a list of chapters +let chapterList withNew (model: ManageChaptersModel) app = + form [ _method "post"; _id "chapter_list"; _class "container mb-3"; _hxTarget "this"; _hxSwap "outerHTML" ] [ + antiCsrf app + input [ _type "hidden"; _name "Id"; _value model.Id ] + div [ _class "row mwl-table-heading" ] [ + div [ _class "col" ] [ raw "Start" ] + div [ _class "col" ] [ raw "Title" ] + div [ _class "col" ] [ raw "Image?" ] + div [ _class "col" ] [ raw "Location?" ] + ] + yield! model.Chapters |> List.mapi (fun idx chapter -> + div [ _class "row pb-3 mwl-table-detail"; _id $"chapter{idx}" ] [ + div [ _class "col" ] [ txt (startTimePattern.Format chapter.StartTime) ] + div [ _class "col" ] [ txt (defaultArg chapter.Title "") ] + div [ _class "col" ] [ raw (if Option.isSome chapter.ImageUrl then "Y" else "N") ] + div [ _class "col" ] [ raw (if Option.isSome chapter.Location then "Y" else "N") ] + ]) + div [ _class "row pb-3"; _id "chapter-1" ] [ + if withNew then + yield! chapterEdit (EditChapterModel.FromChapter (PostId model.Id) -1 Chapter.Empty) app + else + let newLink = relUrl app $"admin/post/{model.Id}/chapter/-1" + div [ _class "row pb-3 mwl-table-detail" ] [ + div [ _class "col-12" ] [ + a [ _class "btn btn-primary"; _href newLink; _hxGet newLink; _hxTarget "#chapter-1" ] [ + raw "Add a New Chapter" + ] + ] + ] + ] + ] + |> List.singleton + +/// Manage Chapters page +let chapters withNew (model: ManageChaptersModel) app = [ + h2 [ _class "my-3" ] [ txt app.PageTitle ] + article [] [ + p [ _style "line-height:1.2rem;" ] [ + strong [] [ txt model.Title ]; br [] + small [ _class "text-muted" ] [ + a [ _href (relUrl app $"admin/post/{model.Id}/edit") ] [ + raw "« Back to Edit Post" + ] + ] + ] + yield! chapterList withNew model app + ] +] diff --git a/src/MyWebLog/AdminViews/User.fs b/src/MyWebLog/AdminViews/User.fs new file mode 100644 index 0000000..3e58130 --- /dev/null +++ b/src/MyWebLog/AdminViews/User.fs @@ -0,0 +1,91 @@ +module MyWebLog.AdminViews.User + +open Giraffe.ViewEngine +open Giraffe.ViewEngine.Htmx +open MyWebLog +open MyWebLog.ViewModels + +/// Page to display the log on page +let logOn (model: LogOnModel) (app: AppViewContext) = [ + h2 [ _class "my-3" ] [ rawText "Log On to "; encodedText app.WebLog.Name ] + article [ _class "py-3" ] [ + form [ _action (relUrl app "user/log-on"); _method "post"; _class "container"; _hxPushUrl "true" ] [ + antiCsrf app + if Option.isSome model.ReturnTo then input [ _type "hidden"; _name "ReturnTo"; _value model.ReturnTo.Value ] + div [ _class "row" ] [ + div [ _class "col-12 col-md-6 col-lg-4 offset-lg-2 pb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "email"; _id "email"; _name "EmailAddress"; _class "form-control"; _autofocus + _required ] + label [ _for "email" ] [ rawText "E-mail Address" ] + ] + ] + div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [ + div [ _class "form-floating" ] [ + input [ _type "password"; _id "password"; _name "Password"; _class "form-control"; _required ] + label [ _for "password" ] [ rawText "Password" ] + ] + ] + ] + div [ _class "row pb-3" ] [ + div [ _class "col text-center" ] [ + button [ _type "submit"; _class "btn btn-primary" ] [ rawText "Log On" ] + ] + ] + ] + ] +] + +/// The list of users for a web log (part of web log settings page) +let userList (model: WebLogUser list) app = + let badge = "ms-2 badge bg" + div [ _id "userList" ] [ + div [ _class "container g-0" ] [ + div [ _class "row mwl-table-detail"; _id "user_new" ] [] + ] + form [ _method "post"; _class "container g-0"; _hxTarget "this"; _hxSwap "outerHTML show:window:top" ] [ + antiCsrf app + for user in model do + div [ _class "row mwl-table-detail"; _id $"user_{user.Id}" ] [ + div [ _class $"col-12 col-md-4 col-xl-3 no-wrap" ] [ + txt user.PreferredName; raw " " + match user.AccessLevel with + | Administrator -> span [ _class $"{badge}-success" ] [ raw "ADMINISTRATOR" ] + | WebLogAdmin -> span [ _class $"{badge}-primary" ] [ raw "WEB LOG ADMIN" ] + | Editor -> span [ _class $"{badge}-secondary" ] [ raw "EDITOR" ] + | Author -> span [ _class $"{badge}-dark" ] [ raw "AUTHOR" ] + br [] + if app.IsAdministrator || (app.IsWebLogAdmin && not (user.AccessLevel = Administrator)) then + let urlBase = $"admin/settings/user/{user.Id}" + small [] [ + a [ _href (relUrl app $"{urlBase}/edit"); _hxTarget $"#user_{user.Id}" + _hxSwap $"innerHTML show:#user_{user.Id}:top" ] [ + raw "Edit" + ] + if app.UserId.Value <> user.Id then + let delLink = relUrl app $"{urlBase}/delete" + span [ _class "text-muted" ] [ raw " • " ] + a [ _href delLink; _hxPost delLink; _class "text-danger" + _hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [ + raw "Delete" + ] + ] + ] + div [ _class "col-12 col-md-4 col-xl-4" ] [ + txt $"{user.FirstName} {user.LastName}"; br [] + small [ _class "text-muted" ] [ + txt user.Email + if Option.isSome user.Url then + br []; txt user.Url.Value + ] + ] + div [ _class "d-none d-xl-block col-xl-2" ] [ longDate user.CreatedOn ] + div [ _class "col-12 col-md-4 col-xl-3" ] [ + match user.LastSeenOn with + | Some it -> longDate it; raw " at "; shortTime it + | None -> raw "--" + ] + ] + ] + ] + |> List.singleton \ No newline at end of file diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index eac2c53..ea60ec0 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -6,6 +6,7 @@ open System.IO open System.Web open DotLiquid open Giraffe.ViewEngine +open MyWebLog.AdminViews.Helpers open MyWebLog.ViewModels /// Extensions on the DotLiquid Context object @@ -227,15 +228,16 @@ let register () = typeof; typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof; typeof // View models - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof - typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof; typeof; typeof + typeof // Framework types typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 91904fd..cd92a9a 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 49a1f5f..70ad2c5 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -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 = [] let AntiCsrfTokens = "csrf" + /// The unified application view context + [] + let AppViewContext = "app" + /// The categories for this web log [] 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 diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 282e9fb..c34fa05 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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() 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 } diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 979ad9e..454bf9f 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -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 diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index 076a51b..57bc9e5 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -9,6 +9,10 @@ + + + + diff --git a/src/admin-theme/chapter-edit.liquid b/src/admin-theme/chapter-edit.liquid deleted file mode 100644 index d5e73a0..0000000 --- a/src/admin-theme/chapter-edit.liquid +++ /dev/null @@ -1,105 +0,0 @@ -

{% if model.index < 0 %}Add{% else %}Edit{% endif %} Chapter

-

Times may be entered as seconds; minutes and seconds; or hours, minutes and seconds. Fractional - seconds are supported to two decimal places. -{% assign post_url = "admin/post/" | append: model.post_id | append: "/chapter/" | append: model.index | relative_link %} -

- - - -
-
-
- - -
-
-
-
- - - Optional; ends when next starts -
-
-
-
- - - Optional -
-
-
-
- - - Optional; a separate image to display while this chapter is playing -
-
-
-
- - -
- Not displayed, but may update image and location -
-
-
- {%- if model.location_name != "" -%}{% assign has_loc = true %}{% else %}{% assign has_loc = false %}{% endif -%} -
-
- - -
-
-
-
- - -
-
-
-
- - - - Optional; - see spec - -
-
-
-
- - - - Optional; get ID, - see spec - -
-
-
-
-
- {% if model.index < 0 -%} -
- - -
- {% else -%} - - {% endif %} - - {% assign cancel_link = "admin/post/" | append: model.post_id | append: "/chapters" | relative_link %} - Cancel -
-
-
diff --git a/src/admin-theme/chapters.liquid b/src/admin-theme/chapters.liquid deleted file mode 100644 index a61ab41..0000000 --- a/src/admin-theme/chapters.liquid +++ /dev/null @@ -1,38 +0,0 @@ -

{{ page_title }}

-
-
- - -
-
-
-

- {{ model.title }}
- - - « Back to Edit Post - - -

-
-
-
Start
-
Title
-
Image?
-
Location?
-
- {% for chapter in model.chapters %} -
-
{{ chapter.start_time }}
-
{{ chapter.title }}
-
{% if chapter.image_url == "" %}N{% else %}Y{% endif %}
-
{% if chapter.location %}Y{% else %}N{% endif %}
-
- {% endfor %} -
- {% assign new_link = "admin/post/" | append: model.id | append: "/chapter/-1" | relative_link %} - Add a New Chapter -
-
-
-
diff --git a/src/admin-theme/dashboard.liquid b/src/admin-theme/dashboard.liquid deleted file mode 100644 index 782a8c3..0000000 --- a/src/admin-theme/dashboard.liquid +++ /dev/null @@ -1,59 +0,0 @@ -

{{ web_log.name }} • Dashboard

-
-
-
-
-
Posts
-
-
- Published {{ model.posts }} -   Drafts {{ model.drafts }} -
- {% if is_author %} - View All - Write a New Post - {% endif %} -
-
-
-
-
-
Pages
-
-
- All {{ model.pages }} -   Shown in Page List {{ model.listed_pages }} -
- {% if is_author %} - View All - Create a New Page - {% endif %} -
-
-
-
-
-
-
-
Categories
-
-
- All {{ model.categories }} -   Top Level {{ model.top_level_categories }} -
- {% if is_web_log_admin %} - View All - Add a New Category - {% endif %} -
-
-
-
- {% if is_web_log_admin %} -
-
- Modify Settings -
-
- {% endif %} -
diff --git a/src/admin-theme/log-on.liquid b/src/admin-theme/log-on.liquid deleted file mode 100644 index d6880ac..0000000 --- a/src/admin-theme/log-on.liquid +++ /dev/null @@ -1,30 +0,0 @@ -

Log On to {{ web_log.name }}

-
-
- - {% if model.return_to %} - - {% endif %} -
-
-
-
- - -
-
-
-
- - -
-
-
-
-
- -
-
-
-
-