WIP on endpoint routing conversion (#59)

src/Directory.Packages.props

@@ -11,8 +11,8 @@
     <PackageVersion Include="Fluid.Core" Version="2.31.0" />
     <PackageVersion Include="FSharp.Core" Version="10.1.301" />
     <PackageVersion Include="Giraffe" Version="8.2.0" />
-    <PackageVersion Include="Giraffe.Htmx" Version="4.0.0-beta4" />
+    <PackageVersion Include="Giraffe.Htmx" Version="4.0.0-beta5" />
-    <PackageVersion Include="Giraffe.ViewEngine.Htmx" Version="4.0.0-beta4" />
+    <PackageVersion Include="Giraffe.ViewEngine.Htmx" Version="4.0.0-beta5" />
     <PackageVersion Include="Markdig" Version="1.3.2" />
     <PackageVersion Include="Markdown.ColorCode" Version="3.0.1" />
     <PackageVersion Include="Microsoft.Data.Sqlite" Version="10.0.9" />

src/MyWebLog/Handlers/Admin.fs

@@ -10,7 +10,7 @@ open NodaTime
 
 /// ~~~ DASHBOARDS ~~~
 module Dashboard =
-    
+
     // GET /admin/dashboard
     let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
         let getCount (f: WebLogId -> Task<int>) = f ctx.WebLog.Id
@@ -43,7 +43,7 @@ let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
 
 /// ~~~ CACHES ~~~
 module Cache =
-    
+
     // POST /admin/cache/web-log/{id}/refresh
     let refreshWebLog webLogId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
         let data = ctx.Data
@@ -92,17 +92,17 @@ module Cache =
 
 /// ~~~ CATEGORIES ~~~
 module Category =
-    
+
     open MyWebLog.Data
 
     // GET /admin/categories
-    let all : HttpHandler = fun next ctx ->
+    let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
         let response = fun next ctx ->
             adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
         (withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
 
     // GET /admin/category/{id}/edit
-    let edit catId : HttpHandler = fun next ctx -> task {
+    let edit catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
         let! result = task {
             match catId with
             | "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
@@ -166,15 +166,15 @@ module RedirectRules =
     open Microsoft.AspNetCore.Http
 
     // GET /admin/settings/redirect-rules
-    let all : HttpHandler = fun next ctx ->
+    let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
         adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
 
     // GET /admin/settings/redirect-rules/[index]
-    let edit idx : HttpHandler = fun next ctx ->
+    let edit idx : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
         let titleAndView =
             if idx = -1 then
                 Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
-            else        
+            else
                 let rules = ctx.WebLog.RedirectRules
                 if rules.Length < idx || idx < 0 then
                     None
@@ -184,7 +184,7 @@ module RedirectRules =
         match titleAndView with
         | Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
         | None -> Error.notFound next ctx
-        
+
     /// Update the web log's redirect rules in the database, the request web log, and the web log cache
     let private updateRedirectRules (ctx: HttpContext) webLog = backgroundTask {
         do! ctx.Data.WebLog.UpdateRedirectRules webLog
@@ -243,15 +243,15 @@ module RedirectRules =
 
 /// ~~~ TAG MAPPINGS ~~~
 module TagMapping =
-    
+
     // GET /admin/settings/tag-mappings
-    let all : HttpHandler = fun next ctx -> task {
+    let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
         let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
         return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
     }
 
     // GET /admin/settings/tag-mapping/{id}/edit
-    let edit tagMapId : HttpHandler = fun next ctx -> task {
+    let edit tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
         let isNew  = tagMapId = "new"
         let tagMap =
             if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
@@ -290,7 +290,7 @@ module TagMapping =
 
 /// ~~~ THEMES ~~~
 module Theme =
-    
+
     open System
     open System.IO
     open System.IO.Compression
@@ -298,7 +298,7 @@ module Theme =
     open MyWebLog.Data
 
     // GET /admin/theme/list
-    let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { 
+    let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
         let! themes = ctx.Data.Theme.All ()
         return!
             Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
@@ -378,7 +378,7 @@ module Theme =
         let! theme = updateTemplates { theme with Templates = [] } zip
         do! data.Theme.Save theme
         do! updateAssets themeId zip data
-        
+
         return theme
     }
 
@@ -392,7 +392,7 @@ module Theme =
                 let! exists = data.Theme.Exists themeId
                 let  isNew  = not exists
                 let! model  = ctx.BindFormAsync<UploadThemeModel>()
-                if isNew || model.DoOverwrite then 
+                if isNew || model.DoOverwrite then
                     // Load the theme to the database
                     use stream = new MemoryStream()
                     do! themeFile.CopyToAsync stream
@@ -448,11 +448,11 @@ module Theme =
 
 /// ~~~ WEB LOG SETTINGS ~~~
 module WebLog =
-    
+
     open System.IO
 
     // GET /admin/settings
-    let settings : HttpHandler = fun next ctx -> task {
+    let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
         let  data     = ctx.Data
         let! allPages = data.Page.All ctx.WebLog.Id
         let  pages    =
@@ -479,13 +479,13 @@ module WebLog =
 
             // Update cache
             WebLogCache.set webLog
-            
+
             if oldSlug <> webLog.Slug then
                 // Rename disk directory if it exists
                 let uploadRoot = Path.Combine("wwwroot", "upload")
                 let oldDir     = Path.Combine(uploadRoot, oldSlug)
                 if Directory.Exists oldDir then Directory.Move(oldDir, Path.Combine(uploadRoot, webLog.Slug))
-        
+
             do! addMessage ctx { UserMessage.Success with Message = "Web log settings saved successfully" }
             return! redirectToGet "admin/settings" next ctx
         | None -> return! Error.notFound next ctx

src/MyWebLog/Handlers/Post.fs

@@ -96,22 +96,25 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
 
 open Giraffe
 
-// GET /page/{pageNbr}
+// GET /page/{pageNbr}[/]
 let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
-    let  count   = ctx.WebLog.PostsPerPage
+    if ctx.Request.Path.Value.EndsWith "/" then
-    let  data    = ctx.Data
+        return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
-    let! posts   = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
+    else
-    let! viewCtx = preparePostList ctx.WebLog posts PostList "" pageNbr count data
+        let  count   = ctx.WebLog.PostsPerPage
-    let  title   =
+        let  data    = ctx.Data
-        match pageNbr, ctx.WebLog.DefaultPage with
+        let! posts   = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
-        | 1, "posts" -> None
+        let! viewCtx = preparePostList ctx.WebLog posts PostList "" pageNbr count data
-        | _, "posts" -> Some $"Page {pageNbr}"
+        let  title   =
-        | _,  _      -> Some $"Page {pageNbr} « Posts"
+            match pageNbr, ctx.WebLog.DefaultPage with
-    return!
+            | 1, "posts" -> None
-        { viewCtx with
+            | _, "posts" -> Some $"Page {pageNbr}"
-            PageTitle = defaultArg title viewCtx.PageTitle
+            | _,  _      -> Some $"Page {pageNbr} « Posts"
-            IsHome    = pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" }
+        return!
-        |> themedView "index" next ctx
+            { viewCtx with
+                PageTitle = defaultArg title viewCtx.PageTitle
+                IsHome    = pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" }
+            |> themedView "index" next ctx
 }
 
 // GET /page/{pageNbr}/

src/MyWebLog/Handlers/Routes.fs

@@ -1,10 +1,8 @@
 /// Routes for this application
 module MyWebLog.Handlers.Routes
 
-open System.Reflection
 open Giraffe
 open Microsoft.AspNetCore.Http
-open Microsoft.Extensions.FileProviders
 open MyWebLog
 
 /// Module to resolve routes that do not match any other known route (web blog content)
@@ -13,18 +11,12 @@ module CatchAll =
     open System.IO
     open MyWebLog.ViewModels
 
-    /// URLs for the embedded htmx scripts
-    let htmxUrls = [ "giraffe.htmx.common/htmx.min.js"; "giraffe.htmx.common/htmax.min.js" ]
-    
     /// 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 textLink = string ctx.Request.Path
-            let extra = webLog.ExtraPath
-            let url   = string ctx.Request.Path
-            (if extra = "" then url else url[extra.Length..]).ToLowerInvariant()
         let await it = (Async.AwaitTask >> Async.RunSynchronously) it
         seq {
             // Static file
@@ -41,32 +33,6 @@ module CatchAll =
                     |> System.DateTimeOffset
                     |> Some
                     |> streamFile true staticFileName None
-            // Embedded htmx library
-            if htmxUrls |> List.exists textLink.EndsWith then
-                debug (fun () -> "Embedded htmx script")
-                let asm = Assembly.Load "Giraffe.Htmx.Common"
-                asm.GetManifestResourceNames() |> Array.iter (fun it -> debug (fun () -> $"Resource {it}"))
-                let name = textLink.Split("/") |> Array.last |> sprintf "Giraffe.Htmx.Common/%s"
-                use fs = asm.GetManifestResourceStream name
-                if isNull fs then
-                    debug (fun () -> $"No stream found for {name}")
-                else
-                    debug (fun () -> $"Found {name}")
-                    yield streamData true fs None None
-                // let files = EmbeddedFileProvider(Assembly.Load "Giraffe.Htmx.Common")
-                // let cont = files.GetDirectoryContents "."
-                // if cont.Exists then
-                //     debug (fun () -> "Contents found in file provider, here comes the list")
-                //     debug (fun () -> $"%A{cont}")
-                //     cont |> Seq.iter (fun it -> debug (fun () -> "Path = " + it.PhysicalPath))
-                // else
-                //     debug (fun () -> "No contents found in file provider")
-                // let file = files.GetFileInfo (textLink.Replace("giraffe.htmx.common", "Giraffe.Htmx.Common"))
-                // debug (fun () -> $"File info created; {textLink} exists = {file.Exists}")
-                // if file.Exists then
-                //     use contents = file.CreateReadStream()
-                //     yield streamData true contents None None
-                //yield None
             // Home page directory without the directory slash
             if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty)
             let permalink = Permalink textLink[1..]
@@ -149,61 +115,7 @@ module Asset =
 
 /// The primary myWebLog router
 let router : HttpHandler = choose [
-    GET_HEAD >=> choose [
-        route "/" >=> Post.home
-    ]
     subRoute "/admin" (requireUser >=> choose [
-        GET_HEAD >=> choose [
-            route    "/administration" >=> Admin.Dashboard.admin
-            subRoute "/categor" (requireAccess WebLogAdmin >=> choose [
-                route  "ies"       >=> Admin.Category.all
-                routef "y/%s/edit"     Admin.Category.edit
-            ])
-            route    "/dashboard" >=> Admin.Dashboard.user
-            route    "/my-info"   >=> User.myInfo
-            subRoute "/page" (choose [
-                route  "s"                       >=> Page.all 1
-                routef "s/page/%i"                   Page.all
-                routef "/%s/edit"                    Page.edit
-                routef "/%s/permalinks"              Page.editPermalinks
-                routef "/%s/revision/%s/preview"     Page.previewRevision
-                routef "/%s/revisions"               Page.editRevisions
-            ])
-            subRoute "/post" (choose [
-                route  "s"                       >=> Post.all 1
-                routef "s/page/%i"                   Post.all
-                routef "/%s/edit"                    Post.edit
-                routef "/%s/permalinks"              Post.editPermalinks
-                routef "/%s/revision/%s/preview"     Post.previewRevision
-                routef "/%s/revisions"               Post.editRevisions
-                routef "/%s/chapter/%i"              Post.editChapter
-                routef "/%s/chapters"                Post.manageChapters
-            ])
-            subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
-                route    ""             >=> Admin.WebLog.settings
-                routef   "/rss/%s/edit"     Feed.editCustomFeed
-                subRoute "/redirect-rules" (choose [
-                    route  ""    >=> Admin.RedirectRules.all
-                    routef "/%i"     Admin.RedirectRules.edit
-                ])
-                subRoute "/tag-mapping" (choose [
-                    route  "s"        >=> Admin.TagMapping.all
-                    routef "/%s/edit"     Admin.TagMapping.edit
-                ])
-                subRoute "/user" (choose [
-                    route  "s"        >=> User.all
-                    routef "/%s/edit"     User.edit
-                ])
-            ])
-            subRoute "/theme" (choose [
-                route "/list" >=> Admin.Theme.all
-                route "/new"  >=> Admin.Theme.add
-            ])
-            subRoute "/upload" (choose [
-                route "s"    >=> Upload.list
-                route "/new" >=> Upload.showNew
-            ])
-        ]
         POST >=> validateCsrf >=> choose [
             subRoute "/cache" (choose [
                 routef "/theme/%s/refresh"   Admin.Cache.refreshTheme
@@ -271,16 +183,10 @@ let router : HttpHandler = choose [
         ]
     ])
     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.serve
     GET_HEAD >=> routexp "/upload/(.*)"    Upload.serve
     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
         ]
@@ -289,17 +195,70 @@ let router : HttpHandler = choose [
     //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 ->
-    let extraPath = ctx.WebLog.ExtraPath
-    (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 ]
+let endpoints = [
+    GET_HEAD [ route "/" Post.home ]
+    subRoute "/admin" [
+        GET_HEAD [
+            route    "/administration" Admin.Dashboard.admin
+            subRoute "/categor" [
+                route  "ies"       Admin.Category.all
+                routef "y/%s/edit" Admin.Category.edit
+            ]
+            route    "/dashboard" Admin.Dashboard.user
+            route    "/my-info"   User.myInfo
+            subRoute "/page" [
+                route  "s"                       (Page.all 1)
+                routef "s/page/%i"               Page.all
+                routef "/%s/edit"                Page.edit
+                routef "/%s/permalinks"          Page.editPermalinks
+                routef "/%s/revision/%s/preview" Page.previewRevision
+                routef "/%s/revisions"           Page.editRevisions
+            ]
+            subRoute "/post" [
+                route  "s"                       (Post.all 1)
+                routef "s/page/%i"               Post.all
+                routef "/%s/edit"                Post.edit
+                routef "/%s/permalinks"          Post.editPermalinks
+                routef "/%s/revision/%s/preview" Post.previewRevision
+                routef "/%s/revisions"           Post.editRevisions
+                routef "/%s/chapter/%i"          Post.editChapter
+                routef "/%s/chapters"            Post.manageChapters
+            ]
+            subRoute "/settings" [
+                route    ""             Admin.WebLog.settings
+                routef   "/rss/%s/edit" Feed.editCustomFeed
+                subRoute "/redirect-rules" [
+                    route  ""    Admin.RedirectRules.all
+                    routef "/%i" Admin.RedirectRules.edit
+                ]
+                subRoute "/tag-mapping" [
+                    route  "s"        Admin.TagMapping.all
+                    routef "/%s/edit" Admin.TagMapping.edit
+                ]
+                subRoute "/user" [
+                    route  "s"        User.all
+                    routef "/%s/edit" User.edit
+                ]
+            ]
+            subRoute "/theme" [
+                route "/list" Admin.Theme.all
+                route "/new"  Admin.Theme.add
+            ]
+            subRoute "/upload" [
+                route "s"    Upload.list
+                route "/new" Upload.showNew
+            ]
+        ]
+    ]
+    subRoute "/user" [
+        GET_HEAD [ route "/log-on" (User.logOn None) ]
+        POST [
+            route "/log-off" User.logOff
+        ]
+    ]
+    GET_HEAD [ routef "/page/%i" Post.pageOfPosts ]
+    route "{**url}" router
+]

src/MyWebLog/Handlers/User.fs

@@ -47,7 +47,7 @@ let doLogOn : HttpHandler = fun next ctx -> task {
     let! model   = ctx.BindFormAsync<LogOnModel>()
     let  data    = ctx.Data
     let! tryUser = data.WebLogUser.FindByEmail (model.EmailAddress.ToLowerInvariant()) ctx.WebLog.Id
-    match! verifyPassword tryUser model.Password ctx with 
+    match! verifyPassword tryUser model.Password ctx with
     | Ok _ ->
         let user = tryUser.Value
         let claims = seq {
@@ -89,7 +89,7 @@ open Giraffe.Htmx
 let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
 
 // GET /admin/settings/users
-let all : HttpHandler = fun next ctx -> task {
+let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
     return! adminBarePage "User Administration" next ctx (Views.User.userList users)
 }
@@ -97,9 +97,9 @@ let all : HttpHandler = fun next ctx -> task {
 /// Show the edit user page
 let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
     adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
-    
+
 // GET /admin/settings/user/{id}/edit
-let edit usrId : HttpHandler = fun next ctx -> task {
+let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let isNew   = usrId = "new"
     let userId  = WebLogUserId usrId
     let tryUser =

src/MyWebLog/Program.fs

@@ -20,6 +20,9 @@ type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
             ctx.Items["webLog"] <- webLog
             if PageListCache.exists ctx then () else do! PageListCache.update ctx
             if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
+            if webLog.ExtraPath <> "" then
+                ctx.Request.PathBase <- PathString(webLog.ExtraPath)
+                ctx.Request.Path <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..])
             return! next.Invoke ctx
         | None ->
             if isDebug then log.LogDebug $"No resolved web log for {path}"
@@ -242,7 +245,7 @@ let main args =
         let _ = app.UseStaticFiles()
         let _ = app.UseRouting()
         let _ = app.UseSession()
-        let _ = app.UseGiraffe Handlers.Routes.endpoint
+        let _ = app.UseGiraffe Handlers.Routes.endpoints
 
         app.Run()
     }

src/MyWebLog/Template.fs

@@ -174,6 +174,7 @@ let options () =
 
     it
 
+open Giraffe.Htmx.Common
 
 /// <summary>Fluid parser customized with myWebLog filters and tags</summary>
 let parser =
@@ -255,7 +256,7 @@ let parser =
         fun writer encoder context ->
             let webLog = context.App.WebLog
             if webLog.AutoHtmx then
-                context.App.WebLog.RelativeUrl(Permalink "htmx.min.js")
+                context.App.WebLog.RelativeUrl(Permalink StaticAssetUrl.htmx[1..])
                 |> sprintf "%s<script src=\"%s\"></script>" s
                 |> writer.WriteLine
             if assetExists "script.js" webLog then

src/MyWebLog/Views/Helpers.fs

@@ -2,6 +2,7 @@
 [<AutoOpen>]
 module MyWebLog.Views.Helpers
 
+open Giraffe.Htmx
 open Giraffe.ViewEngine
 open Giraffe.ViewEngine.Accessibility
 open Giraffe.ViewEngine.Htmx
@@ -243,7 +244,7 @@ module Layout =
                             ]
                             if app.IsLoggedOn then
                                 li [ _class "nav-item" ] [
-                                    a [ _class "nav-link"; _href (relUrl app "user/log-off"); _hxNoBoost ] [
+                                    a [ _class "nav-link"; _hxPost (relUrl app "user/log-off"); _hxNoBoost ] [
                                         raw "Log Off"
                                     ]
                                 ]
@@ -317,8 +318,7 @@ module Layout =
                 script [ _src "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js"
                          _integrity "sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
                          _crossorigin "anonymous" ] []
-                //script [ _src (relUrl app "htmx.min.js") ] []
+                script [ _src (relUrl app StaticAssetUrl.htmx[1..]) ] []
-                Script.local
                 script [ _src (relUrl app "themes/admin/admin.js") ] []
             ]
         ]
@@ -335,7 +335,6 @@ module Layout =
 
 
 // ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES
-open Giraffe.Htmx.Common
 
 /// <summary>The round-trip instant pattern</summary>
 let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff"