Add log on; fix DotLiquid rendering

src/MyWebLog.Data/Data.fs

@@ -94,7 +94,7 @@ module Startup =
                 let! _ =
                     rethink {
                         withTable table
-                        indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "email"))
+                        indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName"))
                         write
                         withRetryOnce conn
                     }
@@ -342,3 +342,14 @@ module WebLogUser =
             ignoreResult
         }
     
+    /// Find a user by their e-mail address
+    let findByEmail (email : string) (webLogId : WebLogId) =
+        rethink<WebLogUser list> {
+            withTable Table.WebLogUser
+            getAll [ r.Array (webLogId, email) ] "logOn"
+            limit 1
+            result
+            withRetryDefault
+        }
+        |> tryFirst
+        

src/MyWebLog.Domain/ViewModels.fs

@@ -30,3 +30,25 @@ type SinglePageModel =
     }
     /// Is this the home page?
     member this.isHome with get () = PageId.toString this.page.id = this.webLog.defaultPage
+
+
+/// The model used to display the admin dashboard
+type DashboardModel =
+    {   /// The number of published posts
+        posts : int
+
+        /// The number of post drafts
+        drafts : int
+
+        /// The number of pages
+        pages : int
+
+        /// The number of pages in the page list
+        listedPages : int
+
+        /// The number of categories
+        categories : int
+
+        /// The top-level categories
+        topLevelCategories : int
+    }

src/MyWebLog/Handlers.fs

@@ -1,36 +1,139 @@
 [<RequireQualifiedAccess>]
 module MyWebLog.Handlers
 
+open DotLiquid
 open Giraffe
+open Microsoft.AspNetCore.Http
 open MyWebLog
 open MyWebLog.ViewModels
+open RethinkDb.Driver.Net
 open System
+open System.Net
+open System.Threading.Tasks
+
+/// Handlers for error conditions
+module Error =
+
+    (* open Microsoft.Extensions.Logging *)
+
+    (*/// Handle errors
+    let error (ex : Exception) (log : ILogger) =
+        log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
+        clearResponse
+        >=> setStatusCode 500
+        >=> setHttpHeader "X-Toast" (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message)
+        >=> text ex.Message *)
+
+    /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
+    let notAuthorized : HttpHandler =
+        fun next ctx ->
+            (next, ctx)
+            ||> match ctx.Request.Method with
+                | "GET" -> redirectTo false $"/user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
+                | _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None
+
+    /// 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"
+
 
 [<AutoOpen>]
 module private Helpers =
     
-    open DotLiquid
+    open Microsoft.Extensions.DependencyInjection
     open System.Collections.Concurrent
     open System.IO
     
     /// Cache for parsed templates
-    let private themeViews = ConcurrentDictionary<string, Template> ()
+    module private TemplateCache =
         
-    /// Return a view for a theme
+        /// Cache of parsed templates
-    let themedView<'T> (template : string) (model : obj) : HttpHandler = fun next ctx -> task {
+        let private views = ConcurrentDictionary<string, Template> ()
-        let webLog       = WebLogCache.getByCtx ctx
+        
-        let templatePath = $"themes/{webLog.themePath}/{template}"
+        /// Get a template for the given web log
-        match themeViews.ContainsKey templatePath with
+        let get (theme : string) (templateName : string) = task {
+            let templatePath = $"themes/{theme}/{templateName}"
+            match views.ContainsKey templatePath with
             | true -> ()
             | false ->
                 let! file = File.ReadAllTextAsync $"{templatePath}.liquid"
-            themeViews[templatePath] <- Template.Parse file
+                views[templatePath] <- Template.Parse (file, SyntaxCompatibility.DotLiquid22)
-        let view = themeViews[templatePath].Render (Hash.FromAnonymousObject model)
+            return views[templatePath]
-        return! htmlString view next ctx
+        }
+    
+    /// Either get the web log from the hash, or get it from the cache and add it to the hash
+    let deriveWebLogFromHash (hash : Hash) ctx =
+        match hash.ContainsKey "web_log" with
+        | true -> hash["web_log"] :?> WebLog
+        | false ->
+            let wl = WebLogCache.getByCtx ctx
+            hash.Add ("web_log", wl)
+            wl
+    
+    /// Render a view for the specified theme, using the specified template, layout, and hash
+    let viewForTheme theme template layout next ctx = fun (hash : Hash) -> task {
+        // Don't need the web log, but this adds it to the hash if the function is called directly
+        let _ = deriveWebLogFromHash hash ctx
+        hash.Add ("logged_on", ctx.User.Identity.IsAuthenticated)
+        
+        // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a two-pass
+        //       render; the net effect is a "layout" capability similar to Razor or Pug
+        
+        // Render view content...
+        let! contentTemplate = TemplateCache.get theme template
+        hash.Add ("content", contentTemplate.Render hash)
+        
+        // ...then render that content with its layout
+        let! layoutTemplate = TemplateCache.get theme (defaultArg layout "layout")
+        return! htmlString (layoutTemplate.Render hash) next ctx
+    }
+    
+    /// Return a view for the web log's default theme
+    let themedView template layout next ctx = fun (hash : Hash) -> task {
+        return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template layout next ctx hash
+    }
+    
+    /// The web log ID for the current request
+    let webLogId ctx = (WebLogCache.getByCtx ctx).id
+    
+    let conn (ctx : HttpContext) = ctx.RequestServices.GetRequiredService<IConnection> ()
+
+
+module Admin =
+    
+    // GET /admin/
+    let dashboard : HttpHandler =
+        requiresAuthentication Error.notFound
+        >=> fun next ctx -> task {
+            let webLogId' = webLogId ctx
+            let conn' = conn ctx
+            let getCount (f : WebLogId -> IConnection -> Task<int>) = f webLogId' conn'
+            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" None next ctx
         }
 
 module User =
     
+    open Microsoft.AspNetCore.Authentication;
+    open Microsoft.AspNetCore.Authentication.Cookies
+    open System.Security.Claims
     open System.Security.Cryptography
     open System.Text
     
@@ -40,12 +143,73 @@ module User =
         use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
         Convert.ToBase64String(alg.GetBytes(64))
     
+    // GET /user/log-on
+    let logOn : HttpHandler = fun next ctx -> task {
+        return!
+            Hash.FromAnonymousObject {| page_title = "Log On" |}
+            |> viewForTheme "admin" "log-on" None next ctx
+    }
+    
+    // POST /user/log-on
+    let doLogOn : HttpHandler = fun next ctx -> task {
+        let! model = ctx.BindFormAsync<LogOnModel> ()
+        match! Data.WebLogUser.findByEmail model.emailAddress (webLogId ctx) (conn ctx) 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))
+
+            // TODO: confirmation message
+
+            return! redirectTo false "/admin/" next ctx
+        | _ ->
+            // TODO: make error, not 404
+            return! Error.notFound next ctx
+    }
+
+    let logOff : HttpHandler = fun next ctx -> task {
+        do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
+
+        // TODO: confirmation message
+
+        return! redirectTo false "/" next ctx
+    }
+
 
 module CatchAll =
     
+    // GET /
+    let home : HttpHandler = fun next ctx -> task {
+        let webLog = WebLogCache.getByCtx ctx
+        match webLog.defaultPage with
+        | "posts" ->
+            // TODO: page of posts
+            return! Error.notFound next ctx
+        | pageId ->
+            match! Data.Page.findById (PageId pageId) webLog.id (conn ctx) with
+            | Some page ->
+                return!
+                    Hash.FromAnonymousObject {| page = page; page_title = page.title |}
+                    |> themedView "single-page" page.template next ctx
+            | None -> return! Error.notFound next ctx
+    }
+    
     let catchAll : HttpHandler = fun next ctx -> task {
-        let testPage = { Page.empty with text = "Howdy, folks!" }
+        let webLog = WebLogCache.getByCtx ctx
-        return! themedView "single-page" { page = testPage; webLog = WebLogCache.getByCtx ctx } next ctx
+        let pageId = PageId webLog.defaultPage
+        match! Data.Page.findById pageId webLog.id (conn ctx) with
+        | Some page ->
+            return!
+                Hash.FromAnonymousObject {| page = page; page_title = page.title |}
+                |> themedView "single-page" page.template next ctx
+        | None -> return! Error.notFound next ctx
     }
 
 open Giraffe.EndpointRouting
@@ -53,7 +217,20 @@ open Giraffe.EndpointRouting
 /// The endpoints defined in the above handlers
 let endpoints = [
     GET [
-        route "" CatchAll.catchAll
+        route "/" CatchAll.home
+    ]
+    subRoute "/admin" [
+        GET [
+            route "/" Admin.dashboard
+        ]
+    ]
+    subRoute "/user" [
+        GET [
+            route "/log-on"  User.logOn
+            route "/log-off" User.logOff
+        ]
+        POST [
+            route "/log-on" User.doLogOn
+        ]
     ]
 ]
-    

src/MyWebLog/Program.fs

@@ -103,6 +103,8 @@ let initDb args sp = task {
         return! System.Threading.Tasks.Task.CompletedTask
 }
 
