Version 2, ready for beta

src/MyWebLog/Handlers/Admin.fs

@@ -0,0 +1,504 @@
+/// Handlers to manipulate admin functions
+module MyWebLog.Handlers.Admin
+
+open System.Threading.Tasks
+open DotLiquid
+open Giraffe
+open MyWebLog
+open MyWebLog.ViewModels
+
+// GET /admin
+let dashboard : HttpHandler = fun next ctx -> task {
+    let webLogId = ctx.WebLog.id
+    let data     = ctx.Data
+    let getCount (f : WebLogId -> Task<int>) = f webLogId
+    let! posts   = data.Post.countByStatus Published |> getCount
+    let! drafts  = data.Post.countByStatus Draft     |> getCount
+    let! pages   = data.Page.countAll                |> getCount
+    let! listed  = data.Page.countListed             |> getCount
+    let! cats    = data.Category.countAll            |> getCount
+    let! topCats = data.Category.countTopLevel       |> getCount
+    return!
+        Hash.FromAnonymousObject {|
+            page_title = "Dashboard"
+            model      =
+                { posts              = posts
+                  drafts             = drafts
+                  pages              = pages
+                  listedPages        = listed
+                  categories         = cats
+                  topLevelCategories = topCats
+                }
+        |}
+        |> viewForTheme "admin" "dashboard" next ctx
+}
+
+// -- CATEGORIES --
+
+// GET /admin/categories
+let listCategories : HttpHandler = fun next ctx -> task {
+    let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
+    let hash = Hash.FromAnonymousObject {|
+        web_log    = ctx.WebLog
+        categories = CategoryCache.get ctx
+        page_title = "Categories"
+        csrf       = csrfToken ctx
+    |}
+    hash.Add ("category_list", catListTemplate.Render hash)
+    return! viewForTheme "admin" "category-list" next ctx hash
+}
+
+// GET /admin/categories/bare
+let listCategoriesBare : HttpHandler = fun next ctx -> task {
+    return!
+        Hash.FromAnonymousObject {|
+            categories = CategoryCache.get ctx
+            csrf       = csrfToken ctx
+        |}
+        |> bareForTheme "admin" "category-list-body" next ctx
+}
+
+
+// GET /admin/category/{id}/edit
+let editCategory catId : HttpHandler = fun next ctx -> task {
+    let! result = task {
+        match catId with
+        | "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" })
+        | _ ->
+            match! ctx.Data.Category.findById (CategoryId catId) ctx.WebLog.id with
+            | Some cat -> return Some ("Edit Category", cat)
+            | None -> return None
+    }
+    match result with
+    | Some (title, cat) ->
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = EditCategoryModel.fromCategory cat
+                page_title = title
+                categories = CategoryCache.get ctx
+            |}
+            |> bareForTheme "admin" "category-edit" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/category/save
+let saveCategory : HttpHandler = fun next ctx -> task {
+    let  webLog   = ctx.WebLog
+    let  data     = ctx.Data
+    let! model    = ctx.BindFormAsync<EditCategoryModel> ()
+    let! category = task {
+        match model.categoryId with
+        | "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLog.id }
+        | catId -> return! data.Category.findById (CategoryId catId) webLog.id
+    }
+    match category with
+    | Some cat ->
+        let cat =
+            { cat with
+                name        = model.name
+                slug        = model.slug
+                description = if model.description = "" then None else Some model.description
+                parentId    = if model.parentId    = "" then None else Some (CategoryId model.parentId)
+            }
+        do! (match model.categoryId with "new" -> data.Category.add | _ -> data.Category.update) cat
+        do! CategoryCache.update ctx
+        do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
+        return! listCategoriesBare next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/category/{id}/delete
+let deleteCategory catId : HttpHandler = fun next ctx -> task {
+    match! ctx.Data.Category.delete (CategoryId catId) ctx.WebLog.id with
+    | true ->
+        do! CategoryCache.update ctx
+        do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
+    | false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" }
+    return! listCategoriesBare next ctx
+}
+
+// -- PAGES --
+
+// GET /admin/pages
+// GET /admin/pages/page/{pageNbr}
+let listPages pageNbr : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let! pages  = ctx.Data.Page.findPageOfPages webLog.id pageNbr
+    return!
+        Hash.FromAnonymousObject {|
+            csrf       = csrfToken ctx
+            pages      = pages |> List.map (DisplayPage.fromPageMinimal webLog)
+            page_title = "Pages"
+            page_nbr   = pageNbr
+            prev_page  = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
+            next_page  = $"/page/{pageNbr + 1}"
+        |}
+        |> viewForTheme "admin" "page-list" next ctx
+}
+
+// GET /admin/page/{id}/edit
+let editPage pgId : HttpHandler = fun next ctx -> task {
+    let! result = task {
+        match pgId with
+        | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
+        | _ ->
+            match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
+            | Some page -> return Some ("Edit Page", page)
+            | None -> return None
+    }
+    match result with
+    | Some (title, page) ->
+        let  model     = EditPageModel.fromPage page
+        let! templates = templatesForTheme ctx "page"
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = model
+                metadata   = Array.zip model.metaNames model.metaValues
+                             |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
+                page_title = title
+                templates  = templates
+            |}
+            |> viewForTheme "admin" "page-edit" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// GET /admin/page/{id}/permalinks
+let editPagePermalinks pgId : HttpHandler = fun next ctx -> task {
+    match! ctx.Data.Page.findFullById (PageId pgId) ctx.WebLog.id with
+    | Some pg ->
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = ManagePermalinksModel.fromPage pg
+                page_title = $"Manage Prior Permalinks"
+            |}
+            |> viewForTheme "admin" "permalinks" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/page/permalinks
+let savePagePermalinks : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
+    let  links  = model.prior |> Array.map Permalink |> List.ofArray
+    match! ctx.Data.Page.updatePriorPermalinks (PageId model.id) webLog.id links with
+    | true ->
+        do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" }
+        return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{model.id}/permalinks")) next ctx
+    | false -> return! Error.notFound next ctx
+}
+
+// POST /admin/page/{id}/delete
+let deletePage pgId : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    match! ctx.Data.Page.delete (PageId pgId) webLog.id with
+    | true ->
+        do! PageListCache.update ctx
+        do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" }
+    | false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" }
+    return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/pages")) next ctx
+}
+
+open System
+
+#nowarn "3511"
+
+// POST /admin/page/save
+let savePage : HttpHandler = fun next ctx -> task {
+    let! model  = ctx.BindFormAsync<EditPageModel> ()
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let  now    = DateTime.UtcNow
+    let! pg     = task {
+        match model.pageId with
+        | "new" ->
+            return Some
+                { Page.empty with
+                    id          = PageId.create ()
+                    webLogId    = webLog.id
+                    authorId    = userId ctx
+                    publishedOn = now
+                }
+        | pgId -> return! data.Page.findFullById (PageId pgId) webLog.id
+    }
+    match pg with
+    | Some page ->
+        let updateList = page.showInPageList <> model.isShownInPageList
+        let revision   = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
+        // Detect a permalink change, and add the prior one to the prior list
+        let page =
+            match Permalink.toString page.permalink with
+            | "" -> page
+            | link when link = model.permalink -> page
+            | _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks }
+        let page =
+            { page with
+                title          = model.title
+                permalink      = Permalink model.permalink
+                updatedOn      = now
+                showInPageList = model.isShownInPageList
+                template       = match model.template with "" -> None | tmpl -> Some tmpl
+                text           = MarkupText.toHtml revision.text
+                metadata       = Seq.zip model.metaNames model.metaValues
+                                 |> Seq.filter (fun it -> fst it > "")
+                                 |> Seq.map (fun it -> { name = fst it; value = snd it })
+                                 |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
+                                 |> List.ofSeq
+                revisions      = match page.revisions |> List.tryHead with
+                                 | Some r when r.text = revision.text -> page.revisions
+                                 | _ -> revision :: page.revisions
+            }
+        do! (if model.pageId = "new" then data.Page.add else data.Page.update) page
+        if updateList then do! PageListCache.update ctx
+        do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
+        return!
+            redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/page/{PageId.toString page.id}/edit")) next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// -- TAG MAPPINGS --
+
+open Microsoft.AspNetCore.Http
+
+/// Get the hash necessary to render the tag mapping list
+let private tagMappingHash (ctx : HttpContext) = task {
+    let! mappings = ctx.Data.TagMap.findByWebLog ctx.WebLog.id
+    return Hash.FromAnonymousObject {|
+        web_log     = ctx.WebLog
+        csrf        = csrfToken ctx
+        mappings    = mappings
+        mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
+    |}
+}
+
+// GET /admin/settings/tag-mappings
+let tagMappings : HttpHandler = fun next ctx -> task {
+    let! hash         = tagMappingHash ctx
+    let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
+    
+    hash.Add ("tag_mapping_list", listTemplate.Render hash)
+    hash.Add ("page_title", "Tag Mappings")
+    
+    return! viewForTheme "admin" "tag-mapping-list" next ctx hash
+}
+
+// GET /admin/settings/tag-mappings/bare
+let tagMappingsBare : HttpHandler = fun next ctx -> task {
+    let! hash = tagMappingHash ctx
+    return! bareForTheme "admin" "tag-mapping-list-body" next ctx hash
+}
+
+// GET /admin/settings/tag-mapping/{id}/edit
+let editMapping tagMapId : HttpHandler = fun next ctx -> task {
+    let isNew  = tagMapId = "new"
+    let tagMap =
+        if isNew then
+            Task.FromResult (Some { TagMap.empty with id = TagMapId "new" })
+        else
+            ctx.Data.TagMap.findById (TagMapId tagMapId) ctx.WebLog.id
+    match! tagMap with
+    | Some tm ->
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = EditTagMapModel.fromMapping tm
+                page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag" 
+            |}
+            |> bareForTheme "admin" "tag-mapping-edit" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/settings/tag-mapping/save
+let saveMapping : HttpHandler = fun next ctx -> task {
+    let  data   = ctx.Data
+    let! model  = ctx.BindFormAsync<EditTagMapModel> ()
+    let  tagMap =
+        if model.id = "new" then
+            Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = ctx.WebLog.id })
+        else
+            data.TagMap.findById (TagMapId model.id) ctx.WebLog.id
+    match! tagMap with
+    | Some tm ->
+        do! data.TagMap.save { tm with tag = model.tag.ToLower (); urlValue = model.urlValue.ToLower () }
+        do! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" }
+        return! tagMappingsBare next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/settings/tag-mapping/{id}/delete
+let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
+    match! ctx.Data.TagMap.delete (TagMapId tagMapId) ctx.WebLog.id with
+    | true  -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
+    | false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
+    return! tagMappingsBare next ctx
+}
+
+// -- THEMES --
+
+open System.IO
+open System.IO.Compression
+open System.Text.RegularExpressions
+open MyWebLog.Data
+
+// GET /admin/theme/update
+let themeUpdatePage : HttpHandler = fun next ctx -> task {
+    return!
+        Hash.FromAnonymousObject {|
+            csrf       = csrfToken ctx
+            page_title = "Upload Theme"
+        |}
+        |> viewForTheme "admin" "upload-theme" next ctx
+}
+
+/// Update the name and version for a theme based on the version.txt file, if present
+let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
+    let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
+    match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
+    | Some versionItem ->
+        use  versionFile = new StreamReader(versionItem.Open ())
+        let! versionText = versionFile.ReadToEndAsync ()
+        let  parts       = versionText.Trim().Replace("\r", "").Split "\n"
+        let  displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.id
+        let  version     = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
+        return { theme with name = displayName; version = version }
+    | None ->
+        return { theme with name = ThemeId.toString theme.id; version = now () }
+}
+
+/// Delete all theme assets, and remove templates from theme
+let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask {
+    if cleanLoad then
+        do! data.ThemeAsset.deleteByTheme theme.id
+        return { theme with templates = [] }
+    else
+        return theme
+}
+
+/// Update the theme with all templates from the ZIP archive
+let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask {
+    let tasks =
+        zip.Entries
+        |> Seq.filter (fun it -> it.Name.EndsWith ".liquid")
+        |> Seq.map (fun templateItem -> backgroundTask {
+            use templateFile = new StreamReader (templateItem.Open ())
+            let! template = templateFile.ReadToEndAsync ()
+            return { name = templateItem.Name.Replace (".liquid", ""); text = template }
+        })
+    let! templates = Task.WhenAll tasks
+    return
+        templates
+        |> Array.fold (fun t template ->
+            { t with templates = template :: (t.templates |> List.filter (fun it -> it.name <> template.name)) })
+            theme
+}
+
+/// Update theme assets from the ZIP archive
+let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundTask {
+    for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
+        let assetName = asset.FullName.Replace ("wwwroot/", "")
+        if assetName <> "" && not (assetName.EndsWith "/") then
+            use stream = new MemoryStream ()
+            do! asset.Open().CopyToAsync stream
+            do! data.ThemeAsset.save
+                    { id        = ThemeAssetId (themeId, assetName)
+                      updatedOn = asset.LastWriteTime.DateTime
+                      data      = stream.ToArray ()
+                    }
+}
+
+/// Get the theme name from the file name given
+let getThemeName (fileName : string) =
+    let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
+    if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then Ok themeName else Error $"Theme name {fileName} is invalid"
+
+/// Load a theme from the given stream, which should contain a ZIP archive
+let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
+    use  zip     = new ZipArchive (file, ZipArchiveMode.Read)
+    let  themeId = ThemeId themeName
+    let! theme   = backgroundTask {
+        match! data.Theme.findById themeId with
+        | Some t -> return t
+        | None   -> return { Theme.empty with id = themeId }
+    }
+    let! theme = updateNameAndVersion theme   zip
+    let! theme = checkForCleanLoad    theme   clean data
+    let! theme = updateTemplates      theme   zip
+    do! data.Theme.save theme
+    do! updateAssets themeId zip data
+}
+
+// POST /admin/theme/update
+let updateTheme : HttpHandler = fun next ctx -> task {
+    if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
+        let themeFile = Seq.head ctx.Request.Form.Files
+        match getThemeName themeFile.FileName with
+        | Ok themeName when themeName <> "admin" ->
+            let data   = ctx.Data
+            use stream = new MemoryStream ()
+            do! themeFile.CopyToAsync stream
+            do! loadThemeFromZip themeName stream true data
+            do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
+            do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
+            return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
+        | Ok _ ->
+            do! addMessage ctx { UserMessage.error with message = "You may not replace the admin theme" }
+            return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
+        | Error message ->
+            do! addMessage ctx { UserMessage.error with message = message }
+            return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/theme/update")) next ctx
+    else
+        return! RequestErrors.BAD_REQUEST "Bad request" next ctx
+}
+
+// -- WEB LOG SETTINGS --
+
+open System.Collections.Generic
+
+// GET /admin/settings
+let settings : HttpHandler = fun next ctx -> task {
+    let  webLog   = ctx.WebLog
+    let  data     = ctx.Data
+    let! allPages = data.Page.all webLog.id
+    let! themes   = data.Theme.all ()
+    return!
+        Hash.FromAnonymousObject {|
+            csrf  = csrfToken ctx
+            model = SettingsModel.fromWebLog webLog
+            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
+            themes     = themes
+                         |> Seq.ofList
+                         |> Seq.map (fun it ->
+                             KeyValuePair.Create (ThemeId.toString it.id, $"{it.name} (v{it.version})"))
+                         |> Array.ofSeq
+            web_log    = webLog
+            page_title = "Web Log Settings"
+        |}
+        |> viewForTheme "admin" "settings" next ctx
+}
+
+// POST /admin/settings
+let saveSettings : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let! model  = ctx.BindFormAsync<SettingsModel> ()
+    match! data.WebLog.findById webLog.id with
+    | Some webLog ->
+        let webLog = model.update webLog
+        do! data.WebLog.updateSettings webLog
+
+        // Update cache
+        WebLogCache.set webLog
+    
+        do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
+        return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings")) next ctx
+    | None -> return! Error.notFound next ctx
+}

