WIP on messages

src/MyWebLog.Data/Converters.fs

@@ -20,6 +20,13 @@ type CommentIdConverter () =
     override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
         (string >> CommentId) reader.Value
 
+type MarkupTextConverter () =
+    inherit JsonConverter<MarkupText> ()
+    override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) =
+        writer.WriteValue (MarkupText.toString value)
+    override _.ReadJson (reader : JsonReader, _ : Type, _ : MarkupText, _ : bool, _ : JsonSerializer) =
+        (string >> MarkupText.parse) reader.Value
+        
 type PermalinkConverter () =
     inherit JsonConverter<Permalink> ()
     override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) =
@@ -63,6 +70,7 @@ let all () : JsonConverter seq =
         // Our converters
         CategoryIdConverter   ()
         CommentIdConverter    ()
+        MarkupTextConverter   ()
         PermalinkConverter    ()
         PageIdConverter       ()
         PostIdConverter       ()

src/MyWebLog.Data/Data.fs

@@ -40,13 +40,13 @@ module Helpers =
 
     /// Verify that the web log ID matches before returning an item
     let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : IConnection -> Task<'T option>) =
-        fun conn -> task {
+        fun conn -> backgroundTask {
             match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None
         }
     
     /// Get the first item from a list, or None if the list is empty
     let tryFirst<'T> (f : IConnection -> Task<'T list>) =
