diff --git a/src/MyWebLog.Data/Postgres/PostgresPersonData.fs b/src/MyWebLog.Data/Postgres/PostgresPersonData.fs
index 1e9fd90..83c1eea 100644
--- a/src/MyWebLog.Data/Postgres/PostgresPersonData.fs
+++ b/src/MyWebLog.Data/Postgres/PostgresPersonData.fs
@@ -5,7 +5,6 @@ open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
-open NodaTime
open Npgsql.FSharp
/// PostgreSQL myWebLog person data implementation
diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs
index 8f4ea05..0282e19 100644
--- a/src/MyWebLog.Domain/ViewModels.fs
+++ b/src/MyWebLog.Domain/ViewModels.fs
@@ -776,6 +776,41 @@ type EditPageModel() =
| _ -> revision :: page.Revisions }
+/// View model to edit a person
+type EditPersonModel() =
+
+ /// The ID of the person being edited
+ member val Id = "" with get, set
+
+ /// The name of the person
+ member val Name = "" with get, set
+
+ /// A URL for this person's profile
+ member val ProfileUrl = "" with get, set
+
+ /// A URL to the image for this person
+ member val ImageUrl = "" with get, set
+
+ /// Create an edit model from a person
+ /// The person for whom the edit model is created
+ static member FromPerson(person: Person) =
+ let model = EditPersonModel()
+ model.Id <- string person.Id
+ model.Name <- person.Name
+ model.ProfileUrl <- defaultArg person.Url ""
+ model.ImageUrl <- defaultArg person.ImageUrl ""
+ model
+
+ /// Update a person with values from this model
+ /// The person to be updated
+ /// A person with their values updated
+ member this.UpdatePerson(person: Person) =
+ { person with
+ Name = this.Name
+ Url = noneIfBlank this.ProfileUrl
+ ImageUrl = noneIfBlank this.ImageUrl }
+
+
/// View model to edit a post
type EditPostModel() =
inherit EditCommonModel()
diff --git a/src/MyWebLog.Tests/Data/PersonDataTests.fs b/src/MyWebLog.Tests/Data/PersonDataTests.fs
index ad8c37c..8ceb678 100644
--- a/src/MyWebLog.Tests/Data/PersonDataTests.fs
+++ b/src/MyWebLog.Tests/Data/PersonDataTests.fs
@@ -1,7 +1,6 @@
/// Integration tests for implementations
module PersonDataTests
-open System
open Expecto
open MyWebLog
open MyWebLog.Data
diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs
index b86dca5..45f9aa9 100644
--- a/src/MyWebLog/Handlers/Admin.fs
+++ b/src/MyWebLog/Handlers/Admin.fs
@@ -181,6 +181,75 @@ module Category =
}
+/// ~~~ PERSON ~~~
+module Person =
+
+ // GET /admin/settings/people
+ let all : HttpHandler =
+ requireAccess WebLogAdmin
+ >=> fun next ctx -> task {
+ let! ppl = ctx.Data.Person.FindByWebLog ctx.WebLog.Id
+ return! adminBarePage "People" next ctx (Views.WebLog.personList ppl)
+ }
+
+ // GET /admin/settings/person/[id]/edit
+ let edit psnId : HttpHandler =
+ requireAccess WebLogAdmin
+ >=> fun next ctx -> task {
+ let! result = task {
+ match psnId with
+ | "new" -> return Some ("Add a New Person", { Person.Empty with Id = PersonId "new" })
+ | _ ->
+ match! ctx.Data.Person.FindById (PersonId psnId) ctx.WebLog.Id with
+ | Some it -> return Some ("Edit Person", it)
+ | None -> return None
+ }
+ match result with
+ | Some (title, psn) ->
+ return! Views.WebLog.personEdit (EditPersonModel.FromPerson psn)
+ |> adminBarePage title next ctx
+ | None -> return! Error.notFound next ctx
+ }
+
+ // POST /admin/settings/person/save
+ let save : HttpHandler =
+ requireAccess WebLogAdmin
+ >=> validateCsrf
+ >=> fun next ctx -> task {
+ let data = ctx.Data
+ let! model = ctx.BindFormAsync()
+ let isNew = model.Id = "new"
+ let person =
+ if isNew then someTask { Person.Empty with Id = PersonId.Create(); WebLogId = ctx.WebLog.Id }
+ else data.Person.FindById (PersonId model.Id) ctx.WebLog.Id
+ match! person with
+ | Some psn ->
+ let updatedPsn = model.UpdatePerson psn
+ do! (if isNew then data.Person.Add else data.Person.Update) updatedPsn
+ do! CategoryCache.update ctx
+ do! addMessage ctx { UserMessage.Success with Message = "Person saved successfully" }
+ return! all next ctx
+ | None -> return! Error.notFound next ctx
+ }
+
+ // DELETE /admin/settings/person/{id}
+ let delete personId : HttpHandler =
+ requireAccess WebLogAdmin
+ >=> fun next ctx -> task {
+ let data = ctx.Data
+ match! data.Person.FindById (PersonId personId) ctx.WebLog.Id with
+ | Some psn ->
+ match! data.Person.Delete psn.Id psn.WebLogId with
+ | true ->
+ do! addMessage ctx { UserMessage.Success with Message = $"Person {psn.Name} deleted successfully" }
+ return! all next ctx
+ | false ->
+ do! addMessage ctx { UserMessage.Error with Message = $"User {psn.Name} was not deleted" }
+ return! all next ctx
+ | None -> return! Error.notFound next ctx
+ }
+
+
/// ~~~ REDIRECT RULES ~~~
module RedirectRules =
diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs
index d4f3235..fcb7955 100644
--- a/src/MyWebLog/Handlers/Helpers.fs
+++ b/src/MyWebLog/Handlers/Helpers.fs
@@ -275,10 +275,6 @@ open System.Threading.Tasks
/// Create a Task with a Some result for the given object
let someTask<'T> (it: 'T) = Task.FromResult(Some it)
-/// Create an absolute URL from a string that may already be an absolute URL
-let absoluteUrl (url: string) (ctx: HttpContext) =
- if url.StartsWith "http" then url else ctx.WebLog.AbsoluteUrl(Permalink url)
-
open MyWebLog.Data
diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs
index 866e916..196ca1b 100644
--- a/src/MyWebLog/Handlers/Post.fs
+++ b/src/MyWebLog/Handlers/Post.fs
@@ -222,8 +222,8 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
let dic = Dictionary()
dic["startTime"] <- Math.Round(it.StartTime.TotalSeconds, 2)
it.Title |> Option.iter (fun ttl -> dic["title"] <- ttl)
- it.ImageUrl |> Option.iter (fun img -> dic["img"] <- absoluteUrl img ctx)
- it.Url |> Option.iter (fun url -> dic["url"] <- absoluteUrl url ctx)
+ it.ImageUrl |> Option.iter (fun img -> dic["img"] <- absoluteUrl img ctx.WebLog)
+ it.Url |> Option.iter (fun url -> dic["url"] <- absoluteUrl url ctx.WebLog)
it.IsHidden |> Option.iter (fun toc -> dic["toc"] <- not toc)
it.EndTime |> Option.iter (fun ent -> dic["endTime"] <- Math.Round(ent.TotalSeconds, 2))
it.Location |> Option.iter (fun loc ->
@@ -237,7 +237,7 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
let jsonFile = Dictionary()
jsonFile["version"] <- "1.2.0"
jsonFile["title"] <- post.Title
- jsonFile["fileName"] <- absoluteUrl ep.Media ctx
+ jsonFile["fileName"] <- absoluteUrl ep.Media ctx.WebLog
if defaultArg ep.ChapterWaypoints false then jsonFile["waypoints"] <- true
jsonFile["chapters"] <- chapterData
(setContentType JSON_CHAPTERS >=> json jsonFile) next ctx
diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs
index acadacd..914b90c 100644
--- a/src/MyWebLog/Handlers/Routes.fs
+++ b/src/MyWebLog/Handlers/Routes.fs
@@ -165,6 +165,10 @@ let endpoints = [
route "" Admin.RedirectRules.all
routef "/%i" Admin.RedirectRules.edit
]
+ subRoute "/pe" [
+ route "ople" Admin.Person.all
+ routef "rson/%s/edit" Admin.Person.edit
+ ]
subRoute "/tag-mapping" [
route "s" Admin.TagMapping.all
routef "/%s/edit" Admin.TagMapping.edit
@@ -202,7 +206,8 @@ let endpoints = [
routef "/%s/revision/%s/restore" Post.restoreRevision
]
subRoute "/settings" [
- route "" Admin.WebLog.saveSettings
+ route "" Admin.WebLog.saveSettings
+ route "/person/save" Admin.Person.save
subRoute "/rss" [
route "" Feed.saveSettings
route "/save" Feed.saveCustomFeed
@@ -235,6 +240,7 @@ let endpoints = [
routef "/%s/revisions" Post.purgeRevisions
]
subRoute "/settings" [
+ routef "/person/%s" Admin.Person.delete
routef "/redirect-rules/%i" Admin.RedirectRules.delete
routef "/rss/%s" Feed.deleteCustomFeed
routef "/tag-mapping/%s" Admin.TagMapping.delete
diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs
index 109dd2c..b2db3d2 100644
--- a/src/MyWebLog/Maintenance.fs
+++ b/src/MyWebLog/Maintenance.fs
@@ -321,6 +321,8 @@ module Backup =
}
let private doRestore archive newUrlBase isInteractive (data: IData) = task {
+ // COMPAT: v2.x archives do not have a People entry
+ let archive = if (box >> isNull) archive.People then { archive with People = [] } else archive
let! restore = task {
match! data.WebLog.FindById archive.WebLog.Id with
| Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
diff --git a/src/MyWebLog/Views/Helpers.fs b/src/MyWebLog/Views/Helpers.fs
index da2f041..9e7de56 100644
--- a/src/MyWebLog/Views/Helpers.fs
+++ b/src/MyWebLog/Views/Helpers.fs
@@ -17,6 +17,10 @@ open NodaTime.Text
let relUrl app =
Permalink >> app.WebLog.RelativeUrl
+/// Create an absolute URL from a string that may already be an absolute URL
+let absoluteUrl (url: string) (webLog: WebLog) =
+ if url.StartsWith "http" then url else webLog.AbsoluteUrl(Permalink url)
+
/// Create a hidden input with the anti-Cross Site Request Forgery (CSRF) token
/// The app view context for the current view
/// A hidden input with the CSRF token value
diff --git a/src/MyWebLog/Views/WebLog.fs b/src/MyWebLog/Views/WebLog.fs
index e7a3110..fdb0ffe 100644
--- a/src/MyWebLog/Views/WebLog.fs
+++ b/src/MyWebLog/Views/WebLog.fs
@@ -399,6 +399,103 @@ let feedEdit (model: EditCustomFeedModel) (ratings: MetaItem list) (mediums: Met
]
+/// Edit form for a person
+let personEdit (model: EditPersonModel) (app: AppViewContext) = [
+ h5 [ _class "my-3" ] [ txt app.PageTitle ]
+ form [ _hxPost (relUrl app "admin/settings/person/save"); _method "post"; _hxBoost; _class "container"
+ hxInherited (_hxTarget "#person_panel"); _hxSwap $"{HxSwap.OuterHtml} show:top showTarget:top" ] [
+ antiCsrf app
+ input [ _type "hidden"; _name "Id"; _value model.Id ]
+ div [ _class "row mb-3" ] [
+ div [ _class "col-12 col-sm-8 offset-sm-2 col-lg-4 offset-lg-0 mb-3" ] [
+ textField [ _autofocus; _required ] (nameof model.Name) "Name" model.Name []
+ ]
+ div [ _class "col-12 col-lg-4 mb-3" ] [
+ textField [] (nameof model.ProfileUrl) "Profile URL" model.ProfileUrl [
+ span [ _class "form-text fst-italic" ] [
+ raw "relative URL will be served from this web log"
+ ]
+ ]
+ ]
+ div [ _class "col-12 col-lg-4 mb-3" ] [
+ textField [] (nameof model.ImageUrl) "Image URL" model.ImageUrl [
+ span [ _class "form-text fst-italic" ] [
+ raw "relative URL will be served from this web log"
+ ]
+ ]
+ ]
+ ]
+ div [ _class "row mb-3" ] [
+ div [ _class "col text-center" ] [
+ saveButton; raw " "
+ a [ _href (relUrl app "admin/settings/people"); _hxBoost; _class "btn btn-sm btn-secondary ms-3" ] [
+ raw "Cancel"
+ ]
+ ]
+ ]
+ ]
+]
+
+
+/// A list of people for this web log
+let personList (ppl: Person list) app =
+ let personDetail (psn: Person) =
+ let url = relUrl app $"admin/settings/person/{psn.Id}"
+ div [ _class "row mwl-table-detail"; _id $"person_{psn.Id}" ] [
+ div [ _class "col-12 col-md-4 no-wrap" ] [
+ txt psn.Name; br []
+ small [] [
+ a [ _href $"{url}/edit"; _hxBoost; _hxTarget $"#person_{psn.Id}"
+ _hxSwap $"{HxSwap.InnerHtml} show:top showTarget:#person_{psn.Id}" ] [
+ raw "Edit"
+ ]; actionSpacer
+ a [ _href url; _hxDelete url; _hxPushUrl "false"; _class "text-danger"
+ _hxConfirm $"Are you sure you want to delete the person “{psn.Name}”? This action cannot be undone." ] [
+ raw "Delete"
+ ]
+ ]
+ ]
+ div [ _class "col-12 col-md-8" ] [
+ if psn.Url.IsSome then
+ a [ _href (absoluteUrl psn.Url.Value app.WebLog); _target "_blank" ] [ txt psn.Url.Value ]
+ else
+ raw "N/A"
+ if psn.ImageUrl.IsSome then
+ br []
+ small [ _class "text-muted" ] [
+ raw "Image: "
+ a [ _href (absoluteUrl psn.ImageUrl.Value app.WebLog); _target "_blank" ] [
+ txt psn.ImageUrl.Value
+ ]
+ ]
+ ]
+ ]
+ div [ _id "person_panel" ] [
+ a [ _href (relUrl app "admin/settings/person/new/edit"); _hxBoost; _hxTarget "#person_new"
+ _class "btn btn-primary btn-sm mb-3" ] [
+ raw "Add a New Person"
+ ]
+ if List.isEmpty ppl then
+ div [ _id "person_new" ] [
+ p [ _class "text-muted text-center fst-italic" ] [ raw "This web log has no people defined" ]
+ ]
+ else
+ div [ _class "container g-0" ] [
+ div [ _class "row mwl-table-heading" ] [
+ div [ _class "col-12 col-md-4" ] [ raw "Name" ]
+ div [ _class "col-12 col-md-8" ] [ raw "URLs" ]
+ ]
+ ]
+ div [ _id "personList" ] [
+ div [ _class "row mwl-table-detail"; _id "person_new" ] []
+ List.map personDetail ppl
+ |> div [ _class "container g-0"; hxInherited (_hxTarget "#person_panel")
+ hxInherited (_hxSwap $"{HxSwap.OuterHtml} show:top showTarget:body") ]
+ ]
+ ]
+ |> List.singleton
+
+
/// Redirect Rule edit form
let redirectEdit (model: EditRedirectRuleModel) app = [
let url = relUrl app $"admin/settings/redirect-rules/{model.RuleId}"
@@ -822,6 +919,11 @@ let webLogSettings
span [ _hxGet (relUrl app "admin/settings/users"); _hxTarget "this"; _hxTrigger HxTrigger.Load
_hxSwap HxSwap.OuterHtml ] []
]
+ fieldset [ _id "people"; _class "container mb-3 pb-0" ] [
+ legend [] [ raw "People" ]
+ span [ _hxGet (relUrl app "admin/settings/people"); _hxTarget "this"; _hxTrigger HxTrigger.Load
+ _hxSwap HxSwap.OuterHtml ] []
+ ]
fieldset [ _id "rss-settings"; _class "container mb-3 pb-0" ] [
legend [] [ raw "RSS Settings" ]
form [ _action (relUrl app "admin/settings/rss"); _method "post"; _hxBoost; _class "container g-0" ] [