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

@@ -96,13 +96,13 @@ 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,11 +166,11 @@ 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))
@@ -245,13 +245,13 @@ module RedirectRules =
 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" }
@@ -452,7 +452,7 @@ 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    =

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

@@ -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)
 }
@@ -99,7 +99,7 @@ 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"