-        fun conn -> task {
+        fun conn -> backgroundTask {
             let! results = f conn
             return results |> List.tryHead
         }
@@ -59,82 +59,52 @@ open Microsoft.Extensions.Logging
 module Startup =
     
     /// Ensure field indexes exist, as well as special indexes for selected tables
-    let private ensureIndexes (log : ILogger) conn table fields = task {
+    let private ensureIndexes (log : ILogger) conn table fields = backgroundTask {
         let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
         for field in fields do
-            match indexes |> List.contains field with
+            if not (indexes |> List.contains field) then
-            | true -> ()
-            | false ->
                 log.LogInformation($"Creating index {table}.{field}...")
-                let! _ = rethink { withTable table; indexCreate field; write; withRetryOnce conn }
+                do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
-                ()
         // Post and page need index by web log ID and permalink
-        match [ Table.Page; Table.Post ] |> List.contains table with
+        if [ Table.Page; Table.Post ] |> List.contains table then
-        | true ->
+            if not (indexes |> List.contains "permalink") then
-            match indexes |> List.contains "permalink" with
-            | true -> ()
-            | false ->
                 log.LogInformation($"Creating index {table}.permalink...")
-                let! _ =
+                do! rethink {
-                    rethink {
                     withTable table
-                        indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink"))
+                    indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink") :> obj)
-                        write
+                    write; withRetryOnce; ignoreResult conn
-                        withRetryOnce conn
                 }
-                ()
             // Prior permalinks are searched when a post or page permalink do not match the current URL
-            match indexes |> List.contains "priorPermalinks" with
+            if not (indexes |> List.contains "priorPermalinks") then
-            | true -> ()
-            | false ->
                 log.LogInformation($"Creating index {table}.priorPermalinks...")
-                let! _ =
+                do! rethink {
-                    rethink {
                     withTable table
-                        indexCreate "priorPermalinks"
+                    indexCreate "priorPermalinks" [ Multi ]
-                        indexOption Multi
+                    write; withRetryOnce; ignoreResult conn
-                        write
-                        withRetryOnce conn
                 }
-                ()
-        | false -> ()
         // Users log on with e-mail
-        match Table.WebLogUser = table with
+        if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
-        | true ->
-            match indexes |> List.contains "logOn" with
-            | true -> ()
-            | false ->
             log.LogInformation($"Creating index {table}.logOn...")
-                let! _ =
+            do! rethink {
-                    rethink {
                 withTable table
-                        indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName"))
+                indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName") :> obj)
-                        write
+                write; withRetryOnce; ignoreResult conn
-                        withRetryOnce conn
             }
-                ()
-        | false -> ()
     }
 
     /// Ensure all necessary tables and indexes exist
     let ensureDb (config : DataConfig) (log : ILogger) conn = task {
         
         let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
-        match dbs |> List.contains config.Database with
+        if not (dbs |> List.contains config.Database) then
-        | true -> ()
-        | false ->
             log.LogInformation($"Creating database {config.Database}...")
-            let! _ = rethink { dbCreate config.Database; write; withRetryOnce conn }
+            do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn }
-            ()
         
         let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
         for tbl in Table.all do
-            match tables |> List.contains tbl with
+            if not (tables |> List.contains tbl) then
-            | true -> ()
-            | false ->
                 log.LogInformation($"Creating table {tbl}...")
-                let! _ = rethink { tableCreate tbl; write; withRetryOnce conn }
+                do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn }
-                ()
 
         let makeIdx = ensureIndexes log conn
         do! makeIdx Table.Category   [ "webLogId" ]
@@ -154,8 +124,7 @@ module Category =
             withTable Table.Category
             getAll [ webLogId ] (nameof webLogId)
             count
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Count top-level categories for a web log
@@ -165,8 +134,7 @@ module Category =
             getAll [ webLogId ] (nameof webLogId)
             filter "parentId" None
             count
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
 
@@ -178,9 +146,7 @@ module Page =
         rethink {
             withTable Table.Page
             insert page
-            write
+            write; withRetryDefault; ignoreResult
-            withRetryDefault
-            ignoreResult
         }
 
     /// Count all pages for a web log
@@ -189,8 +155,7 @@ module Page =
             withTable Table.Page
             getAll [ webLogId ] (nameof webLogId)
             count
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Count listed pages for a web log
@@ -200,8 +165,7 @@ module Page =
             getAll [ webLogId ] (nameof webLogId)
             filter "showInPageList" true
             count
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Retrieve all pages for a web log (excludes text, prior permalinks, and revisions)
@@ -210,8 +174,7 @@ module Page =
             withTable Table.Page
             getAll [ webLogId ] (nameof webLogId)
             without [ "text", "priorPermalinks", "revisions" ]
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Find a page by its ID (including prior permalinks and revisions)
@@ -219,8 +182,7 @@ module Page =
         rethink<Page> {
             withTable Table.Page
             get pageId
-            resultOption
+            resultOption; withRetryDefault
-            withRetryDefault
         }
         |> verifyWebLog webLogId (fun it -> it.webLogId)
 
@@ -230,8 +192,7 @@ module Page =
             withTable Table.Page
             get pageId
             without [ "priorPermalinks", "revisions" ]
-            resultOption
+            resultOption; withRetryDefault
-            withRetryDefault
         }
         |> verifyWebLog webLogId (fun it -> it.webLogId)
 
@@ -242,8 +203,7 @@ module Page =
             getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
             without [ "priorPermalinks", "revisions" ]
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
     
@@ -255,8 +215,7 @@ module Page =
             filter [ "webLogId", webLogId :> obj ]
             pluck [ "permalink" ]
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
 
@@ -268,8 +227,7 @@ module Page =
             filter [ "showInPageList", true :> obj ]
             without [ "text", "priorPermalinks", "revisions" ]
             orderBy "title"
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Find a list of pages (displayed in admin area)
@@ -281,8 +239,7 @@ module Page =
             orderBy "title"
             skip ((pageNbr - 1) * 25)
             limit 25
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
     
     /// Update a page
@@ -299,9 +256,7 @@ module Page =
                 "priorPermalinks", page.priorPermalinks
                 "revisions",       page.revisions
                 ]
-            write
+            write; withRetryDefault; ignoreResult
-            withRetryDefault
-            ignoreResult
         }
 
 /// Functions to manipulate posts
@@ -314,8 +269,7 @@ module Post =
             getAll [ webLogId ] (nameof webLogId)
             filter "status" status
             count
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
     /// Find a post by its permalink
@@ -325,8 +279,7 @@ module Post =
             getAll [ r.Array(permalink, webLogId) ] (nameof permalink)
             without [ "priorPermalinks", "revisions" ]
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
 
@@ -338,8 +291,7 @@ module Post =
             filter [ "webLogId", webLogId :> obj ]
             pluck [ "permalink" ]
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
 
@@ -353,8 +305,7 @@ module Post =
             orderBy "publishedOn"
             skip ((pageNbr - 1) * postsPerPage)
             limit postsPerPage
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
 
 
@@ -366,9 +317,7 @@ module WebLog =
         rethink {
             withTable Table.WebLog
             insert webLog
-            write
+            write; withRetryOnce; ignoreResult
-            withRetryOnce
-            ignoreResult
         }
     
     /// Retrieve a web log by the URL base
@@ -377,8 +326,7 @@ module WebLog =
             withTable Table.WebLog
             getAll [ url ] "urlBase"
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
 
@@ -387,8 +335,7 @@ module WebLog =
         rethink<WebLog> {
             withTable Table.WebLog
             get webLogId
-            resultOption
+            resultOption; withRetryDefault
-            withRetryDefault
         }
     
     /// Update web log settings
@@ -403,9 +350,7 @@ module WebLog =
                 "postsPerPage", webLog.postsPerPage
                 "timeZone",     webLog.timeZone
                 ]
-            write
+            write; withRetryDefault; ignoreResult
-            withRetryDefault
-            ignoreResult
         }
 
 
@@ -417,9 +362,7 @@ module WebLogUser =
         rethink {
             withTable Table.WebLogUser
             insert user
-            write
+            write; withRetryDefault; ignoreResult
-            withRetryDefault
-            ignoreResult
         }
     
     /// Find a user by their e-mail address
@@ -428,8 +371,7 @@ module WebLogUser =
             withTable Table.WebLogUser
             getAll [ r.Array (webLogId, email) ] "logOn"
             limit 1
-            result
+            result; withRetryDefault
-            withRetryDefault
         }
         |> tryFirst
         

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -6,7 +6,6 @@
 	</PropertyGroup>
 
 	<ItemGroup>
-		<ProjectReference Include="..\..\..\RethinkDb.Driver.FSharp\src\RethinkDb.Driver.FSharp\RethinkDb.Driver.FSharp.fsproj" />
 		<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
 	</ItemGroup>
 
@@ -15,6 +14,7 @@
 		<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
 		<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
 		<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
+		<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0003" />
 	</ItemGroup>
 	
 	<ItemGroup>

src/MyWebLog.Domain/MyWebLog.Domain.fsproj

@@ -11,4 +11,8 @@
     <Compile Include="ViewModels.fs" />
   </ItemGroup>
 
+  <ItemGroup>
+    <PackageReference Include="Markdig" Version="0.28.1" />
+  </ItemGroup>
+
 </Project>

src/MyWebLog.Domain/SupportTypes.fs

@@ -1,6 +1,7 @@
 namespace MyWebLog
 
 open System
+open Markdig
 
 /// Support functions for domain definition
 [<AutoOpen>]
@@ -54,21 +55,38 @@ type CommentStatus =
     | Spam
 
 
-/// The source format for a revision
+/// Types of markup text
-type RevisionSource =
+type MarkupText =
     /// Markdown text
-    | Markdown
+    | Markdown of string
-    /// HTML
+    /// HTML text
-    | Html
+    | Html of string
 
-/// Functions to support revision sources
+/// Functions to support markup text
-module RevisionSource =
+module MarkupText =
     