src/MyWebLog/Handlers/Error.fs

@@ -0,0 +1,22 @@
+/// Handlers for error conditions
+module MyWebLog.Handlers.Error
+
+open System.Net
+open System.Threading.Tasks
+open Giraffe
+open Microsoft.AspNetCore.Http
+open MyWebLog
+
+/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
+let notAuthorized : HttpHandler = fun next ctx -> task {
+    if ctx.Request.Method = "GET" then
+        let returnUrl = WebUtility.UrlEncode ctx.Request.Path
+        return!
+            redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink $"user/log-on?returnUrl={returnUrl}")) next ctx
+    else
+        return! (setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None) next ctx
+}
+
+/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
+let notFound : HttpHandler =
+    setStatusCode 404 >=> text "Not found"

src/MyWebLog/Handlers/Feed.fs

@@ -0,0 +1,459 @@
+/// Functions to support generating RSS feeds
+module MyWebLog.Handlers.Feed
+
+open System
+open System.IO
+open System.Net
+open System.ServiceModel.Syndication
+open System.Text.RegularExpressions
+open System.Xml
+open Giraffe
+open Microsoft.AspNetCore.Http
+open MyWebLog
+open MyWebLog.ViewModels
+
+// ~~ FEED GENERATION ~~
+
+/// The type of feed to generate
+type FeedType =
+    | StandardFeed of string
+    | CategoryFeed of CategoryId * string
+    | TagFeed      of string * string
+    | Custom       of CustomFeed * string
+
+/// Derive the type of RSS feed requested
+let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
+    let webLog    = ctx.WebLog
+    let debug     = debug "Feed" ctx
+    let name      = $"/{webLog.rss.feedName}"
+    let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage
+    debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
+    // Standard feed
+    match webLog.rss.feedEnabled && feedPath = name with
+    | true  ->
+        debug (fun () -> "Found standard feed")
+        Some (StandardFeed feedPath, postCount)
+    | false ->
+        // Category and tag feeds are handled by defined routes; check for custom feed
+        match webLog.rss.customFeeds
+              |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with
+        | Some feed ->
+            debug (fun () -> "Found custom feed")
+            Some (Custom (feed, feedPath),
+                  feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
+        | None ->
+            debug (fun () -> $"No matching feed found")
+            None
+
+/// Determine the function to retrieve posts for the given feed
+let private getFeedPosts ctx feedType =
+    let childIds catId =
+        let cat = CategoryCache.get ctx |> Array.find (fun c -> c.id = CategoryId.toString catId)
+        getCategoryIds cat.slug ctx
+    let data = ctx.Data
+    match feedType with
+    | StandardFeed _          -> data.Post.findPageOfPublishedPosts ctx.WebLog.id 1
+    | CategoryFeed (catId, _) -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1
+    | TagFeed      (tag,   _) -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1
+    | Custom       (feed,  _) ->
+        match feed.source with
+        | Category catId -> data.Post.findPageOfCategorizedPosts ctx.WebLog.id (childIds catId) 1
+        | Tag      tag   -> data.Post.findPageOfTaggedPosts ctx.WebLog.id tag 1
+
+/// Strip HTML from a string
+let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
+
+/// XML namespaces for building RSS feeds
+[<RequireQualifiedAccess>]
+module private Namespace = 
+    
+    /// Enables encoded (HTML) content
+    let content = "http://purl.org/rss/1.0/modules/content/"
+
+    /// The dc XML namespace
+    let dc = "http://purl.org/dc/elements/1.1/"
+
+    /// iTunes elements
+    let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
+
+    /// Enables chapters
+    let psc = "http://podlove.org/simple-chapters/"
+
+    /// Enables another "subscribe" option
+    let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
+
+/// Create a feed item from the given post    
+let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
+            (post : Post) =
+    let plainText =
+        let endingP = post.text.IndexOf "</p>"
+        stripHtml <| if endingP >= 0 then post.text[..(endingP - 1)] else post.text
+    let item = SyndicationItem (
+        Id              = WebLog.absoluteUrl webLog post.permalink,
+        Title           = TextSyndicationContent.CreateHtmlContent post.title,
+        PublishDate     = DateTimeOffset post.publishedOn.Value,
+        LastUpdatedTime = DateTimeOffset post.updatedOn,
+        Content         = TextSyndicationContent.CreatePlaintextContent plainText)
+    item.AddPermalink (Uri item.Id)
+    
+    let xmlDoc = XmlDocument ()
+    
+    let encoded =
+        let txt =
+            post.text
+                .Replace("src=\"/", $"src=\"{webLog.urlBase}/")
+                .Replace ("href=\"/", $"href=\"{webLog.urlBase}/")
+        let it  = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
+        let _   = it.AppendChild (xmlDoc.CreateCDataSection txt)
+        it
+    item.ElementExtensions.Add encoded
+        
+    item.Authors.Add (SyndicationPerson (
+        Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value))
+    [ post.categoryIds
+      |> List.map (fun catId ->
+          let cat = cats |> Array.find (fun c -> c.id = CategoryId.toString catId)
+          SyndicationCategory (cat.name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.slug}/"), cat.name))
+      post.tags
+      |> List.map (fun tag ->
+          let urlTag =
+              match tagMaps |> List.tryFind (fun tm -> tm.tag = tag) with
+              | Some tm -> tm.urlValue
+              | None -> tag.Replace (" ", "+")
+          SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
+    ]
+    |> List.concat
+    |> List.iter item.Categories.Add
+    item
+
+/// Add episode information to a podcast feed item
+let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) =
+    let podcast = Option.get feed.podcast
+    let meta name = post.metadata |> List.tryFind (fun it -> it.name = name)
+    let value (item : MetaItem) = item.value
+    let epMediaUrl =
+        match (meta >> Option.get >> value) "episode_media_file" with
+        | link when link.StartsWith "http" -> link
+        | link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
+        | link -> WebLog.absoluteUrl webLog (Permalink link)
+    let epMediaType =
+        match meta "episode_media_type", podcast.defaultMediaType with
+        | Some epType, _ -> Some epType.value
+        | None, Some defType -> Some defType
+        | _ -> None
+    let epImageUrl =
+        match defaultArg ((meta >> Option.map value) "episode_image") (Permalink.toString podcast.imageUrl) with
+        | link when link.StartsWith "http" -> link
+        | link -> WebLog.absoluteUrl webLog (Permalink link)
+    let epExplicit =
+        try
+            (meta >> Option.map (value >> ExplicitRating.parse)) "episode_explicit"
+            |> Option.defaultValue podcast.explicit
+            |> ExplicitRating.toString
+        with :? ArgumentException -> ExplicitRating.toString podcast.explicit
+    
+    let xmlDoc    = XmlDocument ()
+    let enclosure =
+        let it = xmlDoc.CreateElement "enclosure"
+        it.SetAttribute ("url", epMediaUrl)
+        meta "episode_media_length" |> Option.iter (fun len -> it.SetAttribute ("length", len.value))
+        epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
+        it
+    let image =
+        let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
+        it.SetAttribute ("href", epImageUrl)
+        it
+        
+    item.ElementExtensions.Add enclosure
+    item.ElementExtensions.Add image
+    item.ElementExtensions.Add ("creator",  Namespace.dc,     podcast.displayedAuthor)
+    item.ElementExtensions.Add ("author",   Namespace.iTunes, podcast.displayedAuthor)
+    item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
+    meta "episode_subtitle"
+    |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value))
+    meta "episode_duration"
+    |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
+    
+    if post.metadata |> List.exists (fun it -> it.name = "chapter") then
+        try
+            let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
+            chapters.SetAttribute ("version", "1.2")
+            
+            post.metadata
+            |> List.filter (fun it -> it.name = "chapter")
+            |> List.map (fun it ->
+                TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1))
+            |> List.sortBy fst
+            |> List.iter (fun chap ->
+                let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
+                chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
+                chapter.SetAttribute ("title", snd chap)
+                chapters.AppendChild chapter |> ignore)
+            
+            item.ElementExtensions.Add chapters
+        with _ -> ()
+    item
+    
+/// Add a namespace to the feed
+let private addNamespace (feed : SyndicationFeed) alias nsUrl =
+    feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
+
+/// Add items to the top of the feed required for podcasts
+let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
+    let addChild (doc : XmlDocument) ns prefix name value (elt : XmlElement) =
+        let child =
+            if ns = "" then doc.CreateElement name else doc.CreateElement (prefix, name, ns)
+            |> elt.AppendChild
+        child.InnerText <- value
+        elt
+    
+    let podcast  = Option.get feed.podcast
+    let feedUrl  = WebLog.absoluteUrl webLog feed.path
+    let imageUrl =
+        match podcast.imageUrl with
+        | Permalink link when link.StartsWith "http" -> link
+        | Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl
+    
+    let xmlDoc = XmlDocument ()
+    
+    [ "dc", Namespace.dc; "itunes", Namespace.iTunes; "psc", Namespace.psc; "rawvoice", Namespace.rawVoice ]
+    |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
+    
+    let categorization =
+        let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+        it.SetAttribute ("text", podcast.iTunesCategory)
+        podcast.iTunesSubcategory
+        |> Option.iter (fun subCat ->
+            let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+            subCatElt.SetAttribute ("text", subCat)
+            it.AppendChild subCatElt |> ignore)
+        it
+    let image = 
+        [ "title", podcast.title
+          "url",   imageUrl
+          "link",  feedUrl
+        ]
+        |> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
+    let iTunesImage =
+        let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
+        it.SetAttribute ("href", imageUrl)
+        it
+    let owner =
+        [ "name", podcast.displayedAuthor
+          "email", podcast.email
+        ]
+        |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
+                     (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
+    let rawVoice =
+        let it = xmlDoc.CreateElement ("rawvoice", "subscribe", Namespace.rawVoice)
+        it.SetAttribute ("feed", feedUrl)
+        it.SetAttribute ("itunes", "")
+        it
+    
+    rssFeed.ElementExtensions.Add image
+    rssFeed.ElementExtensions.Add owner
+    rssFeed.ElementExtensions.Add categorization
+    rssFeed.ElementExtensions.Add iTunesImage
+    rssFeed.ElementExtensions.Add rawVoice
+    rssFeed.ElementExtensions.Add ("summary",   Namespace.iTunes,   podcast.summary)
+    rssFeed.ElementExtensions.Add ("author",    Namespace.iTunes,   podcast.displayedAuthor)
+    rssFeed.ElementExtensions.Add ("explicit",  Namespace.iTunes,   ExplicitRating.toString podcast.explicit)
+    podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
+
+/// Get the feed's self reference and non-feed link
+let private selfAndLink webLog feedType ctx =
+    let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.rss.feedName}", ""))
+    match feedType with
+    | StandardFeed     path
+    | CategoryFeed (_, path)
+    | TagFeed      (_, path) -> Permalink path[1..], withoutFeed path
+    | Custom (feed, _) ->
+        match feed.source with
+        | Category (CategoryId catId) ->
+            feed.path, Permalink $"category/{(CategoryCache.get ctx |> Array.find (fun c -> c.id = catId)).slug}"
+        | Tag tag -> feed.path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" 
+
+/// Set the title and description of the feed based on its source
+let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
+    let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
+    match feedType with
+    | StandardFeed _ ->
+        feed.Title       <- cleanText None webLog.name
+        feed.Description <- cleanText webLog.subtitle webLog.name
+    | CategoryFeed (CategoryId catId, _) ->
+        let cat = cats |> Array.find (fun it -> it.id = catId)
+        feed.Title       <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
+        feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
+    | TagFeed (tag, _) ->
+        feed.Title       <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
+        feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
+    | Custom (custom, _) ->
+        match custom.podcast with
+        | Some podcast ->
+            feed.Title       <- cleanText None podcast.title
+            feed.Description <- cleanText podcast.subtitle podcast.title
+        | None ->
+            match custom.source with
+            | Category (CategoryId catId) ->
+                let cat = cats |> Array.find (fun it -> it.id = catId)
+                feed.Title       <- cleanText None $"""{webLog.name} - "{stripHtml cat.name}" Category"""
+                feed.Description <- cleanText cat.description $"""Posts categorized under "{cat.name}" """
+            | Tag tag ->
+                feed.Title       <- cleanText None $"""{webLog.name} - "{tag}" Tag"""
+                feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
+    
+/// Create a feed with a known non-zero-length list of posts    
+let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
+    let  webLog     = ctx.WebLog
+    let  data       = ctx.Data
+    let! authors    = getAuthors     webLog posts data
+    let! tagMaps    = getTagMappings webLog posts data
+    let  cats       = CategoryCache.get ctx
+    let  podcast    = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None
+    let  self, link = selfAndLink webLog feedType ctx
+    
+    let toItem post =
+        let item = toFeedItem webLog authors cats tagMaps post
+        match podcast with
+        | Some feed when post.metadata |> List.exists (fun it -> it.name = "episode_media_file") ->
+            addEpisode webLog feed post item
+        | Some _ ->
+            warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
+            item
+        | _ -> item
+        
+    let feed = SyndicationFeed ()
+    addNamespace feed "content" Namespace.content
+    setTitleAndDescription feedType webLog cats feed
+    
+    feed.LastUpdatedTime <- (List.head posts).updatedOn |> DateTimeOffset
+    feed.Generator       <- generator ctx
+    feed.Items           <- posts |> Seq.ofList |> Seq.map toItem
+    feed.Language        <- "en"
+    feed.Id              <- WebLog.absoluteUrl webLog link
+    webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
+    
+    feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
+    feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
+    
+    podcast |> Option.iter (addPodcast webLog feed)
+    
+    use mem = new MemoryStream ()
+    use xml = XmlWriter.Create mem
+    feed.SaveAsRss20 xml
+    xml.Close ()
+    
+    let _ = mem.Seek (0L, SeekOrigin.Begin)
+    let rdr = new StreamReader(mem)
+    let! output = rdr.ReadToEndAsync ()
+    
+    return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
+}
+
+// GET {any-prescribed-feed}
+let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
+    match! getFeedPosts ctx feedType postCount with
+    | posts when List.length posts > 0 -> return! createFeed feedType posts next ctx
+    | _ -> return! Error.notFound next ctx
+}
+
+// ~~ FEED ADMINISTRATION ~~
+
+open DotLiquid
+
+// GET: /admin/rss/settings
+let editSettings : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    let feeds =
+        webLog.rss.customFeeds
+        |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
+        |> Array.ofList
+    return! Hash.FromAnonymousObject
+        {|  csrf         = csrfToken ctx
+            page_title   = "RSS Settings"
+            model        = EditRssModel.fromRssOptions webLog.rss
+            custom_feeds = feeds
+        |}
+        |> viewForTheme "admin" "rss-settings" next ctx
+}
+
+// POST: /admin/rss/settings
+let saveSettings : HttpHandler = fun next ctx -> task {
+    let  data  = ctx.Data
+    let! model = ctx.BindFormAsync<EditRssModel> ()
+    match! data.WebLog.findById ctx.WebLog.id with
+    | Some webLog ->
+        let webLog = { webLog with rss = model.updateOptions webLog.rss }
+        do! data.WebLog.updateRssOptions webLog
+        WebLogCache.set webLog
+        do! addMessage ctx { UserMessage.success with message = "RSS settings updated successfully" }
+        return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// GET: /admin/rss/{id}/edit
+let editCustomFeed feedId : HttpHandler = fun next ctx -> task {
+    let customFeed =
+        match feedId with
+        | "new" -> Some { CustomFeed.empty with id = CustomFeedId "new" }
+        | _     -> ctx.WebLog.rss.customFeeds |> List.tryFind (fun f -> f.id = CustomFeedId feedId)
+    match customFeed with
+    | Some f ->
+        return! Hash.FromAnonymousObject
+            {|  csrf       = csrfToken ctx
+                page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
+                model      = EditCustomFeedModel.fromFeed f
+                categories = CategoryCache.get ctx
+            |}
+            |> viewForTheme "admin" "custom-feed-edit" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST: /admin/rss/save
+let saveCustomFeed : HttpHandler = fun next ctx -> task {
+    let data = ctx.Data
+    match! data.WebLog.findById ctx.WebLog.id with
+    | Some webLog ->
+        let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
+        let theFeed =
+            match model.id with
+            | "new" -> Some { CustomFeed.empty with id = CustomFeedId.create () }
+            | _ -> webLog.rss.customFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.id = model.id)
+        match theFeed with
+        | Some feed ->
+            let feeds = model.updateFeed feed :: (webLog.rss.customFeeds |> List.filter (fun it -> it.id <> feed.id))
+            let webLog = { webLog with rss = { webLog.rss with customFeeds = feeds } }
+            do! data.WebLog.updateRssOptions webLog
+            WebLogCache.set webLog
+            do! addMessage ctx {
+                UserMessage.success with
+                  message = $"""Successfully {if model.id = "new" then "add" else "sav"}ed custom feed"""
+            }
+            let nextUrl = $"admin/settings/rss/{CustomFeedId.toString feed.id}/edit" 
+            return! redirectToGet (WebLog.relativeUrl webLog (Permalink nextUrl)) next ctx
+        | None -> return! Error.notFound next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/rss/{id}/delete
+let deleteCustomFeed feedId : HttpHandler = fun next ctx -> task {
+    let data = ctx.Data
+    match! data.WebLog.findById ctx.WebLog.id with
+    | Some webLog ->
+        let customId = CustomFeedId feedId
+        if webLog.rss.customFeeds |> List.exists (fun f -> f.id = customId) then
+            let webLog = {
+              webLog with
+                rss = {
+                  webLog.rss with
+                    customFeeds = webLog.rss.customFeeds |> List.filter (fun f -> f.id <> customId)
+                }
+            }
+            do! data.WebLog.updateRssOptions webLog
+            WebLogCache.set webLog
+            do! addMessage ctx { UserMessage.success with message = "Custom feed deleted successfully" }
+        else
+            do! addMessage ctx { UserMessage.warning with message = "Custom feed not found; no action taken" }
+        return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/settings/rss")) next ctx
+    | None -> return! Error.notFound next ctx
+}

src/MyWebLog/Handlers/Helpers.fs

@@ -0,0 +1,256 @@
+[<AutoOpen>]
+module private MyWebLog.Handlers.Helpers
+
+open System.Text.Json
+open Microsoft.AspNetCore.Http
+
+/// Session extensions to get and set objects
+type ISession with
+    
+    /// Set an item in the session
+    member this.Set<'T> (key, item : 'T) =
+        this.SetString (key, JsonSerializer.Serialize item)
+    
+    /// Get an item from the session
+    member this.Get<'T> key =
+        match this.GetString key with
+        | null -> None
+        | item -> Some (JsonSerializer.Deserialize<'T> item)
+
+    
+/// The HTTP item key for loading the session
+let private sessionLoadedKey = "session-loaded"
+
+/// Load the session if it has not been loaded already; ensures async access but not excessive loading
+let private loadSession (ctx : HttpContext) = task {
+    if not (ctx.Items.ContainsKey sessionLoadedKey) then
+        do! ctx.Session.LoadAsync ()
+        ctx.Items.Add (sessionLoadedKey, "yes")
+}
+
+/// Ensure that the session is committed
+let private commitSession (ctx : HttpContext) = task {
+    if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync ()
+}
+
+open MyWebLog.ViewModels
+
+/// Add a message to the user's session
+let addMessage (ctx : HttpContext) message = task {
+    do! loadSession ctx
+    let msg = match ctx.Session.Get<UserMessage list> "messages" with Some it -> it | None -> []
+    ctx.Session.Set ("messages", message :: msg)
+}
+
+/// Get any messages from the user's session, removing them in the process
+let messages (ctx : HttpContext) = task {
+    do! loadSession ctx
+    match ctx.Session.Get<UserMessage list> "messages" with
+    | Some msg ->
+        ctx.Session.Remove "messages"
+        return msg |> (List.rev >> Array.ofList)
+    | None -> return [||]
+}
+
+/// Hold variable for the configured generator string
+let mutable private generatorString : string option = None
+
+open Microsoft.Extensions.Configuration
+open Microsoft.Extensions.DependencyInjection
+
+/// Get the generator string
+let generator (ctx : HttpContext) =
+    match generatorString with
+    | Some gen -> gen
+    | None ->
+        let cfg = ctx.RequestServices.GetRequiredService<IConfiguration> ()
+        generatorString <-
+            match Option.ofObj cfg["Generator"] with
+            | Some gen -> Some gen
+            | None -> Some "generator not configured"
+        generatorString.Value
+
+open MyWebLog
+open DotLiquid
+
+/// Either get the web log from the hash, or get it from the cache and add it to the hash
+let private deriveWebLogFromHash (hash : Hash) (ctx : HttpContext) =
+    if hash.ContainsKey "web_log" then () else hash.Add ("web_log", ctx.WebLog)
+    hash["web_log"] :?> WebLog
+
+open Giraffe
+open Giraffe.Htmx
+open Giraffe.ViewEngine
+
+/// htmx script tag
+let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
+
+/// Populate the DotLiquid hash with standard information
+let private populateHash hash ctx = task {
+    // Don't need the web log, but this adds it to the hash if the function is called directly
+    let _ = deriveWebLogFromHash hash ctx
+    let! messages = messages ctx
+    hash.Add ("logged_on",    ctx.User.Identity.IsAuthenticated)
+    hash.Add ("page_list",    PageListCache.get ctx)
+    hash.Add ("current_page", ctx.Request.Path.Value.Substring 1)
+    hash.Add ("messages",     messages)
+    hash.Add ("generator",    generator ctx)
+    hash.Add ("htmx_script",  htmxScript)
+    
+    do! commitSession ctx
+}
+
+/// Render a view for the specified theme, using the specified template, layout, and hash
+let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
+    do! populateHash hash ctx
+    
+    // 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 theme template ctx.Data
+    hash.Add ("content", contentTemplate.Render hash)
+    
+    // ...then render that content with its layout
+    let  isHtmx         = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
+    let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout") ctx.Data
+    
+    return! htmlString (layoutTemplate.Render hash) next ctx
+}
+
+/// Render a bare view for the specified theme, using the specified template and hash
+let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
+    do! populateHash hash ctx
+    
+    // Bare templates are rendered with layout-bare
+    let! contentTemplate = TemplateCache.get theme template ctx.Data
+    hash.Add ("content", contentTemplate.Render hash)
+    
+    let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
+    
+    // add messages as HTTP headers
+    let messages = hash["messages"] :?> UserMessage[]
+    let actions = seq {
+        yield!
+            messages
+            |> Array.map (fun m ->
+                match m.detail with
+                | Some detail -> $"{m.level}|||{m.message}|||{detail}"
+                | None -> $"{m.level}|||{m.message}"
+                |> setHttpHeader "X-Message")
+        withHxNoPush
+        htmlString (layoutTemplate.Render hash)
+        }
+    
+    return! (actions |> Seq.reduce (>=>)) next ctx
+}
+
+/// Return a view for the web log's default theme
+let themedView template next ctx = fun (hash : Hash) -> task {
+    return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash
+}
+
+/// Redirect after doing some action; commits session and issues a temporary redirect
+let redirectToGet url : HttpHandler = fun next ctx -> task {
+    do! commitSession ctx
+    return! redirectTo false url next ctx
+}
+
+open System.Security.Claims
+
+/// Get the user ID for the current request
+let userId (ctx : HttpContext) =
+    WebLogUserId (ctx.User.Claims |> Seq.find (fun c -> c.Type = ClaimTypes.NameIdentifier)).Value
+
+open Microsoft.AspNetCore.Antiforgery
+
+/// Get the Anti-CSRF service
+let private antiForgery (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IAntiforgery> ()
+
+/// Get the cross-site request forgery token set
+let csrfToken (ctx : HttpContext) =
+    (antiForgery ctx).GetAndStoreTokens ctx
+
+/// Validate the cross-site request forgery token in the current request
+let validateCsrf : HttpHandler = fun next ctx -> task {
+    match! (antiForgery ctx).IsRequestValidAsync ctx with
+    | true -> return! next ctx
+    | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" next ctx
+}
+
+/// Require a user to be logged on
+let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
+
+open System.Collections.Generic
+open MyWebLog.Data
+
+/// Get the templates available for the current web log's theme (in a key/value pair list)
+let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask {
+    match! ctx.Data.Theme.findByIdWithoutText (ThemeId ctx.WebLog.themePath) with
+    | Some theme ->
+        return seq {
+            KeyValuePair.Create ("", $"- Default (single-{typ}) -")
+            yield!
+                theme.templates
+                |> Seq.ofList
+                |> Seq.filter (fun it -> it.name.EndsWith $"-{typ}" && it.name <> $"single-{typ}")
+                |> Seq.map (fun it -> KeyValuePair.Create (it.name, it.name))
+        }
+        |> Array.ofSeq
+    | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
+}
+
+/// Get all authors for a list of posts as metadata items
+let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) =
+    posts
+    |> List.map (fun p -> p.authorId)
+    |> List.distinct
+    |> data.WebLogUser.findNames webLog.id
+
+/// Get all tag mappings for a list of posts as metadata items
+let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) =
+    posts
+    |> List.map (fun p -> p.tags)
+    |> List.concat
+    |> List.distinct
+    |> fun tags -> data.TagMap.findMappingForTags tags webLog.id
+
+/// Get all category IDs for the given slug (includes owned subcategories)   
+let getCategoryIds slug ctx =
+    let allCats = CategoryCache.get ctx
+    let cat     = allCats |> Array.find (fun cat -> cat.slug = slug)
+    // Category pages include posts in subcategories
+    allCats
+    |> Seq.ofArray
+    |> Seq.filter (fun c -> c.id = cat.id || Array.contains cat.name c.parentNames)
+    |> Seq.map (fun c -> CategoryId c.id)
+    |> List.ofSeq
+
+open Microsoft.Extensions.Logging
+
+/// Log level for debugging
+let mutable private debugEnabled : bool option = None
+
+/// Is debug enabled for handlers?
+let private isDebugEnabled (ctx : HttpContext) =
+    match debugEnabled with
+    | Some flag -> flag
+    | None ->
+        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+        let log = fac.CreateLogger "MyWebLog.Handlers"
+        debugEnabled <- Some (log.IsEnabled LogLevel.Debug)
+        debugEnabled.Value
+
+/// Log a debug message
+let debug (name : string) ctx msg =
+    if isDebugEnabled ctx then
+        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+        let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
+        log.LogDebug (msg ())
+
+/// Log a warning message
+let warn (name : string) (ctx : HttpContext) msg =
+    let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+    let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
+    log.LogWarning msg
+    

src/MyWebLog/Handlers/Post.fs

@@ -0,0 +1,365 @@
+/// Handlers to manipulate posts
+module MyWebLog.Handlers.Post
+
+open System
+open MyWebLog
+
+/// Parse a slug and page number from an "everything else" URL
+let private parseSlugAndPage webLog (slugAndPage : string seq) =
+    let fullPath = slugAndPage |> Seq.head
+    let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
+    let slugs, isFeed =
+        let feedName = $"/{webLog.rss.feedName}"
+        let notBlank = Array.filter (fun it -> it <> "")
+        if (   (webLog.rss.categoryEnabled && fullPath.StartsWith "/category/")
+            || (webLog.rss.tagEnabled      && fullPath.StartsWith "/tag/"     ))
+           && slugPath.EndsWith feedName then
+            notBlank (slugPath.Replace(feedName, "").Split "/"), true
+        else
+            notBlank (slugPath.Split "/"), false
+    let pageIdx = Array.IndexOf (slugs, "page")
+    let pageNbr =
+        match pageIdx with
+        | -1 -> Some 1
+        | idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1])
+        | _ -> None
+    let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs
+    pageNbr, String.Join ("/", slugParts), isFeed
+
+/// The type of post list being prepared
+type ListType =
+    | AdminList
+    | CategoryList
+    | PostList
+    | SinglePost
+    | TagList
+
+open System.Threading.Tasks
+open DotLiquid
+open MyWebLog.Data
+open MyWebLog.ViewModels
+
+/// Convert a list of posts into items ready to be displayed
+let preparePostList webLog posts listType (url : string) pageNbr perPage ctx (data : IData) = task {
+    let! authors     = getAuthors     webLog posts data
+    let! tagMappings = getTagMappings webLog posts data
+    let  relUrl it   = Some <| WebLog.relativeUrl webLog (Permalink it)
+    let  postItems   =
+        posts
+        |> Seq.ofList
+        |> Seq.truncate perPage
+        |> Seq.map (PostListItem.fromPost webLog)
+        |> Array.ofSeq
+    let! olderPost, newerPost =
+        match listType with
+        | SinglePost ->
+            let post     = List.head posts
+            let dateTime = defaultArg post.publishedOn post.updatedOn
+            data.Post.findSurroundingPosts webLog.id dateTime
+        | _ -> Task.FromResult (None, None)
+    let newerLink =
+        match listType, pageNbr with
+        | SinglePost,   _ -> newerPost |> Option.map (fun p -> Permalink.toString p.permalink)
+        | _,            1 -> None
+        | PostList,     2    when webLog.defaultPage = "posts" -> Some ""
+        | PostList,     _ -> relUrl $"page/{pageNbr - 1}"
+        | CategoryList, 2 -> relUrl $"category/{url}/"
+        | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}"
+        | TagList,      2 -> relUrl $"tag/{url}/"
+        | TagList,      _ -> relUrl $"tag/{url}/page/{pageNbr - 1}"
+        | AdminList,    2 -> relUrl "admin/posts"
+        | AdminList,    _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
+    let olderLink =
+        match listType, List.length posts > perPage with
+        | SinglePost,   _     -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink)
+        | _,            false -> None
+        | PostList,     true  -> relUrl $"page/{pageNbr + 1}"
+        | CategoryList, true  -> relUrl $"category/{url}/page/{pageNbr + 1}"
+        | TagList,      true  -> relUrl $"tag/{url}/page/{pageNbr + 1}"
+        | AdminList,    true  -> relUrl $"admin/posts/page/{pageNbr + 1}"
+    let model =
+        { posts      = postItems
+          authors    = authors
+          subtitle   = None
+          newerLink  = newerLink
+          newerName  = newerPost |> Option.map (fun p -> p.title)
+          olderLink  = olderLink
+          olderName  = olderPost |> Option.map (fun p -> p.title)
+        }
+    return Hash.FromAnonymousObject {|
+        model        = model
+        categories   = CategoryCache.get ctx
+        tag_mappings = tagMappings
+        is_post      = match listType with SinglePost -> true | _ -> false
+    |}
+}
+
+open Giraffe
+
+// GET /page/{pageNbr}
+let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let! posts  = data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage
+    let! hash   = preparePostList webLog posts PostList "" pageNbr webLog.postsPerPage ctx data
+    let  title  =
+        match pageNbr, webLog.defaultPage with
+        | 1, "posts" -> None
+        | _, "posts" -> Some $"Page {pageNbr}"
+        | _,  _      -> Some $"Page {pageNbr} &laquo; Posts"
+    match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
+    if pageNbr = 1 && webLog.defaultPage = "posts" then hash.Add ("is_home", true)
+    return! themedView "index" next ctx hash
+}
+
+// GET /page/{pageNbr}/
+let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx ->
+    redirectTo true (WebLog.relativeUrl ctx.WebLog (Permalink $"page/{pageNbr}")) next ctx
+
+// GET /category/{slug}/
+// GET /category/{slug}/page/{pageNbr}
+let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    let data   = ctx.Data
+    match parseSlugAndPage webLog slugAndPage with
+    | Some pageNbr, slug, isFeed ->
+        match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = slug) with
+        | Some cat when isFeed ->
+            return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.id), $"category/{slug}/{webLog.rss.feedName}"))
+                        (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
+        | Some cat ->
+            // Category pages include posts in subcategories
+            match! data.Post.findPageOfCategorizedPosts webLog.id (getCategoryIds slug ctx) pageNbr webLog.postsPerPage
+                with
+            | posts when List.length posts > 0 ->
+                let! hash = preparePostList webLog posts CategoryList cat.slug pageNbr webLog.postsPerPage ctx data
+                let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
+                hash.Add ("page_title", $"{cat.name}: Category Archive{pgTitle}")
+                hash.Add ("subtitle", defaultArg cat.description "")
+                hash.Add ("is_category", true)
+                hash.Add ("is_category_home", (pageNbr = 1))
+                hash.Add ("slug", slug)
+                return! themedView "index" next ctx hash
+            | _ -> return! Error.notFound next ctx
+        | None -> return! Error.notFound next ctx
+    | None, _, _ -> return! Error.notFound next ctx
+}
+
+open System.Web
+
+// GET /tag/{tag}/
+// GET /tag/{tag}/page/{pageNbr}
+let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    let data   = ctx.Data
+    match parseSlugAndPage webLog slugAndPage with
+    | Some pageNbr, rawTag, isFeed -> 
+        let  urlTag = HttpUtility.UrlDecode rawTag
+        let! tag    = backgroundTask {
+            match! data.TagMap.findByUrlValue urlTag webLog.id with
+            | Some m -> return m.tag
+            | None   -> return urlTag
+        }
+        if isFeed then
+            return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.rss.feedName}"))
+                        (defaultArg webLog.rss.itemsInFeed webLog.postsPerPage) next ctx
+        else
+            match! data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage with
+            | posts when List.length posts > 0 ->
+                let! hash    = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx data
+                let  pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
+                hash.Add ("page_title", $"Posts Tagged &ldquo;{tag}&rdquo;{pgTitle}")
+                hash.Add ("is_tag", true)
+                hash.Add ("is_tag_home", (pageNbr = 1))
+                hash.Add ("slug", rawTag)
+                return! themedView "index" next ctx hash
+            // Other systems use hyphens for spaces; redirect if this is an old tag link
+            | _ ->
+                let spacedTag = tag.Replace ("-", " ")
+                match! data.Post.findPageOfTaggedPosts webLog.id spacedTag pageNbr 1 with
+                | posts when List.length posts > 0 ->
+                    let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
+                    return!
+                        redirectTo true
+                            (WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
+                            next ctx
+                | _ -> return! Error.notFound next ctx
+    | None, _, _ -> return! Error.notFound next ctx
+}
+
+// GET /
+let home : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    match webLog.defaultPage with
+    | "posts" -> return! pageOfPosts 1 next ctx
+    | pageId ->
+        match! ctx.Data.Page.findById (PageId pageId) webLog.id with
+        | Some page ->
+            return!
+                Hash.FromAnonymousObject {|
+                    page       = DisplayPage.fromPage webLog page
+                    categories = CategoryCache.get ctx
+                    page_title = page.title
+                    is_home    = true
+                |}
+                |> themedView (defaultArg page.template "single-page") next ctx
+        | None -> return! Error.notFound next ctx
+}
+
+// GET /admin/posts
+// GET /admin/posts/page/{pageNbr}
+let all pageNbr : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let! posts  = data.Post.findPageOfPosts webLog.id pageNbr 25
+    let! hash   = preparePostList webLog posts AdminList "" pageNbr 25 ctx data
+    hash.Add ("page_title", "Posts")
+    hash.Add ("csrf", csrfToken ctx)
+    return! viewForTheme "admin" "post-list" next ctx hash
+}
+
+// GET /admin/post/{id}/edit
+let edit postId : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let! result = task {
+        match postId with
+        | "new" -> return Some ("Write a New Post", { Post.empty with id = PostId "new" })
+        | _ ->
+            match! data.Post.findFullById (PostId postId) webLog.id with
+            | Some post -> return Some ("Edit Post", post)
+            | None -> return None
+    }
+    match result with
+    | Some (title, post) ->
+        let! cats      = data.Category.findAllForView webLog.id
+        let! templates = templatesForTheme ctx "post"
+        let  model     = EditPostModel.fromPost webLog post
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = model
+                metadata   = Array.zip model.metaNames model.metaValues
+                             |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
+                page_title = title
+                templates  = templates
+                categories = cats
+            |}
+            |> viewForTheme "admin" "post-edit" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// GET /admin/post/{id}/permalinks
+let editPermalinks postId : HttpHandler = fun next ctx -> task {
+    match! ctx.Data.Post.findFullById (PostId postId) ctx.WebLog.id with
+    | Some post ->
+        return!
+            Hash.FromAnonymousObject {|
+                csrf       = csrfToken ctx
+                model      = ManagePermalinksModel.fromPost post
+                page_title = $"Manage Prior Permalinks"
+            |}
+            |> viewForTheme "admin" "permalinks" next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/post/permalinks
+let savePermalinks : HttpHandler = fun next ctx -> task {
+    let  webLog = ctx.WebLog
+    let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
+    let  links  = model.prior |> Array.map Permalink |> List.ofArray
+    match! ctx.Data.Post.updatePriorPermalinks (PostId model.id) webLog.id links with
+    | true ->
+        do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" }
+        return! redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{model.id}/permalinks")) next ctx
+    | false -> return! Error.notFound next ctx
+}
+
+// POST /admin/post/{id}/delete
+let delete postId : HttpHandler = fun next ctx -> task {
+    let webLog = ctx.WebLog
+    match! ctx.Data.Post.delete (PostId postId) webLog.id with
+    | true  -> do! addMessage ctx { UserMessage.success with message = "Post deleted successfully" }
+    | false -> do! addMessage ctx { UserMessage.error with message = "Post not found; nothing deleted" }
+    return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/posts")) next ctx
+}
+
+#nowarn "3511"
+
+// POST /admin/post/save
+let save : HttpHandler = fun next ctx -> task {
+    let! model  = ctx.BindFormAsync<EditPostModel> ()
+    let  webLog = ctx.WebLog
+    let  data   = ctx.Data
+    let  now    = DateTime.UtcNow
+    let! pst    = task {
+        match model.postId with
+        | "new" ->
+            return Some
+                { Post.empty with
+                    id        = PostId.create ()
+                    webLogId  = webLog.id
+                    authorId  = userId ctx
+                }
+        | postId -> return! data.Post.findFullById (PostId postId) webLog.id
+    }
+    match pst with
+    | Some post ->
+        let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" }
+        // Detect a permalink change, and add the prior one to the prior list
+        let post =
+            match Permalink.toString post.permalink with
+            | "" -> post
+            | link when link = model.permalink -> post
+            | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
+        let post =
+            { post with
+                title       = model.title
+                permalink   = Permalink model.permalink
+                publishedOn = if model.doPublish then Some now else post.publishedOn
+                updatedOn   = now
+                text        = MarkupText.toHtml revision.text
+                tags        = model.tags.Split ","
+                              |> Seq.ofArray
+                              |> Seq.map (fun it -> it.Trim().ToLower ())
+                              |> Seq.filter (fun it -> it <> "")
+                              |> Seq.sort
+                              |> List.ofSeq
+                template    = match model.template.Trim () with "" -> None | tmpl -> Some tmpl
+                categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray
+                status      = if model.doPublish then Published else post.status
+                metadata    = Seq.zip model.metaNames model.metaValues
+                              |> Seq.filter (fun it -> fst it > "")
+                              |> Seq.map (fun it -> { name = fst it; value = snd it })
+                              |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
+                              |> List.ofSeq
+                revisions   = match post.revisions |> List.tryHead with
+                              | Some r when r.text = revision.text -> post.revisions
+                              | _ -> revision :: post.revisions
+            }
+        let post =
+            match model.setPublished with
+            | true ->
+                let dt = WebLog.utcTime webLog model.pubOverride.Value
+                match model.setUpdated with
+                | true ->
+                    { post with
+                        publishedOn = Some dt
+                        updatedOn   = dt
+                        revisions   = [ { (List.head post.revisions) with asOf = dt } ]
+                    }
+                | false -> { post with publishedOn = Some dt }
+            | false -> post
+        do! (if model.postId = "new" then data.Post.add else data.Post.update) post
+        // If the post was published or its categories changed, refresh the category cache
+        if model.doPublish
+           || not (pst.Value.categoryIds
+                   |> List.append post.categoryIds
+                   |> List.distinct
+                   |> List.length = List.length pst.Value.categoryIds) then
+            do! CategoryCache.update ctx
+        do! addMessage ctx { UserMessage.success with message = "Post saved successfully" }
+        return!
+            redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/post/{PostId.toString post.id}/edit")) next ctx
+    | None -> return! Error.notFound next ctx
+}

src/MyWebLog/Handlers/Routes.fs

@@ -0,0 +1,240 @@
+/// Routes for this application
+module MyWebLog.Handlers.Routes
+
+open Giraffe
+open Microsoft.AspNetCore.Http
+open MyWebLog
+
+/// Module to resolve routes that do not match any other known route (web blog content) 
+module CatchAll =
+    
+    open DotLiquid
+    open MyWebLog.ViewModels
+    
+    /// Sequence where the first returned value is the proper handler for the link
+    let private deriveAction (ctx : HttpContext) : HttpHandler seq =
+        let webLog   = ctx.WebLog
+        let data     = ctx.Data
+        let debug    = debug "Routes.CatchAll" ctx
+        let textLink =
+            let _, extra = WebLog.hostAndPath webLog
+            let url      = string ctx.Request.Path
+            (if extra = "" then url else url.Substring extra.Length).ToLowerInvariant ()
+        let await it = (Async.AwaitTask >> Async.RunSynchronously) it
+        seq {
+            debug (fun () -> $"Considering URL {textLink}")
+            // Home page directory without the directory slash 
+            if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
+            let permalink = Permalink (textLink.Substring 1)
+            // Current post
+            match data.Post.findByPermalink permalink webLog.id |> await with
+            | Some post ->
+                debug (fun () -> $"Found post by permalink")
+                let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx data |> await
+                model.Add ("page_title", post.title)
+                yield fun next ctx -> themedView (defaultArg post.template "single-post") next ctx model
+            | None -> ()
+            // Current page
+            match data.Page.findByPermalink permalink webLog.id |> await with
+            | Some page ->
+                debug (fun () -> $"Found page by permalink")
+                yield fun next ctx ->
+                    Hash.FromAnonymousObject {|
+                        page       = DisplayPage.fromPage webLog page
+                        categories = CategoryCache.get ctx
+                        page_title = page.title
+                        is_page    = true
+                    |}
+                    |> themedView (defaultArg page.template "single-page") next ctx
+            | None -> ()
+            // RSS feed
+            match Feed.deriveFeedType ctx textLink with
+            | Some (feedType, postCount) ->
+                debug (fun () -> $"Found RSS feed")
+                yield Feed.generate feedType postCount 
+            | None -> ()
+            // Post differing only by trailing slash
+            let altLink =
+                Permalink (if textLink.EndsWith "/" then textLink[1..textLink.Length - 2] else $"{textLink[1..]}/")
+            match data.Post.findByPermalink altLink webLog.id |> await with
+            | Some post ->
+                debug (fun () -> $"Found post by trailing-slash-agnostic permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
+            | None -> ()
+            // Page differing only by trailing slash
+            match data.Page.findByPermalink altLink webLog.id |> await with
+            | Some page ->
+                debug (fun () -> $"Found page by trailing-slash-agnostic permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
+            | None -> ()
+            // Prior post
+            match data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
+            | Some link ->
+                debug (fun () -> $"Found post by prior permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog link)
+            | None -> ()
+            // Prior page
+            match data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id |> await with
+            | Some link ->
+                debug (fun () -> $"Found page by prior permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog link)
+            | None -> ()
+            debug (fun () -> $"No content found")
+        }
+
+    // GET {all-of-the-above}
+    let route : HttpHandler = fun next ctx -> task {
+        match deriveAction ctx |> Seq.tryHead with
+        | Some handler -> return! handler next ctx
+        | None -> return! Error.notFound next ctx
+    }
+
+
+/// Serve theme assets
+module Asset =
+    
+    open System
+    open Microsoft.AspNetCore.Http.Headers
+    open Microsoft.AspNetCore.StaticFiles
+    open Microsoft.Net.Http.Headers
+    
+    /// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
+    let private checkModified asset (ctx : HttpContext) : HttpHandler option =
+        match ctx.Request.Headers.IfModifiedSince with
+        | it when it.Count < 1 -> None
+        | it ->
+            if asset.updatedOn > DateTime.Parse it[0] then
+                None
+            else
+                Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
+    
+    /// An instance of ASP.NET Core's file extension to MIME type converter
+    let private mimeMap = FileExtensionContentTypeProvider ()
+    
+    // GET /theme/{theme}/{**path}
+    let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
+        let path = urlParts |> Seq.skip 1 |> Seq.head
+        match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
+        | Some asset ->
+            match checkModified asset ctx with
+            | Some threeOhFour -> return! threeOhFour next ctx
+            | None ->
+                let mimeType =
+                    match mimeMap.TryGetContentType path with
+                    | true,  typ -> typ
+                    | false, _   -> "application/octet-stream"
+                let headers = ResponseHeaders ctx.Response.Headers
+                headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
+                headers.ContentType  <- MediaTypeHeaderValue mimeType
+                headers.CacheControl <-
+                    let hdr = CacheControlHeaderValue()
+                    hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
+                    hdr
+                return! setBody asset.data next ctx
+        | None -> return! Error.notFound next ctx
+    }
+
+
+/// The primary myWebLog router
+let router : HttpHandler = choose [
+    GET >=> choose [
+        route "/" >=> Post.home
+    ]
+    subRoute "/admin" (requireUser >=> choose [
+        GET >=> choose [
+            subRoute "/categor" (choose [
+                route  "ies"       >=> Admin.listCategories
+                route  "ies/bare"  >=> Admin.listCategoriesBare
+                routef "y/%s/edit"     Admin.editCategory
+            ])
+            route    "/dashboard" >=> Admin.dashboard
+            subRoute "/page" (choose [
+                route  "s"              >=> Admin.listPages 1
+                routef "s/page/%i"          Admin.listPages
+                routef "/%s/edit"           Admin.editPage
+                routef "/%s/permalinks"     Admin.editPagePermalinks
+            ])
+            subRoute "/post" (choose [
+                route  "s"              >=> Post.all 1
+                routef "s/page/%i"          Post.all
+                routef "/%s/edit"           Post.edit
+                routef "/%s/permalinks"     Post.editPermalinks
+            ])
+            subRoute "/settings" (choose [
+                route ""     >=> Admin.settings
+                subRoute "/rss" (choose [
+                    route  ""         >=> Feed.editSettings
+                    routef "/%s/edit"     Feed.editCustomFeed
+                ])
+                subRoute "/tag-mapping" (choose [
+                    route  "s"        >=> Admin.tagMappings
+                    route  "s/bare"   >=> Admin.tagMappingsBare
+                    routef "/%s/edit"     Admin.editMapping
+                ])
+            ])
+            route    "/theme/update" >=> Admin.themeUpdatePage
+            route    "/user/edit"    >=> User.edit
+        ]
+        POST >=> validateCsrf >=> choose [
+            subRoute "/category" (choose [
+                route  "/save"      >=> Admin.saveCategory
+                routef "/%s/delete"     Admin.deleteCategory
+            ])
+            subRoute "/page" (choose [
+                route  "/save"       >=> Admin.savePage
+                route  "/permalinks" >=> Admin.savePagePermalinks
+                routef "/%s/delete"      Admin.deletePage
+            ])
+            subRoute "/post" (choose [
+                route  "/save"       >=> Post.save
+                route  "/permalinks" >=> Post.savePermalinks
+                routef "/%s/delete"      Post.delete
+            ])
+            subRoute "/settings" (choose [
+                route ""     >=> Admin.saveSettings
+                subRoute "/rss" (choose [
+                    route  ""           >=> Feed.saveSettings
+                    route  "/save"      >=> Feed.saveCustomFeed
+                    routef "/%s/delete"     Feed.deleteCustomFeed
+                ])
+                subRoute "/tag-mapping" (choose [
+                    route  "/save"      >=> Admin.saveMapping
+                    routef "/%s/delete"     Admin.deleteMapping
+                ])
+            ])
+            route    "/theme/update" >=> Admin.updateTheme
+            route    "/user/save"    >=> User.save
+        ]
+    ])
+    GET_HEAD >=> routexp "/category/(.*)"  Post.pageOfCategorizedPosts
+    GET_HEAD >=> routef  "/page/%i"        Post.pageOfPosts
+    GET_HEAD >=> routef  "/page/%i/"       Post.redirectToPageOfPosts       
+    GET_HEAD >=> routexp "/tag/(.*)"       Post.pageOfTaggedPosts
+    GET_HEAD >=> routexp "/themes/(.*)"    Asset.serveAsset
+    subRoute "/user" (choose [
+        GET_HEAD >=> choose [
+            route "/log-on"  >=> User.logOn None
+            route "/log-off" >=> User.logOff
+        ]
+        POST >=> validateCsrf >=> choose [
+            route "/log-on" >=> User.doLogOn
+        ]
+    ])
+    GET_HEAD >=> CatchAll.route
+    Error.notFound
+]
+
+/// Wrap a router in a sub-route
+let routerWithPath extraPath : HttpHandler =
+    subRoute extraPath router
+
+/// Handler to apply Giraffe routing with a possible sub-route
+let handleRoute : HttpHandler = fun next ctx -> task {
+    let _, extraPath = WebLog.hostAndPath ctx.WebLog
+    return! (if extraPath = "" then router else routerWithPath extraPath) next ctx
+}
+
+open Giraffe.EndpointRouting
+
+/// Endpoint-routed handler to deal with sub-routes
+let endpoint = [ route "{**url}" handleRoute ]

src/MyWebLog/Handlers/User.fs

@@ -0,0 +1,118 @@
+/// Handlers to manipulate users
+module MyWebLog.Handlers.User
+
+open System
+open System.Security.Cryptography
+open System.Text
+
+/// Hash a password for a given user
+let hashedPassword (plainText : string) (email : string) (salt : Guid) =
+    let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] 
+    use alg     = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
+    Convert.ToBase64String (alg.GetBytes 64)
+
+open DotLiquid
+open Giraffe
+open MyWebLog.ViewModels
+
+// GET /user/log-on
+let logOn returnUrl : HttpHandler = fun next ctx -> task {
+    let returnTo =
+        match returnUrl with
+        | Some _ -> returnUrl
+        | None ->
+            match ctx.Request.Query.ContainsKey "returnUrl" with
+            | true -> Some ctx.Request.Query["returnUrl"].[0]
+            | false -> None
+    return!
+        Hash.FromAnonymousObject {|
+            model      = { LogOnModel.empty with returnTo = returnTo }
+            page_title = "Log On"
+            csrf       = csrfToken ctx
+        |}
+        |> viewForTheme "admin" "log-on" next ctx
+}
+
+open System.Security.Claims
+open Microsoft.AspNetCore.Authentication
+open Microsoft.AspNetCore.Authentication.Cookies
+open MyWebLog
+
+// POST /user/log-on
+let doLogOn : HttpHandler = fun next ctx -> task {
+    let! model  = ctx.BindFormAsync<LogOnModel> ()
+    let  webLog = ctx.WebLog
+    match! ctx.Data.WebLogUser.findByEmail model.emailAddress webLog.id with 
+    | Some user when user.passwordHash = hashedPassword model.password user.userName user.salt ->
+        let claims = seq {
+            Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id)
+            Claim (ClaimTypes.Name,           $"{user.firstName} {user.lastName}")
+            Claim (ClaimTypes.GivenName,      user.preferredName)
+            Claim (ClaimTypes.Role,           user.authorizationLevel.ToString ())
+        }
+        let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
+
+        do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
+            AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
+        do! addMessage ctx
+                { UserMessage.success with message = $"Logged on successfully | Welcome to {webLog.name}!" }
+        return! redirectToGet (defaultArg model.returnTo (WebLog.relativeUrl webLog (Permalink "admin/dashboard")))
+                    next ctx
+    | _ ->
+        do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
+        return! logOn model.returnTo next ctx
+}
+
+// GET /user/log-off
+let logOff : HttpHandler = fun next ctx -> task {
+    do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
+    do! addMessage ctx { UserMessage.info with message = "Log off successful" }
+    return! redirectToGet (WebLog.relativeUrl ctx.WebLog Permalink.empty) next ctx
+}
+
+/// Display the user edit page, with information possibly filled in
+let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task {
+    hash.Add ("page_title", "Edit Your Information")
+    hash.Add ("csrf", csrfToken ctx)
+    return! viewForTheme "admin" "user-edit" next ctx hash
+}
+
+// GET /admin/user/edit
+let edit : HttpHandler = fun next ctx -> task {
+    match! ctx.Data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
+    | Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/user/save
+let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
+    let! model = ctx.BindFormAsync<EditUserModel> ()
+    if model.newPassword = model.newPasswordConfirm then
+        let data = ctx.Data
+        match! data.WebLogUser.findById (userId ctx) ctx.WebLog.id with
+        | Some user ->
+            let pw, salt =
+                if model.newPassword = "" then
+                    user.passwordHash, user.salt
+                else
+                    let newSalt = Guid.NewGuid ()
+                    hashedPassword model.newPassword user.userName newSalt, newSalt
+            let user =
+                { user with
+                    firstName     = model.firstName
+                    lastName      = model.lastName
+                    preferredName = model.preferredName
+                    passwordHash  = pw
+                    salt          = salt
+                }
+            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 (WebLog.relativeUrl ctx.WebLog (Permalink "admin/user/edit")) next ctx
+        | None -> return! Error.notFound next ctx
+    else
+        do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" }
+        return! showEdit (Hash.FromAnonymousObject {|
+                model = { model with newPassword = ""; newPasswordConfirm = "" }
+            |}) next ctx
+}