Add person add/edit/delete in settings (#17)

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

src/MyWebLog.Domain/ViewModels.fs

@@ -776,6 +776,41 @@ type EditPageModel() =
                                | _ -> revision :: page.Revisions }
 
 
+/// <summary>View model to edit a person</summary>
+type EditPersonModel() =
+    
+    /// <summary>The ID of the person being edited</summary>
+    member val Id = "" with get, set
+    
+    /// <summary>The name of the person</summary>
+    member val Name = "" with get, set
+    
+    /// <summary>A URL for this person's profile</summary>
+    member val ProfileUrl = "" with get, set
+    
+    /// <summary>A URL to the image for this person</summary>
+    member val ImageUrl = "" with get, set
+    
+    /// <summary>Create an edit model from a person</summary>
+    /// <param name="person">The person for whom the edit model is created</param>
+    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
+    
+    /// <summary>Update a person with values from this model</summary>
+    /// <param name="person">The person to be updated</param>
+    /// <returns>A person with their values updated</returns>
+    member this.UpdatePerson(person: Person) =
+        { person with
+            Name     = this.Name
+            Url      = noneIfBlank this.ProfileUrl
+            ImageUrl = noneIfBlank this.ImageUrl }
+
+
 /// <summary>View model to edit a post</summary>
 type EditPostModel() =
     inherit EditCommonModel()

src/MyWebLog.Tests/Data/PersonDataTests.fs

@@ -1,7 +1,6 @@
 /// <summary>Integration tests for <see cref="IPersonData" /> implementations</summary>
 module PersonDataTests
 
-open System
 open Expecto
 open MyWebLog
 open MyWebLog.Data

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<EditPersonModel>()
+            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 =
 

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
 

src/MyWebLog/Handlers/Post.fs

@@ -222,8 +222,8 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
                     let dic = Dictionary<string, obj>()
                     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.ImageUrl |> Option.iter (fun img -> dic["img"]     <- absoluteUrl img ctx.WebLog)
-                    it.Url      |> Option.iter (fun url -> dic["url"]     <- absoluteUrl url ctx)
+                    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<string, obj>()
             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

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

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 ->

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)
+
 /// <summary>Create a hidden input with the anti-Cross Site Request Forgery (CSRF) token</summary>
 /// <param name="app">The app view context for the current view</param>
 /// <returns>A hidden input with the CSRF token value</returns>

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" ] [