-    /// Convert a revision source to a string representation
+    /// Pipeline with most extensions enabled
-    let toString = function Markdown -> "Markdown" | Html -> "HTML"
+    let private _pipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().Build ()
+
+    /// Get the source type for the markup text
+    let sourceType = function Markdown _ -> "Markdown" | Html _ -> "HTML"
+    
+    /// Get the raw text, regardless of type
+    let text = function Markdown text -> text | Html text -> text
+    
+    /// Get the string representation of the markup text
+    let toString it = $"{sourceType it}: {text it}"
+    
+    /// Get the HTML representation of the markup text
+    let toHtml = function Markdown text -> Markdown.ToHtml (text, _pipeline) | Html text -> text
+    
+    /// Parse a string into a MarkupText instance
+    let parse (it : string) =
+        match it with
+        | text when text.StartsWith "Markdown: " -> Markdown (text.Substring 10)
+        | text when text.StartsWith "HTML: " -> Html (text.Substring 6)
+        | text -> invalidOp $"Cannot derive type of text ({text})"
 
-    /// Convert a string to a revision source
-    let ofString = function "Markdown" -> Markdown | "HTML" -> Html | x -> invalidArg "string" x
 
 /// A revision of a page or post
 [<CLIMutable; NoComparison; NoEquality>]
@@ -76,11 +94,8 @@ type Revision =
     {   /// When this revision was saved
         asOf : DateTime
 
-        /// The source language (Markdown or HTML)
-        sourceType : RevisionSource
-
         /// The text of the revision
-        text : string
+        text : MarkupText
     }
 
 /// Functions to support revisions
@@ -89,8 +104,7 @@ module Revision =
     /// An empty revision
     let empty =
         { asOf = DateTime.UtcNow
-          sourceType = Html
+          text = Html ""
-          text       = ""
         }
 
 

src/MyWebLog.Domain/ViewModels.fs

@@ -4,6 +4,7 @@ open MyWebLog
 open System
 
 /// Details about a page used to display page lists
+[<NoComparison; NoEquality>]
 type DisplayPage =
     {   /// The ID of this page
         id : string
@@ -40,7 +41,7 @@ type DisplayPage =
 
 
 /// The model to use to allow a user to log on
-[<CLIMutable>]
+[<CLIMutable; NoComparison; NoEquality>]
 type LogOnModel =
     {   /// The user's e-mail address
         emailAddress : string
@@ -51,6 +52,7 @@ type LogOnModel =
 
 
 /// The model used to display the admin dashboard
+[<NoComparison; NoEquality>]
 type DashboardModel =
     {   /// The number of published posts
         posts : int
@@ -73,7 +75,7 @@ type DashboardModel =
 
 
 /// View model to edit a page
-[<CLIMutable>]
+[<CLIMutable; NoComparison; NoEquality>]
 type EditPageModel =
     {   /// The ID of the page being edited
         pageId : string
@@ -84,6 +86,9 @@ type EditPageModel =
         /// The permalink for the page
         permalink : string
 
+        /// The template to use to display the page
+        template : string
+        
         /// Whether this page is shown in the page list
         isShownInPageList : bool
 
@@ -102,14 +107,15 @@ type EditPageModel =
         { pageId            = PageId.toString page.id
           title             = page.title
           permalink         = Permalink.toString page.permalink
+          template          = defaultArg page.template ""
           isShownInPageList = page.showInPageList
-          source = RevisionSource.toString latest.sourceType
+          source            = MarkupText.sourceType latest.text
-          text = latest.text
+          text              = MarkupText.text       latest.text
         }
 
 
 /// View model for editing web log settings
-[<CLIMutable>]
+[<CLIMutable; NoComparison; NoEquality>]
 type SettingsModel =
     {   /// The name of the web log
         name : string
@@ -126,3 +132,34 @@ type SettingsModel =
         /// The time zone in which dates/times should be displayed
         timeZone : string
     }
+
+
+[<CLIMutable; NoComparison; NoEquality>]
+type UserMessage =
+    {   /// The level of the message
+        level : string
+        
+        /// The message
+        message : string
+        
+        /// Further details about the message
+        detail : string option
+    }
+
+/// Functions to support user messages
+module UserMessage =
+    
+    /// An empty user message (use one of the others for pre-filled level)
+    let empty = { level = ""; message = ""; detail = None }
+    
+    /// A blank success message
+    let success = { empty with level = "success" }
+    
+    /// A blank informational message
+    let info = { empty with level = "primary" }
+    
+    /// A blank warning message
+    let warning = { empty with level = "warning" }
+    
+    /// A blank error message
+    let error = { empty with level = "danger" }

src/MyWebLog/Handlers.fs

@@ -36,13 +36,48 @@ module Error =
         setStatusCode 404 >=> text "Not found"
 
 
+open System.Text.Json
+
+/// 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)
+
+    
+open System.Collections.Generic
+
 [<AutoOpen>]
 module private Helpers =
     
-    open Markdig
     open Microsoft.AspNetCore.Antiforgery
     open Microsoft.Extensions.DependencyInjection
     open System.Security.Claims
+    open System.IO
+
+    /// Add a message to the user's session
+    let addMessage (ctx : HttpContext) message = task {
+        do! ctx.Session.LoadAsync ()
+        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! ctx.Session.LoadAsync ()
+        match ctx.Session.Get<UserMessage list> "messages" with
+        | Some msg ->
+            ctx.Session.Remove "messages"
+            return msg |> (List.rev >> Array.ofList)
+        | None -> return [||]
+    }
 
     /// 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 =
@@ -57,9 +92,11 @@ module private Helpers =
     let viewForTheme theme template 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
+        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)
         
         // 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
@@ -105,16 +142,20 @@ module private Helpers =
     /// Require a user to be logged on
     let requireUser = requiresAuthentication Error.notAuthorized
     
-    /// Pipeline with most extensions enabled
+    /// Get the templates available for the current web log's theme (in a key/value pair list)
-    let mdPipeline =
+    let templatesForTheme ctx (typ : string) =
-        MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().Build ()
+        seq {
+            KeyValuePair.Create ("", $"- Default (single-{typ}) -")
+            yield!
+                Directory.EnumerateFiles $"themes/{(WebLogCache.get ctx).themePath}/"
+                |> Seq.filter (fun it -> it.EndsWith $"{typ}.liquid")
+                |> Seq.map (fun it ->
+                    let parts    = it.Split Path.DirectorySeparatorChar
+                    let template = parts[parts.Length - 1].Replace (".liquid", "")
+                    KeyValuePair.Create (template, template))
+        }
+        |> Array.ofSeq
     
-    /// Get the HTML representation of the text of a revision
-    let revisionToHtml (rev : Revision) =
-        match rev.sourceType with Html -> rev.text | Markdown -> Markdown.ToHtml (rev.text, mdPipeline)
-
-
-open System.Collections.Generic
 
 /// Handlers to manipulate admin functions
 module Admin =
@@ -191,8 +232,7 @@ module Admin =
             // Update cache
             WebLogCache.set ctx updated
         
-            // TODO: confirmation message
+            do! addMessage ctx { UserMessage.success with message = "Web log settings saved successfully" }
-
             return! redirectTo false "/admin" next ctx
         | None -> return! Error.notFound next ctx
     }
@@ -216,28 +256,24 @@ module Page =
 
     // GET /page/{id}/edit
     let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task {
-        let! hash = task {
+        let! result = task {
             match pgId with
-            | "new" ->
+            | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" })
-                return
-                    Hash.FromAnonymousObject {|
-                        csrf       = csrfToken ctx
-                        model      = EditPageModel.fromPage { Page.empty with id = PageId "new" }
-                        page_title = "Add a New Page"
-                    |} |> Some
             | _ ->
                 match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with
-                | Some page ->
+                | Some page -> return Some ("Edit Page", page)
-                    return
+                | None -> return None
+        }
+        match result with
+        | Some (title, page) ->
+            return!
                 Hash.FromAnonymousObject {|
                     csrf       = csrfToken ctx
                     model      = EditPageModel.fromPage page
-                            page_title = "Edit Page"
+                    page_title = title
-                        |} |> Some
+                    templates  = templatesForTheme ctx "page"
-                | None -> return None
+                |}
-        }
+                |> viewForTheme "admin" "page-edit" next ctx
-        match hash with
-        | Some h -> return! viewForTheme "admin" "page-edit" next ctx h
         | None -> return! Error.notFound next ctx
     }
 
@@ -262,7 +298,7 @@ module Page =
         match pg with
         | Some page ->
             let updateList = page.showInPageList <> model.isShownInPageList
-            let revision   = { asOf = now; sourceType = RevisionSource.ofString model.source; text = model.text }
+            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
@@ -275,12 +311,13 @@ module Page =
                     permalink      = Permalink model.permalink
                     updatedOn      = now
                     showInPageList = model.isShownInPageList
-                    text           = revisionToHtml revision
+                    template       = match model.template with "" -> None | tmpl -> Some tmpl
+                    text           = MarkupText.toHtml revision.text
                     revisions      = revision :: page.revisions
                 }
             do! (match model.pageId with "new" -> Data.Page.add | _ -> Data.Page.update) page conn
             if updateList then do! PageListCache.update ctx