+open DotLiquid
+open MyWebLog.ViewModels
 
 [<EntryPoint>]
 let main args =
@@ -132,6 +134,12 @@ let main args =
         } |> Async.AwaitTask |> Async.RunSynchronously
     let _ = builder.Services.AddSingleton<IConnection> conn
     
+    // Set up DotLiquid
+    let all = [| "*" |]
+    Template.RegisterSafeType (typeof<Page>, all)
+    Template.RegisterSafeType (typeof<WebLog>, all)
+    Template.RegisterSafeType (typeof<DashboardModel>, all)
+
     let app = builder.Build ()
     
     match args |> Array.tryHead with

src/MyWebLog/themes/admin/dashboard.liquid

@@ -0,0 +1,50 @@
+<article class="container pt-3">
+  <div class="row">
+    <section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">
+      <div class="card">
+        <header class="card-header text-white bg-primary">Posts</header>
+        <div class="card-body">
+          <h6 class="card-subtitle text-muted pb-3">
+            Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
+            &nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
+          </h6>
+          <a href="/posts/list" class="btn btn-secondary me-2">View All</a>
+          <a href="/post/new/edit" class="btn btn-primary">Write a New Post</a>
+        </div>
+      </div>
+    </section>
+    <section class="col-lg-5 col-xl-4 pb-3">
+      <div class="card">
+        <header class="card-header text-white bg-primary">Pages</header>
+        <div class="card-body">
+          <h6 class="card-subtitle text-muted pb-3">
+            All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span>
+            &nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span>
+          </h6>
+          <a href="/pages/list" class="btn btn-secondary me-2">View All</a>
+          <a href="/page/new/edit" class="btn btn-primary">Create a New Page</a>
+        </div>
+      </div>
+    </section>
+  </div>
+  <div class="row">
+    <section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">
+      <div class="card">
+        <header class="card-header text-white bg-secondary">Categories</header>
+        <div class="card-body">
+          <h6 class="card-subtitle text-muted pb-3">
+            All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span>
+            &nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span>
+          </h6>
+          <a href="/categories/list" class="btn btn-secondary me-2">View All</a>
+          <a href="/category/new/edit" class="btn btn-secondary">Add a New Category</a>
+        </div>
+      </div>
+    </section>
+  </div>
+  <div class="row pb-3">
+    <div class="col text-end">
+      <a href="/admin/settings" class="btn btn-secondary">Modify Settings</a>
+    </div>
+  </div>
+</article>

src/MyWebLog/themes/admin/layout.liquid

@@ -0,0 +1,47 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta name="viewport" content="width=device-width" />
+    <title>{{ page_title | escape }} &laquo; Admin &laquo; {{ web_log.name | escape }}</title>
+    <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
+          integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
+    <link rel="stylesheet" href="/themes/admin/admin.css">
+  </head>
+  <body>
+  <header>
+    <nav class="navbar navbar-dark bg-dark navbar-expand-md justify-content-start px-2">
+      <div class="container-fluid">
+        <a class="navbar-brand" href="/">{{ web_log.name }}</a>
+        <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
+                aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
+          <span class="navbar-toggler-icon"></span>
+        </button>
+        <div class="collapse navbar-collapse" id="navbarText">
+          <span class="navbar-text">{{ page_title }}</span>
+          <ul class="navbar-nav flex-grow-1 justify-content-end">
+            {% if logged_on -%}
+              <li class="nav-item"><a class="nav-link" href="/admin/">Dashboard</a></li>
+              <li class="nav-item"><a class="nav-link" href="/user/log-off">Log Off</a></li>
+            {%- else -%}
+              <li class="nav-item"><a class="nav-link" href="/user/log-on">Log On</a></li>
+            {%- endif %}
+          </ul>
+        </div>
+      </div>
+    </nav>
+  </header>
+  <main>
+    {{ content }}
+  </main>
+  <footer>
+    <div class="container-fluid">
+      <div class="row">
+        <div class="col-xs-12 text-end"><img src="/img/logo-light.png" alt="myWebLog"></div>
+      </div>
+    </div>
+  </footer>
+  <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
+          integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
+          crossorigin="anonymous"></script>
+  </body>
+</html>

src/MyWebLog/themes/admin/log-on.liquid

@@ -0,0 +1,26 @@
+<h2 class="p-3 ">Log On to {{ web_log.name }}</h2>
+<article class="pb-3">
+  <form action="/user/log-on" method="post">
+    <div class="container">
+      <div class="row pb-3">
+        <div class="col col-md-6 col-lg-4 offset-lg-2">
+          <div class="form-floating">
+            <input type="email" id="email" name="emailAddress" class="form-control" autofocus required>
+            <label for="email">E-mail Address</label>
+          </div>
+        </div>
+        <div class="col col-md-6 col-lg-4">
+          <div class="form-floating">
+            <input type="password" id="password" name="password" class="form-control" required>
+            <label for="password">Password</label>
+          </div>
+        </div>
+      </div>
+      <div class="row pb-3">
+        <div class="col text-center">
+          <button type="submit" class="btn btn-primary">Log On</button>
+        </div>
+      </div>
+    </div>
+  </form>
+</article>

src/MyWebLog/themes/default/_html-head.liquid

@@ -1,11 +0,0 @@
-<!DOCTYPE html>
-<html lang="en">
-<head>
-    <meta charset="utf-8">
-    <meta name="viewport" content="width=device-width">
-    <meta name="generator" content="myWebLog 2">
-    <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
-          integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
-    <link asp-theme="@Model.WebLog.ThemePath" />
-    <title>{{ title | escape }} &laquo; {{ web_log_name | escape }}</title>
-</head>

src/MyWebLog/themes/default/_page-foot.liquid

@@ -1,6 +0,0 @@
-<footer>
-  <hr>
-  <div class="container-fluid text-end">
-    <img src="/img/logo-dark.png" alt="myWebLog">
-  </div>
-</footer>

src/MyWebLog/themes/default/_page-head.liquid

@@ -1,18 +0,0 @@
-<header>
-  <nav class="navbar navbar-light bg-light navbar-expand-md justify-content-start px-2">
-    <div class="container-fluid">
-      <a class="navbar-brand" href="~/">{{ web_log.name }}</a>
-      <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
-              aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
-        <span class="navbar-toggler-icon"></span>
-      </button>
-      <div class="collapse navbar-collapse" id="navbarText">
-        {% if web_log.subtitle -%}
-          <span class="navbar-text">{{ web_log.subtitle | escape }}</span>
-        {%- endif %}
-        @* TODO: list pages for current web log *@
-        @await Html.PartialAsync("_LogOnOffPartial")
-      </div>
-    </div>
-  </nav>
-</header>

src/MyWebLog/themes/default/layout.liquid

@@ -0,0 +1,47 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <meta name="viewport" content="width=device-width">
+    <meta name="generator" content="myWebLog 2">
+    <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
+          integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
+    <link rel="stylesheet" href="/themes/{{ web_log.theme_path }}/style.css">
+    <title>{{ page_title | escape }} &laquo; {{ web_log.name | escape }}</title>
+  </head>
+  <body>
+    <header>
+      <nav class="navbar navbar-light bg-light navbar-expand-md justify-content-start px-2">
+        <div class="container-fluid">
+          <a class="navbar-brand" href="/">{{ web_log.name }}</a>
+          <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarText"
+                  aria-controls="navbarText" aria-expanded="false" aria-label="Toggle navigation">
+            <span class="navbar-toggler-icon"></span>
+          </button>
+          <div class="collapse navbar-collapse" id="navbarText">
+            {% if web_log.subtitle -%}
+              <span class="navbar-text">{{ web_log.subtitle | escape }}</span>
+            {%- endif %}
+            <ul class="navbar-nav flex-grow-1 justify-content-end">
+              {% if logged_on %}
+                <li class="nav-item"><a class="nav-link" href="/admin/">Dashboard</a></li>
+                <li class="nav-item"><a class="nav-link" href="/user/log-off">Log Off</a></li>
+              {% else %}
+                <li class="nav-item"><a class="nav-link" href="/user/log-on">Log On</a></li>
+              {% endif %}
+            </ul>
+          </div>
+        </div>
+      </nav>
+    </header>
+    <main>
+      {{ content }}  
+    </main>
+    <footer>
+      <hr>
+      <div class="container-fluid text-end">
+        <img src="/img/logo-dark.png" alt="myWebLog">
+      </div>
+    </footer>
+  </body>
+</html>

src/MyWebLog/themes/default/single-page.liquid

@@ -1,14 +1,4 @@
-<!DOCTYPE html>
+<h2>{{ page.title }}</h2>
-<html lang="en">
+<article>
-  {{ render "_html-head", title: title, web_log_name: web_log.name }}
-  <body>
-    {{ render "_page-head", web_log: web_log }}
-    <main>
-      <h2>{{ page.title }}</h2>
-      <article>
   {{ page.text }}
-      </article>
+</article>
-    </main>
-    {{ render "_page-foot" }}
-  </body>
-</html>