-            // TODO: confirmation
+            do! addMessage ctx { UserMessage.success with message = "Page saved successfully" }
             return! redirectTo false $"/page/{PageId.toString page.id}/edit" next ctx
         | None -> return! Error.notFound next ctx
     }
@@ -373,7 +410,8 @@ module User =
     // POST /user/log-on
     let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
         let! model  = ctx.BindFormAsync<LogOnModel> ()
-        match! Data.WebLogUser.findByEmail model.emailAddress (webLogId ctx) (conn ctx) with 
+        let  webLog = WebLogCache.get ctx
+        match! Data.WebLogUser.findByEmail model.emailAddress webLog.id (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)
@@ -385,20 +423,21 @@ module User =
 
             do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
                 AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
-
+            do! addMessage ctx
-            // TODO: confirmation message
+                    { UserMessage.success with
-
+                        message = "Logged on successfully"
+                        detail = Some $"Welcome to {webLog.name}!"
+                    }
             return! redirectTo false "/admin" next ctx
         | _ ->
-            // TODO: make error, not 404
+            do! addMessage ctx { UserMessage.error with message = "Log on attempt unsuccessful" }
-            return! Error.notFound next ctx
+            return! logOn 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" }
-        // TODO: confirmation message
-
         return! redirectTo false "/" next ctx
     }
     

src/MyWebLog/MyWebLog.fsproj

@@ -16,7 +16,7 @@
   <ItemGroup>
     <PackageReference Include="DotLiquid" Version="2.2.610" />
     <PackageReference Include="Giraffe" Version="6.0.0" />
-    <PackageReference Include="Markdig" Version="0.28.1" />
+    <PackageReference Include="RethinkDB.DistributedCache" Version="0.9.0-alpha02" />
   </ItemGroup>
 
   <ItemGroup>

src/MyWebLog/Program.fs

@@ -60,8 +60,11 @@ module DotLiquidBespoke =
             |> Seq.iter result.WriteLine
 
 
-/// Initialize a new database
+/// Create the default information for a new web log
-let initDbValidated (args : string[]) (sp : IServiceProvider) = task {
+module NewWebLog =
+    
+    /// Create the web log information
+    let private createWebLog (args : string[]) (sp : IServiceProvider) = task {
         
         let conn = sp.GetRequiredService<IConnection> ()
         
@@ -117,8 +120,7 @@ let initDbValidated (args : string[]) (sp : IServiceProvider) = task {
                     text        = "<p>This is your default home page.</p>"
                     revisions   = [
                         { asOf = DateTime.UtcNow
-                      sourceType = Html
+                          text = Html "<p>This is your default home page.</p>"
-                      text       = "<p>This is your default home page.</p>"
                         }
                     ]
                 } conn
@@ -126,10 +128,10 @@ let initDbValidated (args : string[]) (sp : IServiceProvider) = task {
         Console.WriteLine($"Successfully initialized database for {args[2]} with URL base {args[1]}");
     }
 
-/// Initialize a new database
+    /// Create a new web log
-let initDb args sp = task {
+    let create args sp = task {
         match args |> Array.length with
-    | 5 -> return! initDbValidated args sp
+        | 5 -> return! createWebLog args sp
         | _ ->
             Console.WriteLine "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]"
             return! System.Threading.Tasks.Task.CompletedTask
@@ -145,6 +147,7 @@ open Microsoft.AspNetCore.Builder
 open Microsoft.Extensions.Configuration
 open Microsoft.Extensions.Logging
 open MyWebLog.ViewModels
+open RethinkDB.DistributedCache
 open RethinkDb.Driver.FSharp
 
 [<EntryPoint>]
@@ -177,6 +180,14 @@ let main args =
         } |> Async.AwaitTask |> Async.RunSynchronously
     let _ = builder.Services.AddSingleton<IConnection> conn
     
+    let _ = builder.Services.AddDistributedRethinkDBCache (fun opts ->
+        opts.Database <- rethinkCfg.Database
+        opts.Connection <- conn)
+    let _ = builder.Services.AddSession(fun opts ->
+        opts.IdleTimeout        <- TimeSpan.FromMinutes 30
+        opts.Cookie.HttpOnly    <- true
+        opts.Cookie.IsEssential <- true)
+    
     // Set up DotLiquid
     Template.RegisterFilter typeof<DotLiquidBespoke.NavLinkFilter>
     Template.RegisterTag<DotLiquidBespoke.UserLinksTag> "user_links"
@@ -189,6 +200,7 @@ let main args =
     Template.RegisterSafeType (typeof<DisplayPage>, all)
     Template.RegisterSafeType (typeof<SettingsModel>, all)
     Template.RegisterSafeType (typeof<EditPageModel>, all)
+    Template.RegisterSafeType (typeof<UserMessage>, all)
     
     Template.RegisterSafeType (typeof<AntiforgeryTokenSet>, all)
     Template.RegisterSafeType (typeof<string option>, all)
@@ -197,13 +209,14 @@ let main args =
     let app = builder.Build ()
     
     match args |> Array.tryHead with
-    | Some it when it = "init" -> initDb args app.Services |> Async.AwaitTask |> Async.RunSynchronously
+    | Some it when it = "init" -> NewWebLog.create args app.Services |> Async.AwaitTask |> Async.RunSynchronously
     | _ ->
         let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
         let _ = app.UseMiddleware<WebLogMiddleware> ()
         let _ = app.UseAuthentication ()
         let _ = app.UseStaticFiles ()
         let _ = app.UseRouting ()
+        let _ = app.UseSession ()
         let _ = app.UseGiraffe Handlers.endpoints
 
         app.Run()

src/MyWebLog/appsettings.json

@@ -2,5 +2,11 @@
   "RethinkDB": {
     "hostname": "data02.bitbadger.solutions",
     "database": "myWebLog-dev"
+  },
+  "Logging": {
+    "LogLevel": {
+      "RethinkDB.DistributedCache": "Debug",
+      "RethinkDb.Driver": "Debug"
+    }
   }
 }

src/MyWebLog/themes/admin/dashboard.liquid

@@ -1,4 +1,4 @@
-<h2 class="py-3">{{ web_log.name }} &bull; Dashboard</h2>
+<h2 class="my-3">{{ web_log.name }} &bull; Dashboard</h2>
 <article class="container">
   <div class="row">
     <section class="col-lg-5 offset-lg-1 col-xl-4 offset-xl-2 pb-3">

src/MyWebLog/themes/admin/layout.liquid

@@ -37,6 +37,20 @@
     </nav>
   </header>
   <main class="mx-3">
+    {% if messages %}
+      <div class="messages mt-2">
+        {% for msg in messages %}
+          <div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show">
+            {{ msg.message }}
+            <button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button>
+            {% if msg.detail %}
+              <hr>
+              <p>{{ msg.detail.value }}</p>
+            {% endif %}
+          </div>
+        {% endfor %}
+      </div>
+    {% endif %}
     {{ content }}
   </main>
   <footer>

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

@@ -1,5 +1,5 @@
-<h2 class="py-3">Log On to {{ web_log.name }}</h2>
+<h2 class="my-3">Log On to {{ web_log.name }}</h2>
-<article class="pb-3">
+<article class="py-3">
   <form action="/user/log-on" method="post">
     <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
     <div class="container">

src/MyWebLog/themes/admin/page-edit.liquid

@@ -1,27 +1,33 @@
-<h2 class="py-3">{{ page_title }}</h2>
+<h2 class="my-3">{{ page_title }}</h2>
 <article>
   <form action="/page/save" method="post">
     <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
     <input type="hidden" name="pageId" value="{{ model.page_id }}">
     <div class="container">
       <div class="row mb-3">
-        <div class="col">
+        <div class="col-9">
-          <div class="form-floating">
+          <div class="form-floating pb-3">
             <input type="text" name="title" id="title" class="form-control" autofocus required
                    value="{{ model.title }}">
             <label for="title">Title</label>
           </div>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col-9">
           <div class="form-floating">
             <input type="text" name="permalink" id="permalink" class="form-control" required
                    value="{{ model.permalink }}">
             <label for="permalink">Permalink</label>
           </div>
         </div>
-        <div class="col-3 align-self-center">
+        <div class="col-3">
+          <div class="form-floating pb-3">
+            <select name="template" id="template" class="form-control">
+              {% for tmpl in templates -%}
+                <option value="{{ tmpl[0] }}"{% if model.template == tmpl %} selected="selected"{% endif %}>
+                  {{ tmpl[1] }}
+                </option>
+              {%- endfor %}
+            </select>
+            <label for="template">Page Template</label>
+          </div>
           <div class="form-check form-switch">
             <input type="checkbox" name="isShownInPageList" id="showList" class="form-check-input" value="true"
                    {%- if model.is_shown_in_page_list %} checked="checked"{% endif %}>

src/MyWebLog/themes/admin/page-list.liquid

@@ -1,4 +1,4 @@
-<h2 class="py-3">{{ page_title }}</h2>
+<h2 class="my-3">{{ page_title }}</h2>
 <article class="container">
   <a href="/page/new/edit" class="btn btn-primary btn-sm my-3">Create a New Page</a>
   <table class="table table-sm table-striped table-hover">

src/MyWebLog/themes/admin/settings.liquid

@@ -1,4 +1,4 @@
-<h2 class="py-3">{{ web_log.name }} Settings</h2>
+<h2 class="my-3">{{ web_log.name }} Settings</h2>
 <article>
   <form action="/admin/settings" method="post">
     <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">

src/MyWebLog/themes/default/layout.liquid

@@ -35,6 +35,20 @@
       </nav>
     </header>
     <main class="mx-3">
+      {% if messages %}
+        <div class="messages">
+          {% for msg in messages %}
+            <div role="alert" class="alert alert-{{ msg.level }} alert-dismissible fade show">
+              {{ msg.message }}
+              <button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button>
+              {% if msg.detail %}
+                <hr>
+                <p>{{ msg.detail.value }}</p>
+              {% endif %}
+            </div>
+          {% endfor %}
+        </div>
+      {% endif %}
       {{ content }}  
     </main>
     <footer>
@@ -43,5 +57,8 @@
         <img src="/img/logo-dark.png" alt="myWebLog">
       </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/wwwroot/themes/admin/admin.css

@@ -3,3 +3,7 @@
   border-top: solid 1px black;
   color: white;
 }
+.messages {
+  max-width: 60rem;
+  margin: auto;
+}

src/MyWebLog/wwwroot/themes/default/style.css

@@ -0,0 +1,4 @@
+.messages {
+    max-width: 60rem;
+    margin: auto;
+}