Fix PostgreSQL v2.1 migration (#44)

fixes #43

.config/dotnet-tools.json

@@ -1,12 +0,0 @@
-{
-  "version": 1,
-  "isRoot": true,
-  "tools": {
-    "fake-cli": {
-      "version": "5.22.0",
-      "commands": [
-        "fake"
-      ]
-    }
-  }
-}

.github/workflows/ci.yml

@@ -0,0 +1,99 @@
+name: Continuous Integration
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+    branches:
+      - main
+  workflow_dispatch:
+env:
+  MWL_TEST_RETHINK_URI: rethinkdb://localhost/mwl_test
+jobs:
+  build_and_test:
+    name: Build / Test
+    runs-on: ubuntu-latest
+
+    strategy:
+      matrix:
+        dotnet-version:
+          - "6.0"
+          - "7.0"
+          - "8.0"
+
+    services:
+      postgres:
+        image: postgres:latest
+        env:
+          POSTGRES_PASSWORD: postgres
+        options: >-
+          --health-cmd pg_isready
+          --health-interval 10s
+          --health-timeout 5s
+          --health-retries 5
+        ports:
+          - 5432:5432
+      rethink:
+        image: rethinkdb:latest
+        ports:
+          - 28015:28015
+    
+    steps:
+      - name: Check Out Code
+        uses: actions/checkout@v4
+      - name: Setup .NET Core SDK
+        uses: actions/setup-dotnet@v4.0.0
+        with:
+          dotnet-version: 8.x
+      - name: Restore dependencies
+        run: dotnet restore src/MyWebLog.sln
+      - name: Build (${{ matrix.dotnet-version }})
+        run: dotnet build src/MyWebLog.sln -f net${{ matrix.dotnet-version }}
+      - name: Test (${{ matrix.dotnet-version }})
+        run: cd src/MyWebLog.Tests; dotnet run -f net${{ matrix.dotnet-version }}
+
+  publish:
+    name: Publish Packages
+    runs-on: ubuntu-latest
+    needs: build_and_test
+    
+    strategy:
+      matrix:
+        ver:
+          - "net6.0"
+          - "net7.0"
+          - "net8.0"
+        os:
+          - "linux-x64"
+          - "win-x64"
+        include:
+          - os: "linux-x64"
+            bz2: true
+          - os: "win-x64"
+            zip: true
+    steps:
+      - name: Check Out Code
+        uses: actions/checkout@v4
+      - name: Setup .NET Core SDK
+        uses: actions/setup-dotnet@v4.0.0
+        with:
+          dotnet-version: 8.x
+      - name: Publish (Release)
+        run: dotnet publish -c Release -f ${{ matrix.ver }} -r ${{ matrix.os }} src/MyWebLog/MyWebLog.fsproj
+      - name: Zip Admin Theme
+        run: cd src/admin-theme; zip -r ../MyWebLog/bin/Release/${{ matrix.ver }}/${{ matrix.os }}/publish/admin-theme.zip *; cd ../..
+      - name: Zip Default Theme
+        run: cd src/default-theme; zip -r ../MyWebLog/bin/Release/${{ matrix.ver }}/${{ matrix.os }}/publish/default-theme.zip *; cd ../..
+      - if: ${{ matrix.bz2 }}
+        name: Create .tar.bz2 Archive
+        run: tar cfj myWebLog-${{ matrix.ver }}-${{ matrix.os }}.tar.bz2 -C src/MyWebLog/bin/Release/${{ matrix.ver }}/${{ matrix.os }}/publish .
+      - if: ${{ matrix.zip }}
+        name: Create .zip Archive
+        run: cd src/MyWebLog/bin/Release/${{ matrix.ver }}/${{ matrix.os }}/publish; zip -r myWebLog-${{ matrix.ver }}-${{ matrix.os }}.zip *; cp myWeb*.zip ../../../../../../..; cd ../../../../../../..
+      - name: Upload Artifacts
+        uses: actions/upload-artifact@v4
+        with:
+          name: package-${{ matrix.ver }}-${{ matrix.os }}
+          path: |
+            *x64.zip
+            *.bz2

.gitignore

@@ -261,7 +261,8 @@ src/MyWebLog/wwwroot/img/daniel-j-summers
 src/MyWebLog/wwwroot/img/bit-badger
 
 .ionide
+.vscode
 src/MyWebLog/appsettings.Production.json
 
 # SQLite database files
-src/MyWebLog/*.db*
+src/MyWebLog/data/*.db*

build.fs

@@ -0,0 +1,166 @@
+open System.IO
+open Fake.Core
+open Fake.DotNet
+open Fake.IO
+open Fake.IO.Globbing.Operators
+
+let execContext = Context.FakeExecutionContext.Create false "build.fsx" []
+Context.setExecutionContext (Context.RuntimeContext.Fake execContext)
+
+/// The output directory for release ZIPs
+let releasePath = "releases"
+
+/// The path to the main project
+let projectPath = "src/MyWebLog"
+
+/// The path and name of the main project
+let projName = $"{projectPath}/MyWebLog.fsproj"
+
+/// The version being packaged (extracted from appsettings.json)
+let version =
+    let settings   = File.ReadAllText $"{projectPath}/appsettings.json"
+    let generator  = settings.Substring (settings.IndexOf "\"Generator\":")
+    let appVersion = generator.Replace("\"Generator\": \"", "")
+    let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"")
+    appVersion.Split ' ' |> Array.last
+    
+/// Zip a theme distributed with myWebLog
+let zipTheme (name : string) (_ : TargetParameter) =
+    let path = $"src/{name}-theme"
+    !! $"{path}/**/*"
+    |> Zip.filesAsSpecs path
+    |> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
+    |> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
+
+/// Frameworks supported by this build
+let frameworks = [ "net6.0"; "net7.0"; "net8.0" ]
+
+/// Publish the project for the given runtime ID    
+let publishFor rid (_ : TargetParameter) =
+    frameworks
+    |> List.iter (fun fwk ->
+        DotNet.publish
+            (fun opts ->
+                { opts with Runtime = Some rid; SelfContained = Some false; NoLogo = true; Framework = Some fwk })
+            projName)
+
+/// Package published output for the given runtime ID
+let packageFor rid (_ : TargetParameter) =
+    frameworks
+    |> List.iter (fun fwk ->
+        let path = $"{projectPath}/bin/Release/{fwk}/%s{rid}/publish"
+        let prodSettings = $"{path}/appsettings.Production.json"
+        if File.exists prodSettings then File.delete prodSettings
+        [   !! $"{path}/**/*"
+            |> Zip.filesAsSpecs path
+            |> Seq.map (fun (orig, dest) ->
+                orig, if dest.StartsWith "MyWebLog" then dest.Replace ("MyWebLog", "myWebLog") else dest)
+            Seq.singleton ($"{releasePath}/admin-theme.zip", "admin-theme.zip")
+            Seq.singleton ($"{releasePath}/default-theme.zip", "default-theme.zip")
+        ]
+        |> Seq.concat
+        |> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{fwk}.{rid}.zip")
+
+
+Target.create "Clean" (fun _ ->
+    !! "src/**/bin"
+    ++ "src/**/obj"
+    |> Shell.cleanDirs 
+    Shell.cleanDir releasePath
+)
+
+Target.create "Build" (fun _ ->
+    DotNet.build (fun opts -> { opts with NoLogo = true }) projName
+)
+
+Target.create "ZipAdminTheme"   (zipTheme "admin")
+Target.create "ZipDefaultTheme" (zipTheme "default")
+
+Target.create "PublishWindows" (publishFor "win-x64")
+Target.create "PackageWindows" (packageFor "win-x64")
+
+Target.create "PublishLinux" (publishFor "linux-x64")
+Target.create "PackageLinux" (packageFor "linux-x64")
+
+Target.create "RepackageLinux" (fun _ ->
+    let workDir = $"{releasePath}/linux"
+    frameworks
+    |> List.iter (fun fwk ->
+        let zipArchive = $"{releasePath}/myWebLog-{version}.{fwk}.linux-x64.zip"
+        let sh command args = 
+            CreateProcess.fromRawCommand command args
+            |> CreateProcess.redirectOutput
+            |> Proc.run
+            |> ignore
+        Shell.mkdir workDir
+        Zip.unzip workDir zipArchive
+        Shell.cd workDir
+        sh "chmod" [ "+x"; "./myWebLog" ]
+        sh "tar" [ "cfj"; $"../myWebLog-{version}.{fwk}.linux-x64.tar.bz2"; "." ]
+        Shell.cd "../.."
+        Shell.rm zipArchive)
+    Shell.rm_rf workDir
+)
+
+Target.create "All" ignore
+
+Target.create "RemoveThemeArchives" (fun _ ->
+    Shell.rm $"{releasePath}/admin-theme.zip"
+    Shell.rm $"{releasePath}/default-theme.zip"
+)
+
+Target.create "CI" ignore
+
+open Fake.Core.TargetOperators
+
+let dependencies = [
+    "Clean"
+      ==> "All"
+
+    "Clean"
+      ?=> "Build"
+      ==> "All"
+
+    "Clean"
+      ?=> "ZipDefaultTheme"
+      ==> "All"
+
+    "Clean"
+      ?=> "ZipAdminTheme"
+      ==> "All"
+
+    "Build"
+      ==> "PublishWindows"
+      ==> "All"
+
+    "Build"
+      ==> "PublishLinux"
+      ==> "All"
+
+    "PublishWindows"
+      ==> "PackageWindows"
+      ==> "All"
+
+    "PublishLinux"
+      ==> "PackageLinux"
+      ==> "All"
+
+    "PackageLinux"
+      ==> "RepackageLinux"
+      ==> "All"
+
+    "All"
+      ==> "RemoveThemeArchives"
+      ==> "CI"
+]
+
+[<EntryPoint>]
+let main args =
+    try
+        match args with
+        | [| target |] -> Target.runOrDefault target
+        | _ -> Target.runOrDefault "All"
+        0
+    with e ->
+        printfn "%A" e
+        1

build.fsproj

@@ -0,0 +1,20 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>net8.0</TargetFramework>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="build.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Fake.Core.Target" Version="6.0.0" />
+    <PackageReference Include="Fake.DotNet.Cli" Version="6.0.0" />
+    <PackageReference Include="Fake.IO.FileSystem" Version="6.0.0" />
+    <PackageReference Include="Fake.IO.Zip" Version="6.0.0" />
+    <PackageReference Include="MSBuild.StructuredLogger" Version="2.2.206" />
+  </ItemGroup>
+
+</Project>

build.fsx

@@ -1,144 +0,0 @@
-#r "paket:
-nuget Fake.DotNet.Cli
-nuget Fake.IO.FileSystem
-nuget Fake.IO.Zip
-nuget Fake.Core.Target //"
-#load ".fake/build.fsx/intellisense.fsx"
-open System.IO
-open Fake.Core
-open Fake.DotNet
-open Fake.IO
-open Fake.IO.Globbing.Operators
-open Fake.Core.TargetOperators
-
-Target.initEnvironment ()
-
-/// The output directory for release ZIPs
-let releasePath = "releases"
-
-/// The path to the main project
-let projectPath = "src/MyWebLog"
-
-/// The path and name of the main project
-let projName = $"{projectPath}/MyWebLog.fsproj"
-
-/// The version being packaged (extracted from appsettings.json)
-let version =
-    let settings   = File.ReadAllText $"{projectPath}/appsettings.json"
-    let generator  = settings.Substring (settings.IndexOf "\"Generator\":")
-    let appVersion = generator.Replace("\"Generator\": \"", "")
-    let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"")
-    appVersion.Split ' ' |> Array.last
-    
-/// Zip a theme distributed with myWebLog
-let zipTheme (name : string) (_ : TargetParameter) =
-    let path = $"src/{name}-theme"
-    !! $"{path}/**/*"
-    |> Zip.filesAsSpecs path //$"src/{name}-theme"
-    |> Seq.filter (fun (_, name) -> not (name.EndsWith ".zip"))
-    |> Zip.zipSpec $"{releasePath}/{name}.zip"
-
-/// Publish the project for the given runtime ID    
-let publishFor rid (_ : TargetParameter) =
-    DotNet.publish (fun opts -> { opts with Runtime = Some rid; SelfContained = Some false; NoLogo = true }) projName
-
-/// Package published output for the given runtime ID
-let packageFor (rid : string) (_ : TargetParameter) =
-    let path = $"{projectPath}/bin/Release/net6.0/{rid}/publish"
-    [ !! $"{path}/**/*"
-        |> Zip.filesAsSpecs path
-        |> Zip.moveToFolder "app"
-      Seq.singleton ($"{releasePath}/admin.zip", "admin.zip")
-      Seq.singleton ($"{releasePath}/default.zip", "default.zip")
-    ]
-    |> Seq.concat
-    |> Zip.zipSpec $"{releasePath}/myWebLog-{version}.{rid}.zip"
-
-
-Target.create "Clean" (fun _ ->
-    !! "src/**/bin"
-    ++ "src/**/obj"
-    |> Shell.cleanDirs 
-    Shell.cleanDir releasePath
-)
-
-Target.create "Build" (fun _ ->
-    DotNet.build (fun opts -> { opts with NoLogo = true }) projName
-)
-
-Target.create "ZipAdminTheme"   (zipTheme "admin")
-Target.create "ZipDefaultTheme" (zipTheme "default")
-
-Target.create "PublishWindows" (publishFor "win-x64")
-Target.create "PackageWindows" (packageFor "win-x64")
-
-Target.create "PublishLinux" (publishFor "linux-x64")
-Target.create "PackageLinux" (packageFor "linux-x64")
-
-Target.create "RepackageLinux" (fun _ ->
-    let workDir = $"{releasePath}/linux"
-    let zipArchive = $"{releasePath}/myWebLog-{version}.linux-x64.zip"
-    let sh command args = 
-        CreateProcess.fromRawCommand command args
-        |> CreateProcess.redirectOutput
-        |> Proc.run
-        |> ignore
-    Shell.mkdir workDir
-    Zip.unzip workDir zipArchive
-    Shell.cd workDir
-    sh "chmod" [ "+x"; "app/MyWebLog" ]
-    sh "tar" [ "cfj"; $"../myWebLog-{version}.linux-x64.tar.bz2"; "." ]
-    Shell.cd "../.."
-    Shell.rm zipArchive
-    Shell.rm_rf workDir
-)
-
-Target.create "All" ignore
-
-Target.create "RemoveThemeArchives" (fun _ ->
-    Shell.rm $"{releasePath}/admin.zip"
-    Shell.rm $"{releasePath}/default.zip"
-)
-
-Target.create "CI" ignore
-
-"Clean"
-  ==> "All"
-
-"Clean"
-  ?=> "Build"
-  ==> "All"
-
-"Clean"
-  ?=> "ZipDefaultTheme"
-  ==> "All"
-
-"Clean"
-  ?=> "ZipAdminTheme"
-  ==> "All"
-
-"Build"
-  ==> "PublishWindows"
-  ==> "All"
-
-"Build"
-  ==> "PublishLinux"
-  ==> "All"
-
-"PublishWindows"
-  ==> "PackageWindows"
-  ==> "All"
-
-"PublishLinux"
-  ==> "PackageLinux"
-  ==> "All"
-
-"PackageLinux"
-  ==> "RepackageLinux"
-  ==> "All"
-
-"All"
-  ==> "RemoveThemeArchives"
-  ==> "CI"
-
-Target.runOrDefault "All"

build.fsx.lock

@@ -1,227 +0,0 @@
-STORAGE: NONE
-RESTRICTION: || (== net6.0) (== netstandard2.0)
-NUGET
-  remote: https://api.nuget.org/v3/index.json
-    BlackFox.VsWhere (1.1)
-      FSharp.Core (>= 4.2.3)
-      Microsoft.Win32.Registry (>= 4.7)
-    Fake.Core.CommandLineParsing (5.22)
-      FParsec (>= 1.1.1)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Context (5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Environment (5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.FakeVar (5.22)
-      Fake.Core.Context (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Process (5.22)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.FakeVar (>= 5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.Core.Trace (>= 5.22)
-      Fake.IO.FileSystem (>= 5.22)
-      FSharp.Core (>= 6.0)
-      System.Collections.Immutable (>= 5.0)
-    Fake.Core.SemVer (5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.String (5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Target (5.22)
-      Fake.Core.CommandLineParsing (>= 5.22)
-      Fake.Core.Context (>= 5.22)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.FakeVar (>= 5.22)
-      Fake.Core.Process (>= 5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.Core.Trace (>= 5.22)
-      FSharp.Control.Reactive (>= 5.0.2)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Tasks (5.22)
-      Fake.Core.Trace (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Trace (5.22)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.FakeVar (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Core.Xml (5.22)
-      Fake.Core.String (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.DotNet.Cli (5.22)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.Process (>= 5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.Core.Trace (>= 5.22)
-      Fake.DotNet.MSBuild (>= 5.22)
-      Fake.DotNet.NuGet (>= 5.22)
-      Fake.IO.FileSystem (>= 5.22)
-      FSharp.Core (>= 6.0)
-      Mono.Posix.NETStandard (>= 1.0)
-      Newtonsoft.Json (>= 13.0.1)
-    Fake.DotNet.MSBuild (5.22)
-      BlackFox.VsWhere (>= 1.1)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.Process (>= 5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.Core.Trace (>= 5.22)
-      Fake.IO.FileSystem (>= 5.22)
-      FSharp.Core (>= 6.0)
-      MSBuild.StructuredLogger (>= 2.1.545)
-    Fake.DotNet.NuGet (5.22)
-      Fake.Core.Environment (>= 5.22)
-      Fake.Core.Process (>= 5.22)
-      Fake.Core.SemVer (>= 5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.Core.Tasks (>= 5.22)
-      Fake.Core.Trace (>= 5.22)
-      Fake.Core.Xml (>= 5.22)
-      Fake.IO.FileSystem (>= 5.22)
-      Fake.Net.Http (>= 5.22)
-      FSharp.Core (>= 6.0)
-      Newtonsoft.Json (>= 13.0.1)
-      NuGet.Protocol (>= 5.11)
-    Fake.IO.FileSystem (5.22)
-      Fake.Core.String (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.IO.Zip (5.22)
-      Fake.Core.String (>= 5.22)
-      Fake.IO.FileSystem (>= 5.22)
-      FSharp.Core (>= 6.0)
-    Fake.Net.Http (5.22)
-      Fake.Core.Trace (>= 5.22)
-      FSharp.Core (>= 6.0)
-    FParsec (1.1.1)
-      FSharp.Core (>= 4.3.4)
-    FSharp.Control.Reactive (5.0.5)
-      FSharp.Core (>= 4.7.2)
-      System.Reactive (>= 5.0 < 6.0)
-    FSharp.Core (6.0.5)
-    Microsoft.Build (17.2)
-      Microsoft.Build.Framework (>= 17.2) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      Microsoft.NET.StringTools (>= 1.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      Microsoft.Win32.Registry (>= 4.3) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
-      System.Collections.Immutable (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      System.Configuration.ConfigurationManager (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      System.Reflection.Metadata (>= 1.6) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
-      System.Security.Principal.Windows (>= 4.7) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
-      System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
-      System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-    Microsoft.Build.Framework (17.2)
-      Microsoft.Win32.Registry (>= 4.3)
-      System.Security.Permissions (>= 4.7)
-    Microsoft.Build.Tasks.Core (17.2)
-      Microsoft.Build.Framework (>= 17.2)
-      Microsoft.Build.Utilities.Core (>= 17.2)
-      Microsoft.NET.StringTools (>= 1.0)
-      Microsoft.Win32.Registry (>= 4.3)
-      System.CodeDom (>= 4.4)
-      System.Collections.Immutable (>= 5.0)
-      System.Reflection.Metadata (>= 1.6)
-      System.Resources.Extensions (>= 4.6)
-      System.Security.Cryptography.Pkcs (>= 4.7)
-      System.Security.Cryptography.Xml (>= 4.7)
-      System.Security.Permissions (>= 4.7)
-      System.Threading.Tasks.Dataflow (>= 6.0)
-    Microsoft.Build.Utilities.Core (17.2)
-      Microsoft.Build.Framework (>= 17.2)
-      Microsoft.NET.StringTools (>= 1.0)
-      Microsoft.Win32.Registry (>= 4.3)
-      System.Collections.Immutable (>= 5.0)
-      System.Configuration.ConfigurationManager (>= 4.7)
-      System.Security.Permissions (>= 4.7) - restriction: == netstandard2.0
-      System.Text.Encoding.CodePages (>= 4.0.1) - restriction: == netstandard2.0
-    Microsoft.NET.StringTools (1.0)
-      System.Memory (>= 4.5.4)
-      System.Runtime.CompilerServices.Unsafe (>= 5.0)
-    Microsoft.NETCore.Platforms (6.0.4) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
-    Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
-    Microsoft.Win32.Registry (5.0)
-      System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
-      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
-      System.Security.AccessControl (>= 5.0)
-      System.Security.Principal.Windows (>= 5.0)
-    Microsoft.Win32.SystemEvents (6.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
-    Mono.Posix.NETStandard (1.0)
-    MSBuild.StructuredLogger (2.1.669)
-      Microsoft.Build (>= 16.10)
-      Microsoft.Build.Framework (>= 16.10)
-      Microsoft.Build.Tasks.Core (>= 16.10)
-      Microsoft.Build.Utilities.Core (>= 16.10)
-    Newtonsoft.Json (13.0.1)
-    NuGet.Common (6.2.1)
-      NuGet.Frameworks (>= 6.2.1)
-    NuGet.Configuration (6.2.1)
-      NuGet.Common (>= 6.2.1)
-      System.Security.Cryptography.ProtectedData (>= 4.4)
-    NuGet.Frameworks (6.2.1)
-    NuGet.Packaging (6.2.1)
-      Newtonsoft.Json (>= 13.0.1)
-      NuGet.Configuration (>= 6.2.1)
-      NuGet.Versioning (>= 6.2.1)
-      System.Security.Cryptography.Cng (>= 5.0)
-      System.Security.Cryptography.Pkcs (>= 5.0)
-    NuGet.Protocol (6.2.1)
-      NuGet.Packaging (>= 6.2.1)
-    NuGet.Versioning (6.2.1)
-    System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
-    System.CodeDom (6.0)
-    System.Collections.Immutable (6.0)
-      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-      System.Runtime.CompilerServices.Unsafe (>= 6.0)
-    System.Configuration.ConfigurationManager (6.0)
-      System.Security.Cryptography.ProtectedData (>= 6.0)
-      System.Security.Permissions (>= 6.0)
-    System.Drawing.Common (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
-      Microsoft.Win32.SystemEvents (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
-    System.Formats.Asn1 (6.0)
-      System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-    System.Memory (4.5.5)
-      System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
-      System.Numerics.Vectors (>= 4.4) - restriction: || (&& (== net6.0) (< netcoreapp2.0)) (== netstandard2.0)
-      System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.1)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= uap10.1)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
-    System.Numerics.Vectors (4.5) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-    System.Reactive (5.0)
-      System.Runtime.InteropServices.WindowsRuntime (>= 4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
-      System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
-    System.Reflection.Metadata (6.0.1)
-      System.Collections.Immutable (>= 6.0)
-    System.Resources.Extensions (6.0)
-      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-    System.Runtime (4.3.1) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
-      Microsoft.NETCore.Platforms (>= 1.1.1)
-      Microsoft.NETCore.Targets (>= 1.1.3)
-    System.Runtime.CompilerServices.Unsafe (6.0)
-    System.Runtime.InteropServices.WindowsRuntime (4.3) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (== netstandard2.0)
-      System.Runtime (>= 4.3)
-    System.Security.AccessControl (6.0)
-      System.Security.Principal.Windows (>= 5.0) - restriction: || (&& (== net6.0) (>= net461)) (== netstandard2.0)
-    System.Security.Cryptography.Cng (5.0)
-      System.Formats.Asn1 (>= 5.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.0))
-    System.Security.Cryptography.Pkcs (6.0.1)
-      System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
-      System.Formats.Asn1 (>= 6.0)
-      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
-      System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
-    System.Security.Cryptography.ProtectedData (6.0)
-    System.Security.Cryptography.Xml (6.0)
-      System.Memory (>= 4.5.4) - restriction: == netstandard2.0
-      System.Security.AccessControl (>= 6.0)
-      System.Security.Cryptography.Pkcs (>= 6.0)
-    System.Security.Permissions (6.0)
-      System.Security.AccessControl (>= 6.0)
-      System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
-    System.Security.Principal.Windows (5.0)
-    System.Text.Encoding.CodePages (6.0)
-      System.Runtime.CompilerServices.Unsafe (>= 6.0)
-    System.Text.Encodings.Web (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      System.Runtime.CompilerServices.Unsafe (>= 6.0)
-    System.Text.Json (6.0.5) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
-      System.Runtime.CompilerServices.Unsafe (>= 6.0)
-      System.Text.Encodings.Web (>= 6.0)
-    System.Threading.Tasks.Dataflow (6.0)
-    System.Threading.Tasks.Extensions (4.5.4) - restriction: || (&& (== net6.0) (>= net472)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (>= uap10.1)) (== netstandard2.0)
-      System.Runtime.CompilerServices.Unsafe (>= 4.5.3) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp2.1)) (&& (== net6.0) (< netstandard1.0)) (&& (== net6.0) (< netstandard2.0)) (&& (== net6.0) (>= wp8)) (== netstandard2.0)
-    System.Windows.Extensions (6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
-      System.Drawing.Common (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))

fake.cmd

@@ -1,2 +0,0 @@
-dotnet tool restore
-dotnet fake %*

fake.sh

@@ -1,7 +0,0 @@
-#!/usr/bin/env bash
-
-set -eu
-set -o pipefail
-
-dotnet tool restore
-dotnet fake "$@"

rethink-case-fix.js

@@ -1,171 +0,0 @@
-
-// Category
-r.db('myWebLog').table('Category').map({
-    Description: r.row('description'),
-    Id: r.row('id'),
-    Name: r.row('name'),
-    ParentId: r.row('parentId'),
-    Slug: r.row('slug'),
-    WebLogId: r.row('webLogId')
-})
-
-// Page
-r.db('myWebLog').table('Page').map({
-    AuthorId: r.row('authorId'),
-    Id: r.row('id'),
-    Metadata: r.row('metadata').map(function (meta) {
-        return { Name: meta('name'), Value: meta('value') }
-    }),
-    Permalink: r.row('permalink'),
-    PriorPermalinks: r.row('priorPermalinks'),
-    PublishedOn: r.row('publishedOn'),
-    Revisions: r.row('revisions').map(function (rev) {
-        return {
-            AsOf: rev('asOf'),
-            Text: rev('text')
-        }
-    }),
-    IsInPageList: r.row('showInPageList'),
-    Template: r.row('template'),
-    Text: r.row('text'),
-    Title: r.row('title'),
-    UpdatedOn: r.row('updatedOn'),
-    WebLogId: r.row('webLogId')
-})
-
-// Post
-r.db('myWebLog').table('Post').map({
-    AuthorId: r.row('authorId'),
-    CategoryIds: r.row('categoryIds'),
-    Episode: r.branch(r.row.hasFields('episode'), {
-        Duration: r.row('episode')('duration'),
-        Length: r.row('episode')('length'),
-        Media: r.row('episode')('media'),
-        MediaType: r.row('episode')('mediaType').default(null),
-        ImageUrl: r.row('episode')('imageUrl').default(null),
-        Subtitle: r.row('episode')('subtitle').default(null),
-        Explicit: r.row('episode')('explicit').default(null),
-        ChapterFile: r.row('episode')('chapterFile').default(null),
-        ChapterType: r.row('episode')('chapterType').default(null),
-        TranscriptUrl: r.row('episode')('transcriptUrl').default(null),
-        TranscriptType: r.row('episode')('transcriptType').default(null),
-        TranscriptLang: r.row('episode')('transcriptLang').default(null),
-        TranscriptCaptions: r.row('episode')('transcriptCaptions').default(null),
-        SeasonNumber: r.row('episode')('seasonNumber').default(null),
-        SeasonDescription: r.row('episode')('seasonDescription').default(null),
-        EpisodeNumber: r.row('episode')('episodeNumber').default(null),
-        EpisodeDescription: r.row('episode')('episodeDescription').default(null)
-    }, null),
-    Id: r.row('id'),
-    Metadata: r.row('metadata').map(function (meta) {
-        return { Name: meta('name'), Value: meta('value') }
-    }),
-    Permalink: r.row('permalink'),
-    PriorPermalinks: r.row('priorPermalinks'),
-    PublishedOn: r.row('publishedOn'),
-    Revisions: r.row('revisions').map(function (rev) {
-        return {
-            AsOf: rev('asOf'),
-            Text: rev('text')
-        }
-    }),
-    Status: r.row('status'),
-    Tags: r.row('tags'),
-    Template: r.row('template').default(null),
-    Text: r.row('text'),
-    Title: r.row('title'),
-    UpdatedOn: r.row('updatedOn'),
-    WebLogId: r.row('webLogId')
-})
-
-// TagMap
-r.db('myWebLog').table('TagMap').map({
-    Id: r.row('id'),
-    Tag: r.row('tag'),
-    UrlValue: r.row('urlValue'),
-    WebLogId: r.row('webLogId')
-})
-
-// Theme
-r.db('myWebLog').table('Theme').map({
-    Id: r.row('id'),
-    Name: r.row('name'),
-    Templates: r.row('templates').map(function (tmpl) {
-        return {
-            Name: tmpl('name'),
-            Text: tmpl('text')
-        }
-    }),
-    Version: r.row('version')
-})
-
-// ThemeAsset
-r.db('myWebLog').table('ThemeAsset').map({
-    Data: r.row('data'),
-    Id: r.row('id'),
-    UpdatedOn: r.row('updatedOn')
-})
-
-// WebLog
-r.db('myWebLog').table('WebLog').map(
-    { AutoHtmx: r.row('autoHtmx'),
-        DefaultPage: r.row('defaultPage'),
-        Id: r.row('id'),
-        Name: r.row('name'),
-        PostsPerPage: r.row('postsPerPage'),
-        Rss: {
-            IsCategoryEnabled: r.row('rss')('categoryEnabled'),
-            Copyright: r.row('rss')('copyright'),
-            CustomFeeds: r.row('rss')('customFeeds').map(function (feed) {
-                return {
-                    Id: feed('id'),
-                    Path: feed('path'),
-                    Podcast: {
-                        DefaultMediaType: feed('podcast')('defaultMediaType'),
-                        DisplayedAuthor: feed('podcast')('displayedAuthor'),
-                        Email: feed('podcast')('email'),
-                        Explicit: feed('podcast')('explicit'),
-                        FundingText: feed('podcast')('fundingText'),
-                        FundingUrl: feed('podcast')('fundingUrl'),
-                        PodcastGuid: feed('podcast')('guid'),
-                        AppleCategory: feed('podcast')('iTunesCategory'),
-                        AppleSubcategory: feed('podcast')('iTunesSubcategory'),
-                        ImageUrl: feed('podcast')('imageUrl'),
-                        ItemsInFeed: feed('podcast')('itemsInFeed'),
-                        MediaBaseUrl: feed('podcast')('mediaBaseUrl'),
-                        Medium: feed('podcast')('medium'),
-                        Subtitle: feed('podcast')('subtitle'),
-                        Summary: feed('podcast')('summary'),
-                        Title: feed('podcast')('title')
-                    },
-                    Source: feed('source')
-                }
-            }),
-            IsFeedEnabled: r.row('rss')('feedEnabled'),
-            FeedName: r.row('rss')('feedName'),
-            ItemsInFeed: r.row('rss')('itemsInFeed'),
-            IsTagEnabled: r.row('rss')('tagEnabled')
-        },
-        Slug: r.row('slug'),
-        Subtitle: r.row('subtitle'),
-        ThemeId: r.row('themePath'),
-        TimeZone: r.row('timeZone'),
-        Uploads: r.row('uploads'),
-        UrlBase: r.row('urlBase')
-    })
-
-// WebLogUser
-r.db('myWebLog').table('WebLogUser').map({
-    AccessLevel: r.row('authorizationLevel'),
-    FirstName: r.row('firstName'),
-    Id: r.row('id'),
-    LastName: r.row('lastName'),
-    PasswordHash: r.row('passwordHash'),
-    PreferredName: r.row('preferredName'),
-    Salt: r.row('salt'),
-    Url: r.row('url'),
-    Email: r.row('userName'),
-    WebLogId: r.row('webLogId'),
-    CreatedOn: r.branch(r.row.hasFields('createdOn'), r.row('createdOn'), r.expr(new Date(0))),
-    LastSeenOn: r.row('lastSeenOn').default(null)
-})

src/.dockerignore

@@ -0,0 +1,4 @@
+**/bin
+**/obj
+**/*.db
+**/appsettings.*.json

src/Directory.Build.props

@@ -0,0 +1,9 @@
+<Project>
+  <PropertyGroup>
+    <TargetFrameworks>net6.0;net7.0;net8.0</TargetFrameworks>
+    <DebugType>embedded</DebugType>
+    <AssemblyVersion>2.1.0.0</AssemblyVersion>
+    <FileVersion>2.1.0.0</FileVersion>
+    <Version>2.1.0</Version>
+  </PropertyGroup>
+</Project>

src/Dockerfile

@@ -0,0 +1,33 @@
+FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
+WORKDIR /mwl
+COPY ./MyWebLog.sln                            ./
+COPY ./Directory.Build.props                   ./
+COPY ./MyWebLog/MyWebLog.fsproj                ./MyWebLog/
+COPY ./MyWebLog.Data/MyWebLog.Data.fsproj      ./MyWebLog.Data/
+COPY ./MyWebLog.Domain/MyWebLog.Domain.fsproj  ./MyWebLog.Domain/
+COPY ./MyWebLog.Tests/MyWebLog.Tests.fsproj    ./MyWebLog.Tests/
+RUN dotnet restore
+
+COPY . ./
+WORKDIR /mwl/MyWebLog
+RUN dotnet publish -f net8.0 -c Release -r linux-x64 --no-self-contained -p:PublishSingleFile=false
+
+FROM alpine AS theme
+RUN apk add --no-cache zip
+WORKDIR /themes/default-theme
+COPY ./default-theme ./
+RUN zip -r ../default-theme.zip ./*
+WORKDIR /themes/admin-theme
+COPY ./admin-theme ./
+RUN zip -r ../admin-theme.zip ./*
+
+FROM  mcr.microsoft.com/dotnet/aspnet:8.0-alpine as final
+WORKDIR /app
+RUN apk add --no-cache icu-libs
+ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false
+COPY --from=build /mwl/MyWebLog/bin/Release/net8.0/linux-x64/publish/ ./
+COPY --from=theme /themes/*.zip /app/
+RUN mkdir themes
+
+EXPOSE 80
+CMD [ "dotnet", "/app/MyWebLog.dll" ]

src/MyWebLog.Data/Converters.fs

@@ -12,123 +12,132 @@ module Json =
     type CategoryIdConverter() =
         inherit JsonConverter<CategoryId>()
         override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
-            writer.WriteValue (CategoryId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
             (string >> CategoryId) reader.Value
 
     type CommentIdConverter() =
         inherit JsonConverter<CommentId>()
         override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
-            writer.WriteValue (CommentId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
             (string >> CommentId) reader.Value
 
+    type CommentStatusConverter() =
+        inherit JsonConverter<CommentStatus>()
+        override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
+            writer.WriteValue(string value)
+        override _.ReadJson(reader: JsonReader, _: Type, _: CommentStatus, _: bool, _: JsonSerializer) =
+            (string >> CommentStatus.Parse) reader.Value
+
     type CustomFeedIdConverter() =
         inherit JsonConverter<CustomFeedId>()
         override _.WriteJson(writer: JsonWriter, value: CustomFeedId, _: JsonSerializer) =
-            writer.WriteValue (CustomFeedId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
             (string >> CustomFeedId) reader.Value
 
     type CustomFeedSourceConverter() =
         inherit JsonConverter<CustomFeedSource>()
         override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
-            writer.WriteValue (CustomFeedSource.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
-            (string >> CustomFeedSource.parse) reader.Value
+            (string >> CustomFeedSource.Parse) reader.Value
             
     type ExplicitRatingConverter() =
         inherit JsonConverter<ExplicitRating>()
         override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
-            writer.WriteValue (ExplicitRating.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
-            (string >> ExplicitRating.parse) reader.Value
+            (string >> ExplicitRating.Parse) reader.Value
         
     type MarkupTextConverter() =
         inherit JsonConverter<MarkupText>()
         override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
-            writer.WriteValue (MarkupText.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
-            (string >> MarkupText.parse) reader.Value
+            (string >> MarkupText.Parse) reader.Value
             
     type PermalinkConverter() =
         inherit JsonConverter<Permalink>()
         override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
-            writer.WriteValue (Permalink.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
             (string >> Permalink) reader.Value
 
     type PageIdConverter() =
         inherit JsonConverter<PageId>()
         override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
-            writer.WriteValue (PageId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
             (string >> PageId) reader.Value
 
     type PodcastMediumConverter() =
         inherit JsonConverter<PodcastMedium>()
         override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
-            writer.WriteValue (PodcastMedium.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
-            (string >> PodcastMedium.parse) reader.Value
+            (string >> PodcastMedium.Parse) reader.Value
 
     type PostIdConverter() =
         inherit JsonConverter<PostId>()
         override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
-            writer.WriteValue (PostId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
             (string >> PostId) reader.Value
 
     type TagMapIdConverter() =
         inherit JsonConverter<TagMapId>()
         override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
-            writer.WriteValue (TagMapId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
             (string >> TagMapId) reader.Value
 
     type ThemeAssetIdConverter() =
         inherit JsonConverter<ThemeAssetId>()
         override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
-            writer.WriteValue (ThemeAssetId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
-            (string >> ThemeAssetId.ofString) reader.Value
+            (string >> ThemeAssetId.Parse) reader.Value
 
     type ThemeIdConverter() =
         inherit JsonConverter<ThemeId>()
         override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
-            writer.WriteValue (ThemeId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
             (string >> ThemeId) reader.Value
     
     type UploadIdConverter() =
         inherit JsonConverter<UploadId>()
         override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
-            writer.WriteValue (UploadId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
             (string >> UploadId) reader.Value
     
     type WebLogIdConverter() =
         inherit JsonConverter<WebLogId>()
         override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
-            writer.WriteValue (WebLogId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
             (string >> WebLogId) reader.Value
 
     type WebLogUserIdConverter() =
         inherit JsonConverter<WebLogUserId> ()
         override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
-            writer.WriteValue (WebLogUserId.toString value)
+            writer.WriteValue(string value)
         override _.ReadJson(reader: JsonReader, _: Type, _: WebLogUserId, _: bool, _: JsonSerializer) =
             (string >> WebLogUserId) reader.Value
 
     open Microsoft.FSharpLu.Json
+    open NodaTime
+    open NodaTime.Serialization.JsonNet
     
-    /// All converters to use for data conversion
+    /// Configure a serializer to use these converters
-    let all () : JsonConverter seq =
+    let configure (ser : JsonSerializer) =
-        seq {
         // Our converters
-            CategoryIdConverter       ()
+        [ CategoryIdConverter() :> JsonConverter
           CommentIdConverter()
+          CommentStatusConverter()
           CustomFeedIdConverter()
           CustomFeedSourceConverter()
           ExplicitRatingConverter()
@@ -142,7 +151,37 @@ module Json =
           ThemeIdConverter()
           UploadIdConverter()
           WebLogIdConverter()
-            WebLogUserIdConverter     ()
+          WebLogUserIdConverter() ]
+        |> List.iter ser.Converters.Add
+        // NodaTime
+        let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
         // Handles DUs with no associated data, as well as option fields
-            CompactUnionJsonConverter ()
+        ser.Converters.Add(CompactUnionJsonConverter())
-        }
+        ser.NullValueHandling     <- NullValueHandling.Ignore
+        ser.MissingMemberHandling <- MissingMemberHandling.Ignore
+        ser
+    
+    /// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
+    let mutable private serializerSettings : JsonSerializerSettings option = None
+    
+    /// Extract settings from the serializer to be used in JsonConvert calls
+    let settings (ser : JsonSerializer) =
+        if Option.isNone serializerSettings then
+            serializerSettings <- JsonSerializerSettings (
+                ConstructorHandling            = ser.ConstructorHandling,
+                ContractResolver               = ser.ContractResolver,
+                Converters                     = ser.Converters,
+                DefaultValueHandling           = ser.DefaultValueHandling,
+                DateFormatHandling             = ser.DateFormatHandling,
+                DateParseHandling              = ser.DateParseHandling,
+                MetadataPropertyHandling       = ser.MetadataPropertyHandling,
+                MissingMemberHandling          = ser.MissingMemberHandling,
+                NullValueHandling              = ser.NullValueHandling,
+                ObjectCreationHandling         = ser.ObjectCreationHandling,
+                ReferenceLoopHandling          = ser.ReferenceLoopHandling,
+                SerializationBinder            = ser.SerializationBinder,
+                TraceWriter                    = ser.TraceWriter,
+                TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling,
+                TypeNameHandling               = ser.TypeNameHandling)
+                |> Some
+        serializerSettings.Value

src/MyWebLog.Data/Interfaces.fs

@@ -1,9 +1,21 @@
 namespace MyWebLog.Data
 
-open System
 open System.Threading.Tasks
 open MyWebLog
 open MyWebLog.ViewModels
+open Newtonsoft.Json
+open NodaTime
+
+/// The result of a category deletion attempt
+[<Struct>]
+type CategoryDeleteResult =
+    /// The category was deleted successfully
+    | CategoryDeleted
+    /// The category was deleted successfully, and its children were reassigned to its parent
+    | ReassignedChildCategories
+    /// The category was not found, so no effort was made to delete it
+    | CategoryNotFound
+
 
 /// Data functions to support manipulating categories
 type ICategoryData =
@@ -18,10 +30,10 @@ type ICategoryData =
     abstract member CountTopLevel : WebLogId -> Task<int>
     
     /// Delete a category (also removes it from posts)
-    abstract member Delete : CategoryId -> WebLogId -> Task<bool>
+    abstract member Delete : CategoryId -> WebLogId -> Task<CategoryDeleteResult>
     
     /// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
-    abstract member FindAllForView : WebLogId -> Task<DisplayCategory[]>
+    abstract member FindAllForView : WebLogId -> Task<DisplayCategory array>
     
     /// Find a category by its ID
     abstract member FindById : CategoryId -> WebLogId -> Task<Category option>
@@ -42,7 +54,7 @@ type IPageData =
     /// Add a page
     abstract member Add : Page -> Task<unit>
     
-    /// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks)
+    /// Get all pages for the web log (excluding text, metadata, revisions, and prior permalinks)
     abstract member All : WebLogId -> Task<Page list>
     
     /// Count all pages for the given web log
@@ -116,7 +128,7 @@ type IPostData =
     abstract member FindPageOfCategorizedPosts :
         WebLogId -> CategoryId list -> pageNbr: int -> postsPerPage: int -> Task<Post list>
     
-    /// Find posts to be displayed on an admin page (excluding revisions and prior permalinks)
+    /// Find posts to be displayed on an admin page (excluding text, revisions, and prior permalinks)
     abstract member FindPageOfPosts : WebLogId -> pageNbr: int -> postsPerPage: int -> Task<Post list>
     
     /// Find posts to be displayed on a page (excluding revisions and prior permalinks)
@@ -127,7 +139,7 @@ type IPostData =
         WebLogId -> tag : string -> pageNbr: int -> postsPerPage: int -> Task<Post list>
     
     /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
-    abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
+    abstract member FindSurroundingPosts : WebLogId -> publishedOn: Instant -> Task<Post option * Post option>
     
     /// Restore posts from a backup
     abstract member Restore : Post list -> Task<unit>
@@ -167,9 +179,15 @@ type ITagMapData =
 /// Functions to manipulate themes
 type IThemeData =
     
-    /// Retrieve all themes (except "admin")
+    /// Retrieve all themes (except "admin") (excluding the text of templates)
     abstract member All : unit -> Task<Theme list>
     
+    /// Delete a theme
+    abstract member Delete : ThemeId -> Task<bool>
+    
+    /// Determine if a theme exists
+    abstract member Exists : ThemeId -> Task<bool>
+    
     /// Find a theme by its ID
     abstract member FindById : ThemeId -> Task<Theme option>
     
@@ -242,6 +260,9 @@ type IWebLogData =
     /// Find a web log by its ID
     abstract member FindById : WebLogId -> Task<WebLog option>
     
+    /// Update redirect rules for a web log
+    abstract member UpdateRedirectRules : WebLog -> Task<unit>
+    
     /// Update RSS options for a web log
     abstract member UpdateRssOptions : WebLog -> Task<unit>
     
@@ -310,6 +331,9 @@ type IData =
     /// Web log user data functions
     abstract member WebLogUser : IWebLogUserData
     
+    /// A JSON serializer for use in persistence
+    abstract member Serializer : JsonSerializer
+    
     /// Do any required start up data checks
     abstract member StartUp : unit -> Task<unit>
     

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -1,23 +1,21 @@
 <Project Sdk="Microsoft.NET.Sdk">
 
-	<PropertyGroup>
-		<TargetFramework>net6.0</TargetFramework>
-		<GenerateDocumentationFile>true</GenerateDocumentationFile>
-		<DebugType>embedded</DebugType>
-	</PropertyGroup>
-
 	<ItemGroup>
 		<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
 	</ItemGroup>
 
 	<ItemGroup>
-		<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
+		<PackageReference Include="BitBadger.Documents.Postgres" Version="3.0.0-rc-2" />
-		<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
+		<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.0.0-rc-2" />
+		<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.3" />
+		<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" />
+		<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" />
 		<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
-		<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
+		<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
+		<PackageReference Include="Npgsql.NodaTime" Version="8.0.2" />
 		<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
 		<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
-		<PackageReference Update="FSharp.Core" Version="6.0.5" />
+		<PackageReference Update="FSharp.Core" Version="8.0.200" />
 	</ItemGroup>
 
 	<ItemGroup>
@@ -25,7 +23,7 @@
 		<Compile Include="Interfaces.fs" />
 		<Compile Include="Utils.fs" />
 		<Compile Include="RethinkDbData.fs" />
-		<Compile Include="SQLite\Helpers.fs" />
+		<Compile Include="SQLite\SQLiteHelpers.fs" />
 		<Compile Include="SQLite\SQLiteCategoryData.fs" />
 		<Compile Include="SQLite\SQLitePageData.fs" />
 		<Compile Include="SQLite\SQLitePostData.fs" />
@@ -35,6 +33,23 @@
 		<Compile Include="SQLite\SQLiteWebLogData.fs" />
 		<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
 		<Compile Include="SQLiteData.fs" />
+		<Compile Include="Postgres\PostgresHelpers.fs" />
+		<Compile Include="Postgres\PostgresCache.fs" />
+		<Compile Include="Postgres\PostgresCategoryData.fs" />
+		<Compile Include="Postgres\PostgresPageData.fs" />
+		<Compile Include="Postgres\PostgresPostData.fs" />
+		<Compile Include="Postgres\PostgresTagMapData.fs" />
+		<Compile Include="Postgres\PostgresThemeData.fs" />
+		<Compile Include="Postgres\PostgresUploadData.fs" />
+		<Compile Include="Postgres\PostgresWebLogData.fs" />
+		<Compile Include="Postgres\PostgresWebLogUserData.fs" />
+		<Compile Include="PostgresData.fs" />
+	</ItemGroup>
+
+	<ItemGroup>
+		<AssemblyAttribute Include="System.Runtime.CompilerServices.InternalsVisibleToAttribute">
+			<_Parameter1>MyWebLog.Tests</_Parameter1>
+		</AssemblyAttribute>
 	</ItemGroup>
 
 </Project>

src/MyWebLog.Data/Postgres/PostgresCache.fs

@@ -0,0 +1,187 @@
+namespace MyWebLog.Data.Postgres
+
+open System.Threading
+open System.Threading.Tasks
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Caching.Distributed
+open NodaTime
+
+/// Helper types and functions for the cache
+[<AutoOpen>]
+module private Helpers =
+    
+    /// The cache entry
+    type Entry = {
+        /// The ID of the cache entry
+        Id: string
+        
+        /// The value to be cached
+        Payload: byte array
+        
+        /// When this entry will expire
+        ExpireAt: Instant
+        
+        /// The duration by which the expiration should be pushed out when being refreshed
+        SlidingExpiration: Duration option
+        
+        /// The must-expire-by date/time for the cache entry
+        AbsoluteExpiration: Instant option
+    }
+    
+    /// Run a task synchronously
+    let sync<'T> (it: Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
+    
+    /// Get the current instant
+    let getNow () = SystemClock.Instance.GetCurrentInstant()
+    
+    /// Create a parameter for the expire-at time
+    let expireParam =
+        typedParam "expireAt"
+
+
+/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
+type DistributedCache () =
+    
+    // ~~~ INITIALIZATION ~~~
+    
+    do
+        task {
+            let! exists =
+                Custom.scalar
+                    "SELECT EXISTS
+                       (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
+                     AS it"
+                    []
+                    toExists
+            if not exists then
+                do! Custom.nonQuery
+                        "CREATE TABLE session (
+                            id                  TEXT        NOT NULL PRIMARY KEY,
+                            payload             BYTEA       NOT NULL,
+                            expire_at           TIMESTAMPTZ NOT NULL,
+                            sliding_expiration  INTERVAL,
+                            absolute_expiration TIMESTAMPTZ);
+                        CREATE INDEX idx_session_expiration ON session (expire_at)" []
+        } |> sync
+    
+    // ~~~ SUPPORT FUNCTIONS ~~~
+    
+    /// Get an entry, updating it for sliding expiration
+    let getEntry key = backgroundTask {
+        let idParam = "@id", Sql.string key
+        let! tryEntry =
+            Custom.single
+                "SELECT * FROM session WHERE id = @id"
+                [ idParam ]
+                (fun row ->
+                      { Id                 = row.string                     "id"
+                        Payload            = row.bytea                      "payload"
+                        ExpireAt           = row.fieldValue<Instant>        "expire_at"
+                        SlidingExpiration  = row.fieldValueOrNone<Duration> "sliding_expiration"
+                        AbsoluteExpiration = row.fieldValueOrNone<Instant>  "absolute_expiration" })
+        match tryEntry with
+        | Some entry ->
+            let now      = getNow ()
+            let slideExp = defaultArg entry.SlidingExpiration  Duration.MinValue
+            let absExp   = defaultArg entry.AbsoluteExpiration Instant.MinValue
+            let needsRefresh, item =
+                if entry.ExpireAt = absExp then false, entry
+                elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
+                elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
+                    true, { entry with ExpireAt = absExp }
+                else true, { entry with ExpireAt = now.Plus slideExp }
+            if needsRefresh then
+                do! Custom.nonQuery
+                        "UPDATE session SET expire_at = @expireAt WHERE id = @id"
+                        [ expireParam item.ExpireAt; idParam ]
+                ()
+            return if item.ExpireAt > now then Some entry else None
+        | None -> return None
+    }
+    
+    /// The last time expired entries were purged (runs every 30 minutes)
+    let mutable lastPurge = Instant.MinValue
+    
+    /// Purge expired entries every 30 minutes
+    let purge () = backgroundTask {
+        let now = getNow ()
+        if lastPurge.Plus(Duration.FromMinutes 30L) < now then
+            do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
+            lastPurge <- now
+    }
+    
+    /// Remove a cache entry
+    let removeEntry key =
+        Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
+    
+    /// Save an entry
+    let saveEntry (opts: DistributedCacheEntryOptions) key payload =
+        let now = getNow ()
+        let expireAt, slideExp, absExp =
+            if opts.SlidingExpiration.HasValue then
+                let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
+                now.Plus slide, Some slide, None
+            elif opts.AbsoluteExpiration.HasValue then
+                let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
+                exp, None, Some exp
+            elif opts.AbsoluteExpirationRelativeToNow.HasValue then
+                let exp = now.Plus(Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
+                exp, None, Some exp
+            else
+                // Default to 1 hour sliding expiration
+                let slide = Duration.FromHours 1
+                now.Plus slide, Some slide, None
+        Custom.nonQuery
+            "INSERT INTO session (
+                id, payload, expire_at, sliding_expiration, absolute_expiration
+            ) VALUES (
+                @id, @payload, @expireAt, @slideExp, @absExp
+            ) ON CONFLICT (id) DO UPDATE
+            SET payload             = EXCLUDED.payload,
+                expire_at           = EXCLUDED.expire_at,
+                sliding_expiration  = EXCLUDED.sliding_expiration,
+                absolute_expiration = EXCLUDED.absolute_expiration"
+            [   "@id",      Sql.string key
+                "@payload", Sql.bytea payload
+                expireParam expireAt
+                optParam "slideExp" slideExp
+                optParam "absExp"   absExp ]
+        
+    // ~~~ IMPLEMENTATION FUNCTIONS ~~~
+    
+    /// Retrieve the data for a cache entry
+    let get key (_: CancellationToken) = backgroundTask {
+        match! getEntry key with
+        | Some entry ->
+            do! purge ()
+            return entry.Payload
+        | None -> return null
+    }
+    
+    /// Refresh an entry
+    let refresh key (cancelToken: CancellationToken) = backgroundTask {
+        let! _ = get key cancelToken
+        ()
+    }
+    
+    /// Remove an entry
+    let remove key (_: CancellationToken) = backgroundTask {
+        do! removeEntry key
+        do! purge ()
+    }
+    
+    /// Set an entry
+    let set key value options (_: CancellationToken) = backgroundTask {
+        do! saveEntry options key value
+        do! purge ()
+    }
+    
+    interface IDistributedCache with
+        member _.Get key = get key CancellationToken.None |> sync
+        member _.GetAsync(key, token) = get key token
+        member _.Refresh key = refresh key CancellationToken.None |> sync
+        member _.RefreshAsync(key, token) = refresh key token
+        member _.Remove key = remove key CancellationToken.None |> sync
+        member _.RemoveAsync(key, token) = remove key token
+        member _.Set(key, value, options) = set key value options CancellationToken.None |> sync
+        member _.SetAsync(key, value, options, token) = set key value options token

src/MyWebLog.Data/Postgres/PostgresCategoryData.fs

@@ -0,0 +1,155 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog category data implementation
+type PostgresCategoryData(log: ILogger) =
+    
+    /// Count all categories for the given web log
+    let countAll webLogId =
+        log.LogTrace "Category.countAll"
+        Count.byContains Table.Category (webLogDoc webLogId)
+    
+    /// Count all top-level categories for the given web log
+    let countTopLevel webLogId =
+        log.LogTrace "Category.countTopLevel"
+        Custom.scalar
+            $"""{Query.Count.byContains Table.Category}
+                  AND {Query.whereByField (Field.NEX (nameof Category.Empty.ParentId)) ""}"""
+            [ webLogContains webLogId ]
+            toCount
+    
+    /// Retrieve all categories for the given web log in a DotLiquid-friendly format
+    let findAllForView webLogId = backgroundTask {
+        log.LogTrace "Category.findAllForView"
+        let! cats =
+            Custom.list
+                $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')"
+                [ webLogContains webLogId ]
+                fromData<Category>
+        let ordered = Utils.orderByHierarchy cats None None []
+        let counts  =
+            ordered
+            |> Seq.map (fun it ->
+                // Parent category post counts include posts in subcategories
+                let catIdSql, catIdParams =
+                    ordered
+                    |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
+                    |> Seq.map _.Id
+                    |> Seq.append (Seq.singleton it.Id)
+                    |> List.ofSeq
+                    |> arrayContains (nameof Post.Empty.CategoryIds) id
+                let postCount =
+                    Custom.scalar
+                        $"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS it
+                              FROM {Table.Post}
+                             WHERE {Query.whereDataContains "@criteria"}
+                               AND {catIdSql}"""
+                        [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catIdParams ]
+                        toCount
+                    |> Async.AwaitTask
+                    |> Async.RunSynchronously
+                it.Id, postCount)
+            |> List.ofSeq
+        return
+            ordered
+            |> Seq.map (fun cat ->
+                { cat with
+                    PostCount = counts
+                                |> List.tryFind (fun c -> fst c = cat.Id)
+                                |> Option.map snd
+                                |> Option.defaultValue 0 })
+            |> Array.ofSeq
+    }
+    /// Find a category by its ID for the given web log
+    let findById catId webLogId =
+        log.LogTrace "Category.findById"
+        Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId
+    
+    /// Find all categories for the given web log
+    let findByWebLog webLogId =
+        log.LogTrace "Category.findByWebLog"
+        Document.findByWebLog<Category> Table.Category webLogId
+    
+    /// Delete a category
+    let delete catId webLogId = backgroundTask {
+        log.LogTrace "Category.delete"
+        match! findById catId webLogId with
+        | Some cat ->
+            // Reassign any children to the category's parent category
+            let! children = Find.byContains<Category> Table.Category {| ParentId = catId |}
+            let hasChildren = not (List.isEmpty children)
+            if hasChildren then
+                let childQuery, childParams =
+                    if cat.ParentId.IsSome then
+                        Query.Patch.byId Table.Category,
+                        children
+                        |> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ])
+                    else
+                        Query.RemoveFields.byId Table.Category,
+                        children
+                        |> List.map (fun child ->
+                            [ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ])
+                let! _ =
+                    Configuration.dataSource ()
+                    |> Sql.fromDataSource
+                    |> Sql.executeTransactionAsync [ childQuery, childParams ]
+                ()
+            // Delete the category off all posts where it is assigned
+            let! posts =
+                Custom.list
+                    $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id"
+                    [ jsonParam "@id" [| string catId |] ]
+                    fromData<Post>
+            if not (List.isEmpty posts) then
+                let! _ =
+                    Configuration.dataSource ()
+                    |> Sql.fromDataSource
+                    |> Sql.executeTransactionAsync
+                        [ Query.Patch.byId Table.Post,
+                          posts
+                          |> List.map (fun post ->
+                              [ idParam post.Id
+                                jsonParam
+                                    "@data"
+                                    {| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} ]) ]
+                ()
+            // Delete the category itself
+            do! Delete.byId Table.Category catId
+            return if hasChildren then ReassignedChildCategories else CategoryDeleted
+        | None -> return CategoryNotFound
+    }
+    
+    /// Save a category
+    let save (cat: Category) = backgroundTask {
+        log.LogTrace "Category.save"
+        do! save Table.Category cat
+    }
+    
+    /// Restore categories from a backup
+    let restore cats = backgroundTask {
+        log.LogTrace "Category.restore"
+        let! _ =
+            Configuration.dataSource ()
+            |> Sql.fromDataSource
+            |> Sql.executeTransactionAsync [
+                Query.insert Table.Category, cats |> List.map (fun c -> [ jsonParam "@data" c ])
+            ]
+        ()
+    }
+    
+    interface ICategoryData with
+        member _.Add cat = save cat
+        member _.CountAll webLogId = countAll webLogId
+        member _.CountTopLevel webLogId = countTopLevel webLogId
+        member _.FindAllForView webLogId = findAllForView webLogId
+        member _.FindById catId webLogId = findById catId webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.Delete catId webLogId = delete catId webLogId
+        member _.Restore cats = restore cats
+        member _.Update cat = save cat

src/MyWebLog.Data/Postgres/PostgresHelpers.fs

@@ -0,0 +1,223 @@
+/// Helper functions for the PostgreSQL data implementation
+[<AutoOpen>]
+module MyWebLog.Data.Postgres.PostgresHelpers
+
+/// The table names used in the PostgreSQL implementation
+[<RequireQualifiedAccess>]
+module Table =
+    
+    /// Categories
+    [<Literal>]
+    let Category = "category"
+    
+    /// Database Version
+    [<Literal>]
+    let DbVersion = "db_version"
+    
+    /// Pages
+    [<Literal>]
+    let Page = "page"
+    
+    /// Page Revisions
+    [<Literal>]
+    let PageRevision = "page_revision"
+    
+    /// Posts
+    [<Literal>]
+    let Post = "post"
+    
+    /// Post Comments
+    [<Literal>]
+    let PostComment = "post_comment"
+    
+    /// Post Revisions
+    [<Literal>]
+    let PostRevision = "post_revision"
+    
+    /// Tag/URL Mappings
+    [<Literal>]
+    let TagMap = "tag_map"
+    
+    /// Themes
+    [<Literal>]
+    let Theme = "theme"
+    
+    /// Theme Assets
+    [<Literal>]
+    let ThemeAsset = "theme_asset"
+    
+    /// Uploads
+    [<Literal>]
+    let Upload = "upload"
+    
+    /// Web Logs
+    [<Literal>]
+    let WebLog = "web_log"
+    
+    /// Users
+    [<Literal>]
+    let WebLogUser = "web_log_user"
+
+
+open System
+open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+open Npgsql
+open Npgsql.FSharp
+
+/// Create a SQL parameter for the web log ID
+let webLogIdParam (webLogId: WebLogId) =
+    "@webLogId", Sql.string (string webLogId)
+
+/// Create an anonymous record with the given web log ID
+let webLogDoc (webLogId: WebLogId) =
+    {| WebLogId = webLogId |}
+
+/// Create a parameter for a web log document-contains query
+let webLogContains webLogId =
+    jsonParam "@criteria" (webLogDoc webLogId)
+
+/// A SQL string to select data from a table with the given JSON document contains criteria
+let selectWithCriteria tableName =
+    $"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
+
+/// Create the SQL and parameters for an IN clause
+let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
+    if List.isEmpty items then "", []
+    else
+        let mutable idx = 0
+        items
+        |> List.skip 1
+        |> List.fold (fun (itemS, itemP) it ->
+            idx <- idx + 1
+            $"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
+            (Seq.ofList items
+             |> Seq.map (fun it ->
+                 $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
+             |> Seq.head)
+        |> function sql, ps -> $"{sql})", ps
+
+/// Create the SQL and parameters for match-any array query
+let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
+    $"data['{name}'] ?| @{name}Values",
+    ($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
+
+/// Get the first result of the given query
+let tryHead<'T> (query: Task<'T list>) = backgroundTask {
+    let! results = query
+    return List.tryHead results
+}
+
+/// Create a parameter for a non-standard type
+let typedParam<'T> name (it: 'T) =
+    $"@%s{name}", Sql.parameter (NpgsqlParameter($"@{name}", it))
+
+/// Create a parameter for a possibly-missing non-standard type
+let optParam<'T> name (it: 'T option) =
+    let p = NpgsqlParameter($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
+    p.ParameterName, Sql.parameter p
+
+/// Mapping functions for SQL queries
+module Map =
+    
+    /// Create a permalink from the current row
+    let toPermalink (row: RowReader) =
+        Permalink (row.string "permalink")
+    
+    /// Create a revision from the current row
+    let toRevision (row: RowReader) : Revision =
+        { AsOf = row.fieldValue<Instant> "as_of"
+          Text = row.string              "revision_text" |> MarkupText.Parse }
+    
+    /// Create a theme asset from the current row
+    let toThemeAsset includeData (row: RowReader) : ThemeAsset =
+        { Id        = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
+          UpdatedOn = row.fieldValue<Instant> "updated_on"
+          Data      = if includeData then row.bytea "data" else [||] }
+    
+    /// Create an uploaded file from the current row
+    let toUpload includeData (row: RowReader) : Upload =
+        { Id        = row.string              "id"         |> UploadId
+          WebLogId  = row.string              "web_log_id" |> WebLogId
+          Path      = row.string              "path"       |> Permalink
+          UpdatedOn = row.fieldValue<Instant> "updated_on"
+          Data      = if includeData then row.bytea "data" else [||] }
+
+/// Document manipulation functions
+module Document =
+    
+    /// Determine whether a document exists with the given key for the given web log
+    let existsByWebLog<'TKey> table (key: 'TKey) webLogId =
+        Custom.scalar
+            $"""SELECT EXISTS (
+                    SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}
+                    ) AS it"""
+            [ "@id", Sql.string (string key); webLogContains webLogId ]
+            toExists
+    
+    /// Find a document by its ID for the given web log
+    let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
+        Custom.single
+            $"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
+            [ "@id", Sql.string (string key); webLogContains webLogId ]
+            fromData<'TDoc>
+    
+    /// Find documents for the given web log
+    let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
+        Find.byContains table (webLogDoc webLogId)
+
+
+/// Functions to support revisions
+module Revisions =
+    
+    /// Find all revisions for the given entity
+    let findByEntityId<'TKey> revTable entityTable (key: 'TKey) =
+        Custom.list
+            $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
+            [ "@id", Sql.string (string key) ]
+            Map.toRevision
+    
+    /// Find all revisions for all posts for the given web log
+    let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId =
+        Custom.list
+            $"""SELECT pr.*
+                  FROM %s{revTable} pr
+                       INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id
+                 WHERE p.{Query.whereDataContains "@criteria"}
+                 ORDER BY as_of DESC"""
+            [ webLogContains webLogId ]
+            (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
+
+    /// Parameters for a revision INSERT statement
+    let revParams<'TKey> (key: 'TKey) rev = [
+        typedParam "asOf" rev.AsOf
+        "@id",   Sql.string (string key)
+        "@text", Sql.string (string rev.Text)
+    ]
+    
+    /// The SQL statement to insert a revision
+    let insertSql table =
+        $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
+    
+    /// Update a page's revisions
+    let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
+        let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
+        if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
+            let! _ =
+                Configuration.dataSource ()
+                |> Sql.fromDataSource
+                |> Sql.executeTransactionAsync
+                    [ if not (List.isEmpty toDelete) then
+                        $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
+                        toDelete
+                        |> List.map (fun it ->
+                            [ "@id", Sql.string (string key)
+                              typedParam "asOf" it.AsOf ])
+                      if not (List.isEmpty toAdd) then
+                        insertSql revTable, toAdd |> List.map (revParams key) ]
+            ()
+    }

src/MyWebLog.Data/Postgres/PostgresPageData.fs

@@ -0,0 +1,201 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog page data implementation
+type PostgresPageData(log: ILogger) =
+    
+    // SUPPORT FUNCTIONS
+    
+    /// Append revisions to a page
+    let appendPageRevisions (page: Page) = backgroundTask {
+        log.LogTrace "Page.appendPageRevisions"
+        let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id
+        return { page with Revisions = revisions }
+    }
+    
+    /// Return a page with no text or revisions
+    let pageWithoutText (row: RowReader) =
+        { fromData<Page> row with Text = "" }
+    
+    /// Update a page's revisions
+    let updatePageRevisions (pageId: PageId) oldRevs newRevs =
+        log.LogTrace "Page.updatePageRevisions"
+        Revisions.update Table.PageRevision Table.Page pageId oldRevs newRevs
+    
+    /// Does the given page exist?
+    let pageExists (pageId: PageId) webLogId =
+        log.LogTrace "Page.pageExists"
+        Document.existsByWebLog Table.Page pageId webLogId
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a page
+    let add (page: Page) = backgroundTask {
+        log.LogTrace "Page.add"
+        do! insert Table.Page { page with Revisions = [] }
+        do! updatePageRevisions page.Id [] page.Revisions
+        ()
+    }
+    
+    /// Get all pages for a web log (without text, metadata, revisions, or prior permalinks)
+    let all webLogId =
+        log.LogTrace "Page.all"
+        Custom.list
+            $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
+            [ webLogContains webLogId ]
+            (fun row -> { fromData<Page> row with Text = ""; Metadata = []; PriorPermalinks = [] }) 
+    
+    /// Count all pages for the given web log
+    let countAll webLogId =
+        log.LogTrace "Page.countAll"
+        Count.byContains Table.Page (webLogDoc webLogId)
+    
+    /// Count all pages shown in the page list for the given web log
+    let countListed webLogId =
+        log.LogTrace "Page.countListed"
+        Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
+    
+    /// Find a page by its ID (without revisions or prior permalinks)
+    let findById pageId webLogId = backgroundTask {
+        log.LogTrace "Page.findById"
+        match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId with
+        | Some page -> return Some { page with PriorPermalinks = [] }
+        | None -> return None
+    }
+    
+    /// Find a complete page by its ID
+    let findFullById pageId webLogId = backgroundTask {
+        log.LogTrace "Page.findFullById"
+        match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId with
+        | Some page ->
+            let! withMore = appendPageRevisions page
+            return Some withMore
+        | None -> return None
+    }
+    
+    // TODO: need to handle when the page being deleted is the home page
+    /// Delete a page by its ID
+    let delete pageId webLogId = backgroundTask {
+        log.LogTrace "Page.delete"
+        match! pageExists pageId webLogId with
+        | true ->
+            do! Custom.nonQuery
+                    $"""DELETE FROM {Table.PageRevision} WHERE page_id = @id;
+                        DELETE FROM {Table.Page}         WHERE {Query.whereById "@id"}"""
+                    [ idParam pageId ]
+            return true
+        | false -> return false
+    }
+    
+    /// Find a page by its permalink for the given web log
+    let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
+        log.LogTrace "Page.findByPermalink"
+        let! page =
+            Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = permalink |}
+            |> tryHead
+        return page |> Option.map (fun pg -> { pg with PriorPermalinks = [] })
+    }
+    
+    /// Find the current permalink within a set of potential prior permalinks for the given web log
+    let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
+        log.LogTrace "Page.findCurrentPermalink"
+        if List.isEmpty permalinks then return None
+        else
+            let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
+            return!
+                Custom.single
+                    $"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
+                          FROM page
+                         WHERE {Query.whereDataContains "@criteria"}
+                           AND {linkSql}"""
+                    [ webLogContains webLogId; linkParam ]
+                    Map.toPermalink
+    }
+    
+    /// Get all complete pages for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        log.LogTrace "Page.findFullByWebLog"
+        let! pages     = Document.findByWebLog<Page> Table.Page webLogId
+        let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId 
+        return
+            pages
+            |> List.map (fun it ->
+                { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
+    }
+    
+    /// Get all listed pages for the given web log (without revisions or text)
+    let findListed webLogId =
+        log.LogTrace "Page.findListed"
+        Custom.list
+            $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
+            [ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ]
+            pageWithoutText
+    
+    /// Get a page of pages for the given web log (without revisions)
+    let findPageOfPages webLogId pageNbr =
+        log.LogTrace "Page.findPageOfPages"
+        Custom.list
+            $"{selectWithCriteria Table.Page}
+               ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
+               LIMIT @pageSize OFFSET @toSkip"
+            [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
+            (fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] })
+    
+    /// Restore pages from a backup
+    let restore (pages: Page list) = backgroundTask {
+        log.LogTrace "Page.restore"
+        let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
+        let! _ =
+            Configuration.dataSource ()
+            |> Sql.fromDataSource
+            |> Sql.executeTransactionAsync
+                [ Query.insert Table.Page,
+                    pages |> List.map (fun page -> [ jsonParam "@data" { page with Revisions = [] } ])
+                  Revisions.insertSql Table.PageRevision,
+                    revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId rev) ]
+        ()
+    }
+    
+    /// Update a page
+    let update (page: Page) = backgroundTask {
+        log.LogTrace "Page.update"
+        match! findFullById page.Id page.WebLogId with
+        | Some oldPage ->
+            do! Update.byId Table.Page page.Id { page with Revisions = [] }
+            do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
+        | None -> ()
+        ()
+    }
+    
+    /// Update a page's prior permalinks
+    let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
+        log.LogTrace "Page.updatePriorPermalinks"
+        match! pageExists pageId webLogId with
+        | true ->
+            do! Patch.byId Table.Page pageId {| PriorPermalinks = permalinks |}
+            return true
+        | false -> return false
+    }
+    
+    interface IPageData with
+        member _.Add page = add page
+        member _.All webLogId = all webLogId
+        member _.CountAll webLogId = countAll webLogId
+        member _.CountListed webLogId = countListed webLogId
+        member _.Delete pageId webLogId = delete pageId webLogId
+        member _.FindById pageId webLogId = findById pageId webLogId
+        member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
+        member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
+        member _.FindFullById pageId webLogId = findFullById pageId webLogId
+        member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
+        member _.FindListed webLogId = findListed webLogId
+        member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
+        member _.Restore pages = restore pages
+        member _.Update page = update page
+        member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

src/MyWebLog.Data/Postgres/PostgresPostData.fs

@@ -0,0 +1,236 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog post data implementation
+type PostgresPostData(log: ILogger) =
+
+    // SUPPORT FUNCTIONS
+    
+    /// Append revisions to a post
+    let appendPostRevisions (post: Post) = backgroundTask {
+        log.LogTrace "Post.appendPostRevisions"
+        let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id
+        return { post with Revisions = revisions }
+    }
+    
+    /// Return a post with no revisions or prior permalinks
+    let postWithoutLinks row =
+        { fromData<Post> row with PriorPermalinks = [] }
+    
+    /// Return a post with no revisions, prior permalinks, or text
+    let postWithoutText row =
+        { postWithoutLinks row with Text = "" }
+    
+    /// Update a post's revisions
+    let updatePostRevisions (postId: PostId) oldRevs newRevs =
+        log.LogTrace "Post.updatePostRevisions"
+        Revisions.update Table.PostRevision Table.Post postId oldRevs newRevs
+    
+    /// Does the given post exist?
+    let postExists (postId: PostId) webLogId =
+        log.LogTrace "Post.postExists"
+        Document.existsByWebLog Table.Post postId webLogId
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Add a post
+    let add (post : Post) = backgroundTask {
+        log.LogTrace "Post.add"
+        do! insert Table.Post { post with Revisions = [] }
+        do! updatePostRevisions post.Id [] post.Revisions
+    }
+    
+    /// Count posts in a status for the given web log
+    let countByStatus (status: PostStatus) webLogId =
+        log.LogTrace "Post.countByStatus"
+        Count.byContains Table.Post {| webLogDoc webLogId with Status = status |}
+    
+    /// Find a post by its ID for the given web log (excluding revisions)
+    let findById postId webLogId = backgroundTask {
+        log.LogTrace "Post.findById"
+        match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
+        | Some post -> return Some { post with PriorPermalinks = [] }
+        | None -> return None
+    }
+    
+    /// Find a post by its permalink for the given web log (excluding revisions)
+    let findByPermalink (permalink: Permalink) webLogId =
+        log.LogTrace "Post.findByPermalink"
+        Custom.single
+            (selectWithCriteria Table.Post)
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Permalink = permalink |} ]
+            postWithoutLinks
+    
+    /// Find a complete post by its ID for the given web log
+    let findFullById postId webLogId = backgroundTask {
+        log.LogTrace "Post.findFullById"
+        match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
+        | Some post ->
+            let! withRevisions = appendPostRevisions post
+            return Some withRevisions
+        | None -> return None
+    }
+    
+    /// Delete a post by its ID for the given web log
+    let delete postId webLogId = backgroundTask {
+        log.LogTrace "Post.delete"
+        match! postExists postId webLogId with
+        | true ->
+            do! Custom.nonQuery
+                    $"""DELETE FROM {Table.PostComment}  WHERE {Query.whereDataContains "@criteria"};
+                        DELETE FROM {Table.PostRevision} WHERE post_id = @id;
+                        DELETE FROM {Table.Post}         WHERE {Query.whereById "@id"}"""
+                    [ idParam postId; jsonParam "@criteria" {| PostId = postId |} ]
+            return true
+        | false -> return false
+    }
+    
+    /// Find the current permalink from a list of potential prior permalinks for the given web log
+    let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
+        log.LogTrace "Post.findCurrentPermalink"
+        if List.isEmpty permalinks then return None
+        else
+            let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks
+            return!
+                Custom.single
+                    $"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
+                          FROM {Table.Post}
+                         WHERE {Query.whereDataContains "@criteria"}
+                           AND {linkSql}"""
+                    [ webLogContains webLogId; linkParam ]
+                    Map.toPermalink
+    }
+    
+    /// Get all complete posts for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        log.LogTrace "Post.findFullByWebLog"
+        let! posts     = Document.findByWebLog<Post> Table.Post webLogId
+        let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
+        return
+            posts
+            |> List.map (fun it ->
+                { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
+    }
+    
+    /// Get a page of categorized posts for the given web log (excludes revisions)
+    let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
+        log.LogTrace "Post.findPageOfCategorizedPosts"
+        let catSql, catParam = arrayContains (nameof Post.Empty.CategoryIds) string categoryIds
+        Custom.list
+            $"{selectWithCriteria Table.Post}
+                 AND {catSql}
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catParam ]
+            postWithoutLinks
+    
+    /// Get a page of posts for the given web log (excludes text and revisions)
+    let findPageOfPosts webLogId pageNbr postsPerPage =
+        log.LogTrace "Post.findPageOfPosts"
+        Custom.list
+            $"{selectWithCriteria Table.Post}
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
+                        data ->> '{nameof Post.Empty.UpdatedOn}'
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
+            [ webLogContains webLogId ]
+            postWithoutText
+    
+    /// Get a page of published posts for the given web log (excludes revisions)
+    let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
+        log.LogTrace "Post.findPageOfPublishedPosts"
+        Custom.list
+            $"{selectWithCriteria Table.Post}
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
+            postWithoutLinks
+    
+    /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
+    let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
+        log.LogTrace "Post.findPageOfTaggedPosts"
+        Custom.list
+            $"{selectWithCriteria Table.Post}
+                 AND data['{nameof Post.Empty.Tags}'] @> @tag
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
+            postWithoutLinks
+    
+    /// Find the next newest and oldest post from a publish date for the given web log
+    let findSurroundingPosts webLogId (publishedOn: Instant) = backgroundTask {
+        log.LogTrace "Post.findSurroundingPosts"
+        let queryParams () =
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
+              "@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
+        let query op direction =
+            $"{selectWithCriteria Table.Post}
+                 AND (data ->> '{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' %s{direction}
+               LIMIT 1"
+        let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
+        let! newer = Custom.list (query ">" "")     (queryParams ()) postWithoutLinks
+        return List.tryHead older, List.tryHead newer
+    }
+    
+    /// Update a post
+    let update (post : Post) = backgroundTask {
+        log.LogTrace "Post.save"
+        match! findFullById post.Id post.WebLogId with
+        | Some oldPost ->
+            do! Update.byId Table.Post post.Id { post with Revisions = [] }
+            do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
+        | None -> ()
+    }
+    
+    /// Restore posts from a backup
+    let restore posts = backgroundTask {
+        log.LogTrace "Post.restore"
+        let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
+        let! _ =
+            Configuration.dataSource ()
+            |> Sql.fromDataSource
+            |> Sql.executeTransactionAsync
+                [ Query.insert Table.Post,
+                    posts |> List.map (fun post -> [ jsonParam "@data" { post with Revisions = [] } ])
+                  Revisions.insertSql Table.PostRevision,
+                    revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId rev) ]
+        ()
+    }
+    
+    /// Update prior permalinks for a post
+    let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
+        log.LogTrace "Post.updatePriorPermalinks"
+        match! postExists postId webLogId with
+        | true ->
+            do! Patch.byId Table.Post postId {| PriorPermalinks = permalinks |}
+            return true
+        | false -> return false
+    }
+    
+    interface IPostData with
+        member _.Add post = add post
+        member _.CountByStatus status webLogId = countByStatus status webLogId
+        member _.Delete postId webLogId = delete postId webLogId
+        member _.FindById postId webLogId = findById postId webLogId
+        member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
+        member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
+        member _.FindFullById postId webLogId = findFullById postId webLogId
+        member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
+        member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
+            findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
+        member _.FindPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
+        member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage =
+            findPageOfPublishedPosts webLogId pageNbr postsPerPage
+        member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
+            findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
+        member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
+        member _.Restore posts = restore posts
+        member _.Update post = update post
+        member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

src/MyWebLog.Data/Postgres/PostgresTagMapData.fs

@@ -0,0 +1,73 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog tag mapping data implementation
+type PostgresTagMapData(log: ILogger) =
+    
+    /// Find a tag mapping by its ID for the given web log
+    let findById tagMapId webLogId =
+        log.LogTrace "TagMap.findById"
+        Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId
+    
+    /// Delete a tag mapping for the given web log
+    let delete (tagMapId: TagMapId) webLogId = backgroundTask {
+        log.LogTrace "TagMap.delete"
+        let! exists = Document.existsByWebLog Table.TagMap tagMapId webLogId
+        if exists then
+            do! Delete.byId Table.TagMap tagMapId
+            return true
+        else return false
+    }
+    
+    /// Find a tag mapping by its URL value for the given web log
+    let findByUrlValue (urlValue: string) webLogId =
+        log.LogTrace "TagMap.findByUrlValue"
+        Find.firstByContains<TagMap> Table.TagMap {| webLogDoc webLogId with UrlValue = urlValue |}
+
+    /// Get all tag mappings for the given web log
+    let findByWebLog webLogId =
+        log.LogTrace "TagMap.findByWebLog"
+        Custom.list
+            $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'"
+            [ webLogContains webLogId ]
+            fromData<TagMap>
+    
+    /// Find any tag mappings in a list of tags for the given web log
+    let findMappingForTags tags webLogId =
+        log.LogTrace "TagMap.findMappingForTags"
+        let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
+        Custom.list
+            $"{selectWithCriteria Table.TagMap} AND {tagSql}"
+            [ webLogContains webLogId; tagParam ]
+            fromData<TagMap>
+    
+    /// Save a tag mapping
+    let save (tagMap: TagMap) =
+        log.LogTrace "TagMap.save"
+        save Table.TagMap tagMap
+    
+    /// Restore tag mappings from a backup
+    let restore (tagMaps: TagMap list) = backgroundTask {
+        let! _ =
+            Configuration.dataSource ()
+            |> Sql.fromDataSource
+            |> Sql.executeTransactionAsync
+                [ Query.insert Table.TagMap,
+                    tagMaps |> List.map (fun tagMap -> [ jsonParam "@data" tagMap ]) ]
+        ()
+    }
+    
+    interface ITagMapData with
+        member _.Delete tagMapId webLogId = delete tagMapId webLogId
+        member _.FindById tagMapId webLogId = findById tagMapId webLogId
+        member _.FindByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.FindMappingForTags tags webLogId = findMappingForTags tags webLogId
+        member _.Save tagMap = save tagMap
+        member _.Restore tagMaps = restore tagMaps

src/MyWebLog.Data/Postgres/PostgresThemeData.fs

@@ -0,0 +1,127 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+
+/// PostreSQL myWebLog theme data implementation
+type PostgresThemeData(log: ILogger) =
+    
+    /// Clear out the template text from a theme
+    let withoutTemplateText row =
+        let theme = fromData<Theme> row
+        { theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) }
+    
+    /// Retrieve all themes (except 'admin'; excludes template text)
+    let all () =
+        log.LogTrace "Theme.all"
+        Custom.list
+            $"{Query.selectFromTable Table.Theme}
+               WHERE data ->> '{nameof Theme.Empty.Id}' <> 'admin'
+               ORDER BY data ->> '{nameof Theme.Empty.Id}'"
+            []
+            withoutTemplateText
+    
+    /// Does a given theme exist?
+    let exists (themeId: ThemeId) =
+        log.LogTrace "Theme.exists"
+        Exists.byId Table.Theme themeId
+    
+    /// Find a theme by its ID
+    let findById (themeId: ThemeId) =
+        log.LogTrace "Theme.findById"
+        Find.byId<ThemeId, Theme> Table.Theme themeId
+    
+    /// Find a theme by its ID (excludes the text of templates)
+    let findByIdWithoutText (themeId: ThemeId) =
+        log.LogTrace "Theme.findByIdWithoutText"
+        Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
+    
+    /// Delete a theme by its ID
+    let delete themeId = backgroundTask {
+        log.LogTrace "Theme.delete"
+        match! exists themeId with
+        | true ->
+            do! Custom.nonQuery
+                    $"""DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
+                        DELETE FROM {Table.Theme}      WHERE {Query.whereById "@id"}"""
+                    [ idParam themeId ]
+            return true
+        | false -> return false
+    }
+    
+    /// Save a theme
+    let save (theme: Theme) =
+        log.LogTrace "Theme.save"
+        save Table.Theme theme
+    
+    interface IThemeData with
+        member _.All() = all ()
+        member _.Delete themeId = delete themeId
+        member _.Exists themeId = exists themeId
+        member _.FindById themeId = findById themeId
+        member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
+        member _.Save theme = save theme
+
+
+/// PostreSQL myWebLog theme data implementation
+type PostgresThemeAssetData(log: ILogger) =
+    
+    /// Get all theme assets (excludes data)
+    let all () =
+        log.LogTrace "ThemeAsset.all"
+        Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
+    
+    /// Delete all assets for the given theme
+    let deleteByTheme (themeId: ThemeId) =
+        log.LogTrace "ThemeAsset.deleteByTheme"
+        Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
+    
+    /// Find a theme asset by its ID
+    let findById assetId =
+        log.LogTrace "ThemeAsset.findById"
+        let (ThemeAssetId (ThemeId themeId, path)) = assetId
+        Custom.single
+            $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
+            [ idParam themeId; "@path", Sql.string path ]
+            (Map.toThemeAsset true)
+    
+    /// Get theme assets for the given theme (excludes data)
+    let findByTheme (themeId: ThemeId) =
+        log.LogTrace "ThemeAsset.findByTheme"
+        Custom.list
+            $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id"
+            [ idParam themeId ]
+            (Map.toThemeAsset false)
+    
+    /// Get theme assets for the given theme
+    let findByThemeWithData (themeId: ThemeId) =
+        log.LogTrace "ThemeAsset.findByThemeWithData"
+        Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] (Map.toThemeAsset true)
+    
+    /// Save a theme asset
+    let save (asset: ThemeAsset) =
+        log.LogTrace "ThemeAsset.save"
+        let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
+        Custom.nonQuery
+            $"INSERT INTO {Table.ThemeAsset} (
+                  theme_id, path, updated_on, data
+              ) VALUES (
+                  @themeId, @path, @updatedOn, @data
+              ) ON CONFLICT (theme_id, path) DO UPDATE
+              SET updated_on = EXCLUDED.updated_on,
+                  data       = EXCLUDED.data"
+            [ "@themeId", Sql.string themeId
+              "@path",    Sql.string path
+              "@data",    Sql.bytea  asset.Data
+              typedParam "updatedOn" asset.UpdatedOn ]
+    
+    interface IThemeAssetData with
+        member _.All() = all ()
+        member _.DeleteByTheme themeId = deleteByTheme themeId
+        member _.FindById assetId = findById assetId
+        member _.FindByTheme themeId = findByTheme themeId
+        member _.FindByThemeWithData themeId = findByThemeWithData themeId
+        member _.Save asset = save asset

src/MyWebLog.Data/Postgres/PostgresUploadData.fs

@@ -0,0 +1,90 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog uploaded file data implementation
+type PostgresUploadData(log: ILogger) =
+
+    /// The INSERT statement for an uploaded file
+    let upInsert = $"
+        INSERT INTO {Table.Upload} (
+            id, web_log_id, path, updated_on, data
+        ) VALUES (
+            @id, @webLogId, @path, @updatedOn, @data
+        )"
+    
+    /// Parameters for adding an uploaded file
+    let upParams (upload: Upload) =
+        [ webLogIdParam upload.WebLogId
+          typedParam "updatedOn" upload.UpdatedOn
+          idParam upload.Id
+          "@path", Sql.string (string upload.Path)
+          "@data", Sql.bytea  upload.Data ]
+    
+    /// Save an uploaded file
+    let add upload =
+        log.LogTrace "Upload.add"
+        Custom.nonQuery upInsert (upParams upload)
+    
+    /// Delete an uploaded file by its ID
+    let delete uploadId webLogId = backgroundTask {
+        log.LogTrace "Upload.delete"
+        let idParam = [ idParam uploadId ]
+        let! path =
+            Custom.single
+                $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
+                (webLogIdParam webLogId :: idParam)
+                (fun row -> row.string "path")
+        if Option.isSome path then
+            do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" idParam
+            return Ok path.Value
+        else return Error $"Upload ID {uploadId} not found"
+    }
+    
+    /// Find an uploaded file by its path for the given web log
+    let findByPath path webLogId =
+        log.LogTrace "Upload.findByPath"
+        Custom.single
+            $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
+            [ webLogIdParam webLogId; "@path", Sql.string path ]
+            (Map.toUpload true)
+    
+    /// Find all uploaded files for the given web log (excludes data)
+    let findByWebLog webLogId =
+        log.LogTrace "Upload.findByWebLog"
+        Custom.list
+            $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
+            [ webLogIdParam webLogId ]
+            (Map.toUpload false)
+    
+    /// Find all uploaded files for the given web log
+    let findByWebLogWithData webLogId =
+        log.LogTrace "Upload.findByWebLogWithData"
+        Custom.list
+            $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
+            [ webLogIdParam webLogId ]
+            (Map.toUpload true)
+    
+    /// Restore uploads from a backup
+    let restore uploads = backgroundTask {
+        log.LogTrace "Upload.restore"
+        for batch in uploads |> List.chunkBySize 5 do
+            let! _ =
+                Configuration.dataSource ()
+                |> Sql.fromDataSource
+                |> Sql.executeTransactionAsync [ upInsert, batch |> List.map upParams ]
+            ()
+    }
+    
+    interface IUploadData with
+        member _.Add upload = add upload
+        member _.Delete uploadId webLogId = delete uploadId webLogId
+        member _.FindByPath path webLogId = findByPath path webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
+        member _.Restore uploads = restore uploads
+        

src/MyWebLog.Data/Postgres/PostgresWebLogData.fs

@@ -0,0 +1,83 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+
+/// PostgreSQL myWebLog web log data implementation
+type PostgresWebLogData(log: ILogger) =
+    
+    /// Add a web log
+    let add (webLog: WebLog) =
+        log.LogTrace "WebLog.add"
+        insert Table.WebLog webLog
+    
+    /// Retrieve all web logs
+    let all () =
+        log.LogTrace "WebLog.all"
+        Find.all<WebLog> Table.WebLog
+    
+    /// Delete a web log by its ID
+    let delete webLogId =
+        log.LogTrace "WebLog.delete"
+        Custom.nonQuery
+            $"""DELETE FROM {Table.PostComment}
+                 WHERE data ->> '{nameof Comment.Empty.PostId}'
+                         IN (SELECT data ->> '{nameof Post.Empty.Id}'
+                               FROM {Table.Post}
+                              WHERE {Query.whereDataContains "@criteria"});
+                DELETE FROM {Table.PostRevision}
+                 WHERE post_id IN (SELECT data ->> 'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
+                DELETE FROM {Table.PageRevision}
+                 WHERE page_id IN (SELECT data ->> 'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
+                {Query.Delete.byContains Table.Post};
+                {Query.Delete.byContains Table.Page};
+                {Query.Delete.byContains Table.Category};
+                {Query.Delete.byContains Table.TagMap};
+                {Query.Delete.byContains Table.WebLogUser};
+                DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
+                DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
+            [ webLogIdParam webLogId; webLogContains webLogId ]
+    
+    /// Find a web log by its host (URL base)
+    let findByHost (url: string) =
+        log.LogTrace "WebLog.findByHost"
+        Find.firstByContains<WebLog> Table.WebLog {| UrlBase = url |}
+    
+    /// Find a web log by its ID
+    let findById (webLogId: WebLogId) = 
+        log.LogTrace "WebLog.findById"
+        Find.byId<WebLogId, WebLog> Table.WebLog webLogId
+    
+    /// Update redirect rules for a web log
+    let updateRedirectRules (webLog: WebLog) = backgroundTask {
+        log.LogTrace "WebLog.updateRedirectRules"
+        match! findById webLog.Id with
+        | Some _ -> do! Patch.byId Table.WebLog webLog.Id {| RedirectRules = webLog.RedirectRules |}
+        | None -> ()
+    }
+    
+    /// Update RSS options for a web log
+    let updateRssOptions (webLog: WebLog) = backgroundTask {
+        log.LogTrace "WebLog.updateRssOptions"
+        match! findById webLog.Id with
+        | Some _ -> do! Patch.byId Table.WebLog webLog.Id {| Rss = webLog.Rss |}
+        | None -> ()
+    }
+    
+    /// Update settings for a web log
+    let updateSettings (webLog: WebLog) =
+        log.LogTrace "WebLog.updateSettings"
+        Update.byId Table.WebLog webLog.Id webLog
+    
+    interface IWebLogData with
+        member _.Add webLog = add webLog
+        member _.All() = all ()
+        member _.Delete webLogId = delete webLogId
+        member _.FindByHost url = findByHost url
+        member _.FindById webLogId = findById webLogId
+        member _.UpdateRedirectRules webLog = updateRedirectRules webLog
+        member _.UpdateRssOptions webLog = updateRssOptions webLog
+        member _.UpdateSettings webLog = updateSettings webLog

src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs

@@ -0,0 +1,102 @@
+namespace MyWebLog.Data.Postgres
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog user data implementation
+type PostgresWebLogUserData(log: ILogger) =
+    
+    /// Add a user
+    let add (user: WebLogUser) =
+        log.LogTrace "WebLogUser.add"
+        insert Table.WebLogUser user
+    
+    /// Find a user by their ID for the given web log
+    let findById userId webLogId =
+        log.LogTrace "WebLogUser.findById"
+        Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId
+    
+    /// Delete a user if they have no posts or pages
+    let delete userId webLogId = backgroundTask {
+        log.LogTrace "WebLogUser.delete"
+        match! findById userId webLogId with
+        | Some _ ->
+            let  criteria = Query.whereDataContains "@criteria"
+            let! isAuthor =
+                Custom.scalar
+                    $" SELECT (   EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria})
+                               OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
+                              ) AS it"
+                    [ jsonParam "@criteria" {| AuthorId = userId |} ]
+                    toExists
+            if isAuthor then
+                return Error "User has pages or posts; cannot delete"
+            else
+                do! Delete.byId Table.WebLogUser userId
+                return Ok true
+        | None -> return Error "User does not exist"
+    }
+    
+    /// Find a user by their e-mail address for the given web log
+    let findByEmail (email: string) webLogId =
+        log.LogTrace "WebLogUser.findByEmail"
+        Find.firstByContains<WebLogUser> Table.WebLogUser {| webLogDoc webLogId with Email = email |}
+    
+    /// Get all users for the given web log
+    let findByWebLog webLogId =
+        log.LogTrace "WebLogUser.findByWebLog"
+        Custom.list
+            $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')"
+            [ webLogContains webLogId ]
+            fromData<WebLogUser>
+    
+    /// Find the names of users by their IDs for the given web log
+    let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
+        log.LogTrace "WebLogUser.findNames"
+        let idSql, idParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" userIds
+        let! users =
+            Custom.list
+                $"{selectWithCriteria Table.WebLogUser} {idSql}"
+                (webLogContains webLogId :: idParams)
+                fromData<WebLogUser>
+        return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
+    }
+    
+    /// Restore users from a backup
+    let restore (users: WebLogUser list) = backgroundTask {
+        log.LogTrace "WebLogUser.restore"
+        let! _ =
+            Configuration.dataSource ()
+            |> Sql.fromDataSource
+            |> Sql.executeTransactionAsync
+                [ Query.insert Table.WebLogUser, users |> List.map (fun user -> [ jsonParam "@data" user ]) ]
+        ()
+    }
+    
+    /// Set a user's last seen date/time to now
+    let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
+        log.LogTrace "WebLogUser.setLastSeen"
+        match! Document.existsByWebLog Table.WebLogUser userId webLogId with
+        | true -> do! Patch.byId Table.WebLogUser userId {| LastSeenOn = Some (Noda.now ()) |}
+        | false -> ()
+    }
+    
+    /// Update a user
+    let update (user: WebLogUser) =
+        log.LogTrace "WebLogUser.update"
+        Update.byId Table.WebLogUser user.Id user
+    
+    interface IWebLogUserData with
+        member _.Add user = add user
+        member _.Delete userId webLogId = delete userId webLogId
+        member _.FindByEmail email webLogId = findByEmail email webLogId
+        member _.FindById userId webLogId = findById userId webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.FindNames webLogId userIds = findNames webLogId userIds
+        member _.Restore users = restore users
+        member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
+        member _.Update user = update user

src/MyWebLog.Data/PostgresData.fs

@@ -0,0 +1,255 @@
+namespace MyWebLog.Data
+
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
+open Microsoft.Extensions.Logging
+open MyWebLog
+open MyWebLog.Data.Postgres
+open Newtonsoft.Json
+open Npgsql.FSharp
+
+/// Data implementation for PostgreSQL
+type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
+    
+    /// Create any needed tables
+    let ensureTables () = backgroundTask {
+        // Set up the PostgreSQL document store
+        Configuration.useSerializer (Utils.createDocumentSerializer ser)
+        
+        let! tables =
+            Custom.list
+                "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename")
+        let needsTable table = not (List.contains table tables)
+        
+        let sql = seq {
+            // Theme tables
+            if needsTable Table.Theme then
+                Query.Definition.ensureTable Table.Theme
+                Query.Definition.ensureKey   Table.Theme
+            if needsTable Table.ThemeAsset then
+                $"CREATE TABLE {Table.ThemeAsset} (
+                    theme_id    TEXT        NOT NULL,
+                    path        TEXT        NOT NULL,
+                    updated_on  TIMESTAMPTZ NOT NULL,
+                    data        BYTEA       NOT NULL,
+                    PRIMARY KEY (theme_id, path))"
+            
+            // Web log table
+            if needsTable Table.WebLog then
+                Query.Definition.ensureTable         Table.WebLog
+                Query.Definition.ensureKey           Table.WebLog
+                Query.Definition.ensureDocumentIndex Table.WebLog Optimized
+            
+            // Category table
+            if needsTable Table.Category then
+                Query.Definition.ensureTable         Table.Category
+                Query.Definition.ensureKey           Table.Category
+                Query.Definition.ensureDocumentIndex Table.Category Optimized
+            
+            // Web log user table
+            if needsTable Table.WebLogUser then
+                Query.Definition.ensureTable         Table.WebLogUser
+                Query.Definition.ensureKey           Table.WebLogUser
+                Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
+            
+            // Page tables
+            if needsTable Table.Page then
+                Query.Definition.ensureTable   Table.Page
+                Query.Definition.ensureKey     Table.Page
+                Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]
+                Query.Definition.ensureIndexOn
+                    Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
+            if needsTable Table.PageRevision then
+                $"CREATE TABLE {Table.PageRevision} (
+                    page_id        TEXT        NOT NULL,
+                    as_of          TIMESTAMPTZ NOT NULL,
+                    revision_text  TEXT        NOT NULL,
+                    PRIMARY KEY (page_id, as_of))"
+            
+            // Post tables
+            if needsTable Table.Post then
+                Query.Definition.ensureTable   Table.Post
+                Query.Definition.ensureKey     Table.Post
+                Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]
+                Query.Definition.ensureIndexOn
+                    Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
+                Query.Definition.ensureIndexOn
+                    Table.Post
+                    "status"
+                    [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
+                $"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
+                $"CREATE INDEX idx_post_tag      ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
+            if needsTable Table.PostRevision then
+                $"CREATE TABLE {Table.PostRevision} (
+                    post_id        TEXT        NOT NULL,
+                    as_of          TIMESTAMPTZ NOT NULL,
+                    revision_text  TEXT        NOT NULL,
+                    PRIMARY KEY (post_id, as_of))"
+            if needsTable Table.PostComment then
+                Query.Definition.ensureTable   Table.PostComment
+                Query.Definition.ensureKey     Table.PostComment
+                Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]
+            
+            // Tag map table
+            if needsTable Table.TagMap then
+                Query.Definition.ensureTable         Table.TagMap
+                Query.Definition.ensureKey           Table.TagMap
+                Query.Definition.ensureDocumentIndex Table.TagMap Optimized
+            
+            // Uploaded file table
+            if needsTable Table.Upload then
+                $"CREATE TABLE {Table.Upload} (
+                    id          TEXT        NOT NULL PRIMARY KEY,
+                    web_log_id  TEXT        NOT NULL,
+                    path        TEXT        NOT NULL,
+                    updated_on  TIMESTAMPTZ NOT NULL,
+                    data        BYTEA       NOT NULL)"
+                $"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)"
+                $"CREATE INDEX idx_upload_path    ON {Table.Upload} (web_log_id, path)"
+            
+            // Database version table
+            if needsTable Table.DbVersion then
+                $"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
+                $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
+        }
+        
+        Configuration.dataSource ()
+        |> Sql.fromDataSource
+        |> Sql.executeTransactionAsync
+            (sql
+             |> Seq.map (fun s ->
+                let parts = s.Replace(" IF NOT EXISTS", "", System.StringComparison.OrdinalIgnoreCase).Split ' '
+                if parts[1].ToLowerInvariant() = "table" then
+                    log.LogInformation $"Creating {parts[2]} table..."
+                s, [ [] ])
+             |> List.ofSeq)
+        |> Async.AwaitTask
+        |> Async.RunSynchronously
+        |> ignore
+    }
+    
+    /// Set a specific database version
+    let setDbVersion version = backgroundTask {
+        do! Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
+        return version
+    }
+    
+    /// Migrate from v2-rc2 to v2 (manual migration required)
+    let migrateV2Rc2ToV2 () = backgroundTask {
+        let! webLogs =
+            Custom.list
+                $"SELECT url_base, slug FROM {Table.WebLog}" [] (fun row -> row.string "url_base", row.string "slug")
+        Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs
+    }
+
+    /// Migrate from v2 to v2.1.1
+    let migrateV2ToV2point1point1 () = backgroundTask {
+        let migration = "v2 to v2.1.1"
+        Utils.Migration.logStep log migration "Adding empty redirect rule set to all weblogs"
+        do! Custom.nonQuery $"""UPDATE {Table.WebLog} SET data = data || '{{ "RedirectRules": [] }}'::jsonb""" []
+
+        let tables =
+            [ Table.Category; Table.Page; Table.Post; Table.PostComment; Table.TagMap; Table.Theme; Table.WebLog
+              Table.WebLogUser ]
+        
+        Utils.Migration.logStep log migration "Adding unique indexes on ID fields"
+        do! Custom.nonQuery (tables |> List.map Query.Definition.ensureKey |> String.concat "; ") []
+        
+        Utils.Migration.logStep log migration "Removing constraints"
+        let fkToDrop =
+            [ "page_revision", "page_revision_page_id_fkey"
+              "post_revision", "post_revision_post_id_fkey"
+              "theme_asset",   "theme_asset_theme_id_fkey"
+              "upload",        "upload_web_log_id_fkey"
+              "category",      "category_pkey"
+              "page",          "page_pkey"
+              "post",          "post_pkey"
+              "post_comment",  "post_comment_pkey"
+              "tag_map",       "tag_map_pkey"
+              "theme",         "theme_pkey"
+              "web_log",       "web_log_pkey"
+              "web_log_user",  "web_log_user_pkey" ]
+        do! Custom.nonQuery
+                (fkToDrop
+                 |> List.map (fun (tbl, fk) -> $"ALTER TABLE {tbl} DROP CONSTRAINT {fk}")
+                 |> String.concat "; ")
+                []
+        
+        Utils.Migration.logStep log migration "Dropping old indexes"
+        let toDrop =
+            [ "idx_category"; "page_author_idx"; "page_permalink_idx"; "page_web_log_idx"; "post_author_idx"
+              "post_category_idx"; "post_permalink_idx"; "post_status_idx"; "post_tag_idx"; "post_web_log_idx"
+              "post_comment_post_idx"; "idx_tag_map"; "idx_web_log"; "idx_web_log_user" ]
+        do! Custom.nonQuery (toDrop |> List.map (sprintf "DROP INDEX %s") |> String.concat "; ") []
+        
+        Utils.Migration.logStep log migration "Dropping old ID columns"
+        do! Custom.nonQuery (tables |> List.map (sprintf "ALTER TABLE %s DROP COLUMN id") |> String.concat "; ") []
+        
+        Utils.Migration.logStep log migration "Adding new indexes"
+        let newIdx =
+            [ yield! tables |> List.map Query.Definition.ensureKey
+              Query.Definition.ensureDocumentIndex Table.Category   Optimized
+              Query.Definition.ensureDocumentIndex Table.TagMap     Optimized
+              Query.Definition.ensureDocumentIndex Table.WebLog     Optimized
+              Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
+              Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]
+              Query.Definition.ensureIndexOn
+                  Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
+              Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]
+              Query.Definition.ensureIndexOn
+                  Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
+              Query.Definition.ensureIndexOn
+                  Table.Post
+                  "status"
+                  [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
+              $"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
+              $"CREATE INDEX idx_post_tag      ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
+              Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] ]
+        do! Custom.nonQuery (newIdx |> String.concat "; ") []
+        
+        Utils.Migration.logStep log migration "Setting database to version 2.1.1"
+        return! setDbVersion "v2.1.1"
+    }
+
+    /// Do required data migration between versions
+    let migrate version = backgroundTask {
+        let mutable v = defaultArg version ""
+
+        if v = "v2-rc2" then 
+            let! webLogs =
+                Custom.list
+                    $"SELECT url_base, slug FROM {Table.WebLog}" []
+                    (fun row -> row.string "url_base", row.string "slug")
+            Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs
+        
+        if v = "v2" then
+            let! ver = migrateV2ToV2point1point1 ()
+            v <- ver
+        
+        if v <> Utils.Migration.currentDbVersion then
+            log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
+            let! _ = setDbVersion Utils.Migration.currentDbVersion
+            ()
+    }
+        
+    interface IData with
+        
+        member _.Category   = PostgresCategoryData   log
+        member _.Page       = PostgresPageData       log
+        member _.Post       = PostgresPostData       log
+        member _.TagMap     = PostgresTagMapData     log
+        member _.Theme      = PostgresThemeData      log
+        member _.ThemeAsset = PostgresThemeAssetData log
+        member _.Upload     = PostgresUploadData     log
+        member _.WebLog     = PostgresWebLogData     log
+        member _.WebLogUser = PostgresWebLogUserData log
+        
+        member _.Serializer = ser
+        
+        member _.StartUp () = backgroundTask {
+            log.LogTrace "PostgresData.StartUp"
+            do! ensureTables ()
+            
+            let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
+            do! migrate version
+        }

src/MyWebLog.Data/RethinkDbData.fs

@@ -5,7 +5,6 @@ open MyWebLog
 open RethinkDb.Driver
 
 /// Functions to assist with retrieving data
-[<AutoOpen>]
 module private RethinkHelpers =
     
     /// Table names
@@ -18,6 +17,9 @@ module private RethinkHelpers =
         /// The comment table
         let Comment = "Comment"
         
+        /// The database version table
+        let DbVersion = "DbVersion"
+        
         /// The page table
         let Page = "Page"
         
@@ -43,7 +45,7 @@ module private RethinkHelpers =
         let WebLogUser = "WebLogUser"
 
         /// A list of all tables
-        let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
+        let all = [ Category; Comment; DbVersion; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
 
     
     /// Index names for indexes not on a data item's name
@@ -87,14 +89,19 @@ open System
 open Microsoft.Extensions.Logging
 open MyWebLog.ViewModels
 open RethinkDb.Driver.FSharp
+open RethinkHelpers
 
 /// RethinkDB implementation of data functions for myWebLog
 type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<RethinkDbData>) =
     
     /// Match theme asset IDs by their prefix (the theme ID)
     let matchAssetByThemeId themeId =
-        let keyPrefix = $"^{ThemeId.toString themeId}/"
+        let keyPrefix = $"^{themeId}/"
-        fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
+        fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj
+    
+    /// Function to exclude template text from themes
+    let withoutTemplateText (row: Ast.ReqlExpr) : obj =
+        {|  Templates = row[nameof Theme.Empty.Templates].Merge(r.HashMap(nameof ThemeTemplate.Empty.Text, "")) |}
         
     /// Ensure field indexes exist, as well as special indexes for selected tables
     let ensureIndexes table fields = backgroundTask {
@@ -105,27 +112,27 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
         // Post and page need index by web log ID and permalink
         if [ Table.Page; Table.Post ] |> List.contains table then
-            let permalinkIdx = nameof Page.empty.Permalink
+            let permalinkIdx = nameof Page.Empty.Permalink
             if not (indexes |> List.contains permalinkIdx) then
                 log.LogInformation $"Creating index {table}.{permalinkIdx}..."
                 do! rethink {
                     withTable table
                     indexCreate permalinkIdx
-                        (fun row -> r.Array (row[nameof Page.empty.WebLogId], row[permalinkIdx].Downcase ()) :> obj)
+                        (fun row -> r.Array(row[nameof Page.Empty.WebLogId], row[permalinkIdx].Downcase()) :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
             // Prior permalinks are searched when a post or page permalink do not match the current URL
-            let priorIdx = nameof Post.empty.PriorPermalinks
+            let priorIdx = nameof Post.Empty.PriorPermalinks
             if not (indexes |> List.contains priorIdx) then
                 log.LogInformation $"Creating index {table}.{priorIdx}..."
                 do! rethink {
                     withTable table
-                    indexCreate priorIdx (fun row -> row[priorIdx].Downcase () :> obj) [ Multi ]
+                    indexCreate priorIdx [ Multi ]
                     write; withRetryOnce; ignoreResult conn
                 }
         // Post needs indexes by category and tag (used for counting and retrieving posts)
         if Table.Post = table then
-            for idx in [ nameof Post.empty.CategoryIds; nameof Post.empty.Tags ] do
+            for idx in [ nameof Post.Empty.CategoryIds; nameof Post.Empty.Tags ] do
                 if not (List.contains idx indexes) then
                     log.LogInformation $"Creating index {table}.{idx}..."
                     do! rethink {
@@ -140,7 +147,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 do! rethink {
                     withTable table
                     indexCreate Index.WebLogAndTag (fun row ->
-                        [| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.Tag] |] :> obj)
+                        [| row[nameof TagMap.Empty.WebLogId]; row[nameof TagMap.Empty.Tag] |] :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
             if not (indexes |> List.contains Index.WebLogAndUrl) then
@@ -148,7 +155,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 do! rethink {
                     withTable table
                     indexCreate Index.WebLogAndUrl (fun row ->
-                        [| row[nameof TagMap.empty.WebLogId]; row[nameof TagMap.empty.UrlValue] |] :> obj)
+                        [| row[nameof TagMap.Empty.WebLogId]; row[nameof TagMap.Empty.UrlValue] |] :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
         // Uploaded files need an index by web log ID and path, as that is how they are retrieved
@@ -158,7 +165,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 do! rethink {
                     withTable table
                     indexCreate Index.WebLogAndPath (fun row ->
-                        [| row[nameof Upload.empty.WebLogId]; row[nameof Upload.empty.Path] |] :> obj)
+                        [| row[nameof Upload.Empty.WebLogId]; row[nameof Upload.Empty.Path] |] :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
         // Users log on with e-mail
@@ -168,14 +175,100 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 do! rethink {
                     withTable table
                     indexCreate Index.LogOn (fun row ->
-                        [| row[nameof WebLogUser.empty.WebLogId]; row[nameof WebLogUser.empty.Email] |] :> obj)
+                        [| row[nameof WebLogUser.Empty.WebLogId]; row[nameof WebLogUser.Empty.Email] |] :> obj)
                     write; withRetryOnce; ignoreResult conn
                 }
+        do! rethink { withTable table; indexWait; result; withRetryDefault; ignoreResult conn }
     }
     
     /// The batch size for restoration methods
     let restoreBatchSize = 100
     
+    /// A value to use when files need to be retrieved without their data
+    let emptyFile = r.Binary(Array.Empty<byte>())
+    
+    /// Delete assets for the given theme ID
+    let deleteAssetsByTheme themeId = rethink {
+        withTable Table.ThemeAsset
+        filter (matchAssetByThemeId themeId)
+        delete
+        write; withRetryDefault; ignoreResult conn
+    }
+    
+    /// Set a specific database version
+    let setDbVersion (version: string) = backgroundTask {
+        do! rethink {
+            withTable Table.DbVersion
+            delete
+            write; withRetryOnce; ignoreResult conn
+        }
+        do! rethink {
+            withTable Table.DbVersion
+            insert {| Id = version |}
+            write; withRetryOnce; ignoreResult conn
+        }
+    }
+    
+    /// Migrate from v2-rc1 to v2-rc2
+    let migrateV2Rc1ToV2Rc2 () = backgroundTask {
+        let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2"
+        logStep "**IMPORTANT**"
+        logStep "See release notes about required backup/restoration for RethinkDB."
+        logStep "If there is an error immediately below this message, this is why."
+        logStep "Setting database version to v2-rc2"
+        do! setDbVersion "v2-rc2"
+    }
+
+    /// Migrate from v2-rc2 to v2
+    let migrateV2Rc2ToV2 () = backgroundTask {
+        Utils.Migration.logStep log "v2-rc2 to v2" "Setting database version; no migration required"
+        do! setDbVersion "v2"
+    }
+
+    /// Migrate from v2 to v2.1
+    let migrateV2ToV2point1 () = backgroundTask {
+        Utils.Migration.logStep log "v2 to v2.1" "Adding empty redirect rule set to all weblogs"
+        do! rethink {
+            withTable Table.WebLog
+            update [ nameof WebLog.Empty.RedirectRules, [] :> obj ]
+            write; withRetryOnce; ignoreResult conn
+        }
+        
+        Utils.Migration.logStep log "v2 to v2.1" "Setting database version to v2.1"
+        do! setDbVersion "v2.1"
+    }
+    
+    /// Migrate from v2.1 to v2.1.1
+    let migrateV2ToV2point1point1 () = backgroundTask {
+        Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
+        do! setDbVersion "v2.1.1"
+    }
+
+    /// Migrate data between versions
+    let migrate version = backgroundTask {
+        let mutable v = defaultArg version ""
+        
+        if v = "v2-rc1" then
+            do! migrateV2Rc1ToV2Rc2 ()
+            v <- "v2-rc2"
+
+        if v = "v2-rc2" then
+            do! migrateV2Rc2ToV2 ()
+            v <- "v2"
+        
+        if v = "v2" then
+            do! migrateV2ToV2point1 ()
+            v <- "v2.1"
+        
+        if v = "v2.1" then
+            do! migrateV2ToV2point1point1 ()
+            v <- "v2.1.1"
+        
+        if v <> Utils.Migration.currentDbVersion then
+            log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
+            do! setDbVersion Utils.Migration.currentDbVersion
+    }
+    
     /// The connection for this instance
     member _.Conn = conn
     
@@ -192,15 +285,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.CountAll webLogId = rethink<int> {
                     withTable Table.Category
-                    getAll [ webLogId ] (nameof Category.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Category.Empty.WebLogId)
                     count
                     result; withRetryDefault conn
                 }
 
                 member _.CountTopLevel webLogId = rethink<int> {
                     withTable Table.Category
-                    getAll [ webLogId ] (nameof Category.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Category.Empty.WebLogId)
-                    filter (nameof Category.empty.ParentId) None
+                    filter (nameof Category.Empty.ParentId) None (Default FilterDefaultHandling.Return)
                     count
                     result; withRetryDefault conn
                 }
@@ -208,8 +301,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 member _.FindAllForView webLogId = backgroundTask {
                     let! cats = rethink<Category list> {
                         withTable Table.Category
-                        getAll [ webLogId ] (nameof Category.empty.WebLogId)
+                        getAll [ webLogId ] (nameof Category.Empty.WebLogId)
-                        orderByFunc (fun it -> it[nameof Category.empty.Name].Downcase () :> obj)
+                        orderByFunc (fun it -> it[nameof Category.Empty.Name].Downcase() :> obj)
                         result; withRetryDefault conn
                     }
                     let  ordered = Utils.orderByHierarchy cats None None []
@@ -225,8 +318,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                                 |> List.ofSeq
                             let! count = rethink<int> {
                                 withTable Table.Post
-                                getAll catIds (nameof Post.empty.CategoryIds)
+                                getAll catIds (nameof Post.Empty.CategoryIds)
-                                filter (nameof Post.empty.Status) Published
+                                filter (nameof Post.Empty.Status) Published
                                 distinct
                                 count
                                 result; withRetryDefault conn
@@ -241,8 +334,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                                 PostCount = counts
                                             |> Array.tryFind (fun c -> fst c = cat.Id)
                                             |> Option.map snd
-                                            |> Option.defaultValue 0
+                                            |> Option.defaultValue 0 })
-                            })
                         |> Array.ofSeq
                 }
                 
@@ -252,24 +344,40 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         get catId
                         resultOption; withRetryOptionDefault
                     }
-                    |> verifyWebLog webLogId (fun c -> c.WebLogId) <| conn
+                    |> verifyWebLog webLogId _.WebLogId <| conn
                 
                 member _.FindByWebLog webLogId = rethink<Category list> {
                     withTable Table.Category
-                    getAll [ webLogId ] (nameof Category.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Category.Empty.WebLogId)
                     result; withRetryDefault conn
                 }
                 
                 member this.Delete catId webLogId = backgroundTask {
                     match! this.FindById catId webLogId with
-                    | Some _ ->
+                    | Some cat ->
+                        // Reassign any children to the category's parent category
+                        let! children = rethink<int> {
+                            withTable Table.Category
+                            filter (nameof Category.Empty.ParentId) catId
+                            count
+                            result; withRetryDefault conn
+                        }
+                        if children > 0 then
+                            do! rethink {
+                                withTable Table.Category
+                                filter (nameof Category.Empty.ParentId) catId
+                                update [ nameof Category.Empty.ParentId, cat.ParentId :> obj ]
+                                write; withRetryDefault; ignoreResult conn
+                            }
                         // Delete the category off all posts where it is assigned
                         do! rethink {
                             withTable Table.Post
-                            getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                            getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                            filter (fun row -> row[nameof Post.empty.CategoryIds].Contains catId :> obj)
+                            filter (fun row -> row[nameof Post.Empty.CategoryIds].Contains catId :> obj)
                             update (fun row ->
-                                {| CategoryIds = r.Array(row[nameof Post.empty.CategoryIds]).Remove catId |} :> obj)
+                                {| CategoryIds =
+                                        row[nameof Post.Empty.CategoryIds].CoerceTo("array")
+                                            .SetDifference(r.Array(catId)) |} :> obj)
                             write; withRetryDefault; ignoreResult conn 
                         }
                         // Delete the category itself
@@ -279,8 +387,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                             delete
                             write; withRetryDefault; ignoreResult conn
                         }
-                        return true
+                        return if children = 0 then CategoryDeleted else ReassignedChildCategories
-                    | None -> return false
+                    | None -> return CategoryNotFound
                 }
                 
                 member _.Restore cats = backgroundTask {
@@ -315,26 +423,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
 
                 member _.All webLogId = rethink<Page list> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
-                    without [ nameof Page.empty.Text
+                    merge (r.HashMap(nameof Page.Empty.Text, "")
-                              nameof Page.empty.Metadata
+                               .With(nameof Page.Empty.Metadata, [||])
-                              nameof Page.empty.Revisions
+                               .With(nameof Page.Empty.Revisions, [||])
-                              nameof Page.empty.PriorPermalinks ]
+                               .With(nameof Page.Empty.PriorPermalinks, [||]))
-                    orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase () :> obj)
+                    orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase() :> obj)
                     result; withRetryDefault conn
                 }
                 
                 member _.CountAll webLogId = rethink<int> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
                     count
                     result; withRetryDefault conn
                 }
 
                 member _.CountListed webLogId = rethink<int> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
-                    filter (nameof Page.empty.IsInPageList) true
+                    filter (nameof Page.Empty.IsInPageList) true
                     count
                     result; withRetryDefault conn
                 }
@@ -343,7 +451,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! result = rethink<Model.Result> {
                         withTable Table.Page
                         getAll [ pageId ]
-                        filter (fun row -> row[nameof Page.empty.WebLogId].Eq webLogId :> obj)
+                        filter (fun row -> row[nameof Page.Empty.WebLogId].Eq webLogId :> obj)
                         delete
                         write; withRetryDefault conn
                     }
@@ -351,19 +459,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 }
                 
                 member _.FindById pageId webLogId =
-                    rethink<Page> {
+                    rethink<Page list> {
                         withTable Table.Page
-                        get pageId
+                        getAll [ pageId ]
-                        without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
+                        filter (nameof Page.Empty.WebLogId) webLogId
-                        resultOption; withRetryOptionDefault
+                        merge (r.HashMap(nameof Page.Empty.PriorPermalinks, [||])
+                                   .With(nameof Page.Empty.Revisions, [||]))
+                        result; withRetryDefault
                     }
-                    |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
+                    |> tryFirst <| conn
 
                 member _.FindByPermalink permalink webLogId =
                     rethink<Page list> {
                         withTable Table.Page
-                        getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.empty.Permalink)
+                        getAll [ [| webLogId :> obj; permalink |] ] (nameof Page.Empty.Permalink)
-                        without [ nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
+                        merge (r.HashMap(nameof Page.Empty.PriorPermalinks, [||])
+                                   .With(nameof Page.Empty.Revisions, [||]))
                         limit 1
                         result; withRetryDefault
                     }
@@ -373,14 +484,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! result =
                         (rethink<Page list> {
                             withTable Table.Page
-                            getAll (objList permalinks) (nameof Page.empty.PriorPermalinks)
+                            getAll (objList permalinks) (nameof Page.Empty.PriorPermalinks)
-                            filter (nameof Page.empty.WebLogId) webLogId
+                            filter (nameof Page.Empty.WebLogId) webLogId
-                            without [ nameof Page.empty.Revisions; nameof Page.empty.Text ]
+                            without [ nameof Page.Empty.Revisions; nameof Page.Empty.Text ]
                             limit 1
                             result; withRetryDefault
                         }
                         |> tryFirst) conn
-                    return result |> Option.map (fun pg -> pg.Permalink)
+                    return result |> Option.map _.Permalink
                 }
                 
                 member _.FindFullById pageId webLogId =
@@ -389,30 +500,32 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         get pageId
                         resultOption; withRetryOptionDefault
                     }
-                    |> verifyWebLog webLogId (fun it -> it.WebLogId) <| conn
+                    |> verifyWebLog webLogId _.WebLogId <| conn
                 
                 member _.FindFullByWebLog webLogId = rethink<Page> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
                     resultCursor; withRetryCursorDefault; toList conn
                 }
                 
                 member _.FindListed webLogId = rethink<Page list> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
-                    filter [ nameof Page.empty.IsInPageList, true :> obj ]
+                    filter [ nameof Page.Empty.IsInPageList, true :> obj ]
-                    without [ nameof Page.empty.Text; nameof Page.empty.PriorPermalinks; nameof Page.empty.Revisions ]
+                    merge (r.HashMap(nameof Page.Empty.Text, "")
-                    orderBy (nameof Page.empty.Title)
+                               .With(nameof Page.Empty.PriorPermalinks, [||])
+                               .With(nameof Page.Empty.Revisions, [||]))
+                    orderBy (nameof Page.Empty.Title)
                     result; withRetryDefault conn
                 }
 
                 member _.FindPageOfPages webLogId pageNbr = rethink<Page list> {
                     withTable Table.Page
-                    getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Page.Empty.WebLogId)
-                    without [ nameof Page.empty.Metadata
+                    merge (r.HashMap(nameof Page.Empty.Metadata, [||])
-                              nameof Page.empty.PriorPermalinks
+                               .With(nameof Page.Empty.PriorPermalinks, [||])
-                              nameof Page.empty.Revisions ]
+                               .With(nameof Page.Empty.Revisions, [||]))
-                    orderByFunc (fun row -> row[nameof Page.empty.Title].Downcase ())
+                    orderByFunc (fun row -> row[nameof Page.Empty.Title].Downcase())
                     skip ((pageNbr - 1) * 25)
                     limit 25
                     result; withRetryDefault conn
@@ -450,7 +563,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         do! rethink {
                             withTable Table.Page
                             get pageId
-                            update [ nameof Page.empty.PriorPermalinks, permalinks :> obj ]
+                            update [ nameof Page.Empty.PriorPermalinks, permalinks :> obj ]
                             write; withRetryDefault; ignoreResult conn
                         }
                         return true
@@ -469,8 +582,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.CountByStatus status webLogId = rethink<int> {
                     withTable Table.Post
-                    getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                    filter (nameof Post.empty.Status) status
+                    filter (nameof Post.Empty.Status) status
                     count
                     result; withRetryDefault conn
                 }
@@ -479,7 +592,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! result = rethink<Model.Result> {
                         withTable Table.Post
                         getAll [ postId ]
-                        filter (fun row -> row[nameof Post.empty.WebLogId].Eq webLogId :> obj)
+                        filter (fun row -> row[nameof Post.Empty.WebLogId].Eq webLogId :> obj)
                         delete
                         write; withRetryDefault conn
                     }
@@ -487,19 +600,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 }
                 
                 member _.FindById postId webLogId =
-                    rethink<Post> {
+                    rethink<Post list> {
                         withTable Table.Post
-                        get postId
+                        getAll [ postId ]
-                        without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                        filter (nameof Post.Empty.WebLogId) webLogId
-                        resultOption; withRetryOptionDefault
+                        merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
+                                   .With(nameof Post.Empty.Revisions, [||]))
+                        result; withRetryDefault
                     }
-                    |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
+                    |> tryFirst <| conn
                 
                 member _.FindByPermalink permalink webLogId =
                     rethink<Post list> {
                         withTable Table.Post
-                        getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.empty.Permalink)
+                        getAll [ [| webLogId :> obj; permalink |] ] (nameof Post.Empty.Permalink)
-                        without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                        merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
+                                   .With(nameof Post.Empty.Revisions, [||]))
                         limit 1
                         result; withRetryDefault
                     }
@@ -511,36 +627,37 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         get postId
                         resultOption; withRetryOptionDefault
                     }
-                    |> verifyWebLog webLogId (fun p -> p.WebLogId) <| conn
+                    |> verifyWebLog webLogId _.WebLogId <| conn
 
                 member _.FindCurrentPermalink permalinks webLogId = backgroundTask {
                     let! result =
                         (rethink<Post list> {
                             withTable Table.Post
-                            getAll (objList permalinks) (nameof Post.empty.PriorPermalinks)
+                            getAll (objList permalinks) (nameof Post.Empty.PriorPermalinks)
-                            filter (nameof Post.empty.WebLogId) webLogId
+                            filter (nameof Post.Empty.WebLogId) webLogId
-                            without [ nameof Post.empty.Revisions; nameof Post.empty.Text ]
+                            without [ nameof Post.Empty.Revisions; nameof Post.Empty.Text ]
                             limit 1
                             result; withRetryDefault
                         }
                         |> tryFirst) conn
-                    return result |> Option.map (fun post -> post.Permalink)
+                    return result |> Option.map _.Permalink
                 }
                 
                 member _.FindFullByWebLog webLogId = rethink<Post> {
                     withTable Table.Post
-                    getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Post.Empty.WebLogId)
                     resultCursor; withRetryCursorDefault; toList conn
                 }
                 
                 member _.FindPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
                     withTable Table.Post
-                    getAll (objList categoryIds) (nameof Post.empty.CategoryIds)
+                    getAll (objList categoryIds) (nameof Post.Empty.CategoryIds)
-                    filter [ nameof Post.empty.WebLogId, webLogId :> obj
+                    filter [ nameof Post.Empty.WebLogId, webLogId :> obj
-                             nameof Post.empty.Status,   Published ]
+                             nameof Post.Empty.Status,   Published ]
-                    without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                    merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
+                               .With(nameof Post.Empty.Revisions, [||]))
                     distinct
-                    orderByDescending (nameof Post.empty.PublishedOn)
+                    orderByDescending (nameof Post.Empty.PublishedOn)
                     skip ((pageNbr - 1) * postsPerPage)
                     limit (postsPerPage + 1)
                     result; withRetryDefault conn
@@ -548,10 +665,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.FindPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
                     withTable Table.Post
-                    getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                    without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                    merge (r.HashMap(nameof Post.Empty.Text, "")
+                               .With(nameof Post.Empty.PriorPermalinks, [||])
+                               .With(nameof Post.Empty.Revisions, [||]))
                     orderByFuncDescending (fun row ->
-                        row[nameof Post.empty.PublishedOn].Default_ (nameof Post.empty.UpdatedOn) :> obj)
+                        row[nameof Post.Empty.PublishedOn].Default_(nameof Post.Empty.UpdatedOn) :> obj)
                     skip ((pageNbr - 1) * postsPerPage)
                     limit (postsPerPage + 1)
                     result; withRetryDefault conn
@@ -559,10 +678,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
 
                 member _.FindPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
                     withTable Table.Post
-                    getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                    getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                    filter (nameof Post.empty.Status) Published
+                    filter (nameof Post.Empty.Status) Published
-                    without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                    merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
-                    orderByDescending (nameof Post.empty.PublishedOn)
+                               .With(nameof Post.Empty.Revisions, [||]))
+                    orderByDescending (nameof Post.Empty.PublishedOn)
                     skip ((pageNbr - 1) * postsPerPage)
                     limit (postsPerPage + 1)
                     result; withRetryDefault conn
@@ -570,11 +690,12 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.FindPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
                     withTable Table.Post
-                    getAll [ tag ] (nameof Post.empty.Tags)
+                    getAll [ tag ] (nameof Post.Empty.Tags)
-                    filter [ nameof Post.empty.WebLogId, webLogId :> obj
+                    filter [ nameof Post.Empty.WebLogId, webLogId :> obj
-                             nameof Post.empty.Status,   Published ]
+                             nameof Post.Empty.Status,   Published ]
-                    without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                    merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
-                    orderByDescending (nameof Post.empty.PublishedOn)
+                               .With(nameof Post.Empty.Revisions, [||]))
+                    orderByDescending (nameof Post.Empty.PublishedOn)
                     skip ((pageNbr - 1) * postsPerPage)
                     limit (postsPerPage + 1)
                     result; withRetryDefault conn
@@ -584,10 +705,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! older =
                         rethink<Post list> {
                             withTable Table.Post
-                            getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                            getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                            filter (fun row -> row[nameof Post.empty.PublishedOn].Lt publishedOn :> obj)
+                            filter (fun row -> row[nameof Post.Empty.PublishedOn].Lt publishedOn :> obj)
-                            without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                            merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
-                            orderByDescending (nameof Post.empty.PublishedOn)
+                                       .With(nameof Post.Empty.Revisions, [||]))
+                            orderByDescending (nameof Post.Empty.PublishedOn)
                             limit 1
                             result; withRetryDefault
                         }
@@ -595,10 +717,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! newer =
                         rethink<Post list> {
                             withTable Table.Post
-                            getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                            getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                            filter (fun row -> row[nameof Post.empty.PublishedOn].Gt publishedOn :> obj)
+                            filter (fun row -> row[nameof Post.Empty.PublishedOn].Gt publishedOn :> obj)
-                            without [ nameof Post.empty.PriorPermalinks; nameof Post.empty.Revisions ]
+                            merge (r.HashMap(nameof Post.Empty.PriorPermalinks, [||])
-                            orderBy (nameof Post.empty.PublishedOn)
+                                       .With(nameof Post.Empty.Revisions, [||]))
+                            orderBy (nameof Post.Empty.PublishedOn)
                             limit 1
                             result; withRetryDefault
                         }
@@ -615,27 +738,25 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         }
                 }
                 
-                member _.Update post = rethink {
+                member this.Update post = backgroundTask {
+                    match! this.FindById post.Id post.WebLogId with
+                    | Some _ ->
+                        do! rethink {
                             withTable Table.Post
                             get post.Id
                             replace post
                             write; withRetryDefault; ignoreResult conn
                         }
-
+                    | None -> ()
-                member _.UpdatePriorPermalinks postId webLogId permalinks = backgroundTask {
-                    match! (
-                        rethink<Post> {
-                            withTable Table.Post
-                            get postId
-                            without [ nameof Post.empty.Revisions; nameof Post.empty.PriorPermalinks ]
-                            resultOption; withRetryOptionDefault
                 }
-                        |> verifyWebLog webLogId (fun p -> p.WebLogId)) conn with
+
+                member this.UpdatePriorPermalinks postId webLogId permalinks = backgroundTask {
+                    match! this.FindById postId webLogId with
                     | Some _ ->
                         do! rethink {
                             withTable Table.Post
                             get postId
-                            update [ nameof Post.empty.PriorPermalinks, permalinks :> obj ]
+                            update [ nameof Post.Empty.PriorPermalinks, permalinks :> obj ]
                             write; withRetryDefault; ignoreResult conn
                         }
                         return true
@@ -650,7 +771,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! result = rethink<Model.Result> {
                         withTable Table.TagMap
                         getAll [ tagMapId ]
-                        filter (fun row -> row[nameof TagMap.empty.WebLogId].Eq webLogId :> obj)
+                        filter (fun row -> row[nameof TagMap.Empty.WebLogId].Eq webLogId :> obj)
                         delete
                         write; withRetryDefault conn
                     }
@@ -663,7 +784,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         get tagMapId
                         resultOption; withRetryOptionDefault
                     }
-                    |> verifyWebLog webLogId (fun tm -> tm.WebLogId) <| conn
+                    |> verifyWebLog webLogId _.WebLogId <| conn
                 
                 member _.FindByUrlValue urlValue webLogId =
                     rethink<TagMap list> {
@@ -678,7 +799,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     withTable Table.TagMap
                     between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
                             [ Index Index.WebLogAndTag ]
-                    orderBy (nameof TagMap.empty.Tag)
+                    orderBy (nameof TagMap.Empty.Tag)
                     result; withRetryDefault conn
                 }
                 
@@ -710,25 +831,49 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.All () = rethink<Theme list> {
                     withTable Table.Theme
-                    filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj)
+                    filter (fun row -> row[nameof Theme.Empty.Id].Ne "admin" :> obj)
-                    without [ nameof Theme.empty.Templates ]
+                    merge withoutTemplateText
-                    orderBy (nameof Theme.empty.Id)
+                    orderBy (nameof Theme.Empty.Id)
                     result; withRetryDefault conn
                 }
                 
+                member _.Exists themeId = backgroundTask {
+                    let! count = rethink<int> {
+                        withTable Table.Theme
+                        filter (nameof Theme.Empty.Id) themeId
+                        count
+                        result; withRetryDefault conn
+                    }
+                    return count > 0
+                }
+                
                 member _.FindById themeId = rethink<Theme> {
                     withTable Table.Theme
                     get themeId
                     resultOption; withRetryOptionDefault conn
                 }
                 
-                member _.FindByIdWithoutText themeId = rethink<Theme> {
+                member _.FindByIdWithoutText themeId =
+                    rethink<Theme list> {
+                        withTable Table.Theme
+                        getAll [ themeId ]
+                        merge withoutTemplateText
+                        result; withRetryDefault
+                    }
+                    |> tryFirst <| conn
+                
+                member this.Delete themeId = backgroundTask {
+                    match! this.FindByIdWithoutText themeId with
+                    | Some _ ->
+                        do! deleteAssetsByTheme themeId
+                        do! rethink {
                             withTable Table.Theme
                             get themeId
-                    merge (fun row ->
+                            delete
-                        {|  Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |]
+                            write; withRetryDefault; ignoreResult conn
-                        |})
+                        }
-                    resultOption; withRetryOptionDefault conn
+                        return true
+                    | None -> return false
                 }
                 
                 member _.Save theme = rethink {
@@ -744,16 +889,11 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.All () = rethink<ThemeAsset list> {
                     withTable Table.ThemeAsset
-                    without [ nameof ThemeAsset.empty.Data ]
+                    merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
                     result; withRetryDefault conn
                 }
                 
-                member _.DeleteByTheme themeId = rethink {
+                member _.DeleteByTheme themeId = deleteAssetsByTheme themeId
-                    withTable Table.ThemeAsset
-                    filter (matchAssetByThemeId themeId)
-                    delete
-                    write; withRetryDefault; ignoreResult conn
-                }
                 
                 member _.FindById assetId = rethink<ThemeAsset> {
                     withTable Table.ThemeAsset
@@ -764,7 +904,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 member _.FindByTheme themeId = rethink<ThemeAsset list> {
                     withTable Table.ThemeAsset
                     filter (matchAssetByThemeId themeId)
-                    without [ nameof ThemeAsset.empty.Data ]
+                    merge (r.HashMap(nameof ThemeAsset.Empty.Data, emptyFile))
                     result; withRetryDefault conn
                 }
                 
@@ -798,7 +938,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                             get uploadId
                             resultOption; withRetryOptionDefault
                         }
-                        |> verifyWebLog<Upload> webLogId (fun u -> u.WebLogId) <| conn
+                        |> verifyWebLog<Upload> webLogId _.WebLogId <| conn
                     match upload with
                     | Some up ->
                         do! rethink {
@@ -807,8 +947,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                             delete
                             write; withRetryDefault; ignoreResult conn
                         }
-                        return Ok (Permalink.toString up.Path)
+                        return Ok (string up.Path)
-                    | None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
+                    | None -> return Result.Error $"Upload ID {uploadId} not found"
                 }
                 
                 member _.FindByPath path webLogId =
@@ -823,7 +963,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     withTable Table.Upload
                     between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
                             [ Index Index.WebLogAndPath ]
-                    without [ nameof Upload.empty.Data ]
+                    merge (r.HashMap(nameof Upload.Empty.Data, emptyFile))
                     resultCursor; withRetryCursorDefault; toList conn
                 }
                 
@@ -838,7 +978,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     // Files can be large; we'll do 5 at a time
                     for batch in uploads |> List.chunkBySize 5 do
                         do! rethink {
-                            withTable Table.TagMap
+                            withTable Table.Upload
                             insert batch
                             write; withRetryOnce; ignoreResult conn
                         }
@@ -863,15 +1003,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                      // Comments should be deleted by post IDs
                      let! thePostIds = rethink<{| Id: string |} list> {
                          withTable Table.Post
-                         getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                         getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                         pluck [ nameof Post.empty.Id ]
+                         pluck [ nameof Post.Empty.Id ]
                          result; withRetryOnce conn
                      }
                      if not (List.isEmpty thePostIds) then
                          let postIds = thePostIds |> List.map (fun it -> it.Id :> obj)
                          do! rethink {
                              withTable Table.Comment
-                             getAll postIds (nameof Comment.empty.PostId)
+                             getAll postIds (nameof Comment.Empty.PostId)
                              delete
                              write; withRetryOnce; ignoreResult conn
                          }
@@ -894,7 +1034,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                      for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
                          do! rethink {
                              withTable table
-                             getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                             getAll [ webLogId ] (nameof Post.Empty.WebLogId)
                              delete
                              write; withRetryOnce; ignoreResult conn
                          }
@@ -909,7 +1049,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 member _.FindByHost url =
                     rethink<WebLog list> {
                         withTable Table.WebLog
-                        getAll [ url ] (nameof WebLog.empty.UrlBase)
+                        getAll [ url ] (nameof WebLog.Empty.UrlBase)
                         limit 1
                         result; withRetryDefault
                     }
@@ -921,10 +1061,17 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     resultOption; withRetryOptionDefault conn
                 }
                 
+                member _.UpdateRedirectRules webLog = rethink {
+                    withTable Table.WebLog
+                    get webLog.Id
+                    update [ nameof WebLog.Empty.RedirectRules, webLog.RedirectRules :> obj ]
+                    write; withRetryDefault; ignoreResult conn
+                }
+                
                 member _.UpdateRssOptions webLog = rethink {
                     withTable Table.WebLog
                     get webLog.Id
-                    update [ nameof WebLog.empty.Rss, webLog.Rss :> obj ]
+                    update [ nameof WebLog.Empty.Rss, webLog.Rss :> obj ]
                     write; withRetryDefault; ignoreResult conn
                 }
                 
@@ -961,22 +1108,22 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         get userId
                         resultOption; withRetryOptionDefault
                     }
-                    |> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn
+                    |> verifyWebLog webLogId _.WebLogId <| conn
                 
                 member this.Delete userId webLogId = backgroundTask {
                     match! this.FindById userId webLogId with
                     | Some _ ->
                         let! pageCount = rethink<int> {
                             withTable Table.Page
-                            getAll [ webLogId ] (nameof Page.empty.WebLogId)
+                            getAll [ webLogId ] (nameof Page.Empty.WebLogId)
-                            filter (nameof Page.empty.AuthorId) userId
+                            filter (nameof Page.Empty.AuthorId) userId
                             count
                             result; withRetryDefault conn
                         }
                         let! postCount = rethink<int> {
                             withTable Table.Post
-                            getAll [ webLogId ] (nameof Post.empty.WebLogId)
+                            getAll [ webLogId ] (nameof Post.Empty.WebLogId)
-                            filter (nameof Post.empty.AuthorId) userId
+                            filter (nameof Post.Empty.AuthorId) userId
                             count
                             result; withRetryDefault conn
                         }
@@ -1004,8 +1151,8 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.FindByWebLog webLogId = rethink<WebLogUser list> {
                     withTable Table.WebLogUser
-                    getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
+                    getAll [ webLogId ] (nameof WebLogUser.Empty.WebLogId)
-                    orderByFunc (fun row -> row[nameof WebLogUser.empty.PreferredName].Downcase ())
+                    orderByFunc (fun row -> row[nameof WebLogUser.Empty.PreferredName].Downcase())
                     result; withRetryDefault conn
                 }
                 
@@ -1013,12 +1160,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     let! users = rethink<WebLogUser list> {
                         withTable Table.WebLogUser
                         getAll (objList userIds)
-                        filter (nameof WebLogUser.empty.WebLogId) webLogId
+                        filter (nameof WebLogUser.Empty.WebLogId) webLogId
                         result; withRetryDefault conn
                     }
-                    return
+                    return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
-                        users
-                        |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
                 }
                 
                 member _.Restore users = backgroundTask {
@@ -1036,7 +1181,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         do! rethink {
                             withTable Table.WebLogUser
                             get userId
-                            update [ nameof WebLogUser.empty.LastSeenOn, DateTime.UtcNow :> obj ]
+                            update [ nameof WebLogUser.Empty.LastSeenOn, Noda.now () :> obj ]
                             write; withRetryOnce; ignoreResult conn
                         }
                     | None -> ()
@@ -1051,7 +1196,6 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         nameof user.LastName,      user.LastName
                         nameof user.PreferredName, user.PreferredName
                         nameof user.PasswordHash,  user.PasswordHash
-                        nameof user.Salt,          user.Salt
                         nameof user.Url,           user.Url
                         nameof user.AccessLevel,   user.AccessLevel
                         ]
@@ -1059,6 +1203,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 }
         }
         
+        member _.Serializer =
+            Net.Converter.Serializer
+        
         member _.StartUp () = backgroundTask {
             let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
             if not (dbs |> List.contains config.Database) then
@@ -1071,12 +1218,27 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     log.LogInformation $"Creating table {tbl}..."
                     do! rethink { tableCreate tbl [ PrimaryKey "Id" ]; write; withRetryOnce; ignoreResult conn }
 
-            do! ensureIndexes Table.Category   [ nameof Category.empty.WebLogId ]
+            if not (List.contains Table.DbVersion tables) then
-            do! ensureIndexes Table.Comment    [ nameof Comment.empty.PostId ]
+                // Version table added in v2-rc2; this will flag that migration to be run
-            do! ensureIndexes Table.Page       [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
+                do! rethink {
-            do! ensureIndexes Table.Post       [ nameof Post.empty.WebLogId; nameof Post.empty.AuthorId ]
+                    withTable Table.DbVersion
+                    insert {| Id = "v2-rc1" |}
+                    write; withRetryOnce; ignoreResult conn
+                }
+            
+            do! ensureIndexes Table.Category   [ nameof Category.Empty.WebLogId ]
+            do! ensureIndexes Table.Comment    [ nameof Comment.Empty.PostId ]
+            do! ensureIndexes Table.Page       [ nameof Page.Empty.WebLogId; nameof Page.Empty.AuthorId ]
+            do! ensureIndexes Table.Post       [ nameof Post.Empty.WebLogId; nameof Post.Empty.AuthorId ]
             do! ensureIndexes Table.TagMap     []
             do! ensureIndexes Table.Upload     []
-            do! ensureIndexes Table.WebLog     [ nameof WebLog.empty.UrlBase ]
+            do! ensureIndexes Table.WebLog     [ nameof WebLog.Empty.UrlBase ]
-            do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.empty.WebLogId ]
+            do! ensureIndexes Table.WebLogUser [ nameof WebLogUser.Empty.WebLogId ]
+            
+            let! version = rethink<{| Id: string |} list> {
+                 withTable Table.DbVersion
+                 limit 1
+                 result; withRetryOnce conn
+            }
+            do! migrate (List.tryHead version |> Option.map _.Id)
         }

src/MyWebLog.Data/SQLite/Helpers.fs

@@ -1,312 +0,0 @@
-/// Helper functions for the SQLite data implementation
-[<AutoOpen>]
-module MyWebLog.Data.SQLite.Helpers
-
-open System
-open Microsoft.Data.Sqlite
-open MyWebLog
-
-/// Run a command that returns a count
-let count (cmd : SqliteCommand) = backgroundTask {
-    let! it = cmd.ExecuteScalarAsync ()
-    return int (it :?> int64)
-}
-
-/// Get lists of items removed from and added to the given lists
-let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
-    let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
-    List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
-
-/// Find meta items added and removed
-let diffMetaItems (oldItems : MetaItem list) newItems =
-    diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
-
-/// Find the permalinks added and removed
-let diffPermalinks oldLinks newLinks =
-    diffLists oldLinks newLinks Permalink.toString
-
-/// Find the revisions added and removed
-let diffRevisions oldRevs newRevs =
-    diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}")
-
-/// Create a list of items from the given data reader
-let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
-    seq { while rdr.Read () do it rdr }
-    |> List.ofSeq
-
-/// Verify that the web log ID matches before returning an item
-let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
-    if rdr.Read () then
-        let item = it rdr
-        if prop item = webLogId then Some item else None
-    else None
-
-/// Execute a command that returns no data
-let write (cmd : SqliteCommand) = backgroundTask {
-    let! _ = cmd.ExecuteNonQueryAsync ()
-    ()
-}
-
-/// Functions to map domain items from a data reader
-module Map =
-    
-    open System.IO
-    
-    /// Get a boolean value from a data reader
-    let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
-    
-    /// Get a date/time value from a data reader
-    let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
-    
-    /// Get a Guid value from a data reader
-    let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
-    
-    /// Get an int value from a data reader
-    let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
-    
-    /// Get a long (64-bit int) value from a data reader
-    let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col)
-    
-    /// Get a BLOB stream value from a data reader
-    let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
-    
-    /// Get a string value from a data reader
-    let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
-    
-    /// Get a timespan value from a data reader
-    let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
-    
-    /// Get a possibly null boolean value from a data reader
-    let tryBoolean col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
-    
-    /// Get a possibly null date/time value from a data reader
-    let tryDateTime col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
-    
-    /// Get a possibly null Guid value from a data reader
-    let tryGuid col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr)
-    
-    /// Get a possibly null int value from a data reader
-    let tryInt col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
-    
-    /// Get a possibly null string value from a data reader
-    let tryString col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
-    
-    /// Get a possibly null timespan value from a data reader
-    let tryTimeSpan col (rdr : SqliteDataReader) =
-        if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
-    
-    /// Map an id field to a category ID
-    let toCategoryId rdr = getString "id" rdr |> CategoryId
-    
-    /// Create a category from the current row in the given data reader
-    let toCategory rdr : Category =
-        {   Id          = toCategoryId            rdr
-            WebLogId    = getString "web_log_id"  rdr |> WebLogId
-            Name        = getString "name"        rdr
-            Slug        = getString "slug"        rdr
-            Description = tryString "description" rdr
-            ParentId    = tryString "parent_id"   rdr |> Option.map CategoryId
-        }
-    
-    /// Create a custom feed from the current row in the given data reader
-    let toCustomFeed rdr : CustomFeed =
-        {   Id      = getString "id"     rdr |> CustomFeedId
-            Source  = getString "source" rdr |> CustomFeedSource.parse
-            Path    = getString "path"   rdr |> Permalink
-            Podcast =
-                if rdr.IsDBNull (rdr.GetOrdinal "title") then
-                    None
-                else
-                    Some {
-                        Title             = getString "title"              rdr
-                        Subtitle          = tryString "subtitle"           rdr
-                        ItemsInFeed       = getInt    "items_in_feed"      rdr
-                        Summary           = getString "summary"            rdr
-                        DisplayedAuthor   = getString "displayed_author"   rdr
-                        Email             = getString "email"              rdr
-                        ImageUrl          = getString "image_url"          rdr |> Permalink
-                        AppleCategory     = getString "apple_category"     rdr
-                        AppleSubcategory  = tryString "apple_subcategory"  rdr
-                        Explicit          = getString "explicit"           rdr |> ExplicitRating.parse
-                        DefaultMediaType  = tryString "default_media_type" rdr
-                        MediaBaseUrl      = tryString "media_base_url"     rdr
-                        PodcastGuid       = tryGuid   "podcast_guid"       rdr
-                        FundingUrl        = tryString "funding_url"        rdr
-                        FundingText       = tryString "funding_text"       rdr
-                        Medium            = tryString "medium"             rdr |> Option.map PodcastMedium.parse
-                    }
-        }
-    
-    /// Create a meta item from the current row in the given data reader
-    let toMetaItem rdr : MetaItem =
-        {   Name  = getString "name"  rdr
-            Value = getString "value" rdr
-        }
-    
-    /// Create a permalink from the current row in the given data reader
-    let toPermalink rdr = getString "permalink" rdr |> Permalink
-    
-    /// Create a page from the current row in the given data reader
-    let toPage rdr : Page =
-        { Page.empty with
-            Id           = getString   "id"              rdr |> PageId
-            WebLogId     = getString   "web_log_id"      rdr |> WebLogId
-            AuthorId     = getString   "author_id"       rdr |> WebLogUserId
-            Title        = getString   "title"           rdr
-            Permalink    = toPermalink                   rdr
-            PublishedOn  = getDateTime "published_on"    rdr
-            UpdatedOn    = getDateTime "updated_on"      rdr
-            IsInPageList = getBoolean  "is_in_page_list" rdr
-            Template     = tryString   "template"        rdr
-            Text         = getString   "page_text"       rdr
-        }
-    
-    /// Create a post from the current row in the given data reader
-    let toPost rdr : Post =
-        { Post.empty with
-            Id             = getString   "id"           rdr |> PostId
-            WebLogId       = getString   "web_log_id"   rdr |> WebLogId
-            AuthorId       = getString   "author_id"    rdr |> WebLogUserId
-            Status         = getString   "status"       rdr |> PostStatus.parse
-            Title          = getString   "title"        rdr
-            Permalink      = toPermalink                rdr
-            PublishedOn    = tryDateTime "published_on" rdr
-            UpdatedOn      = getDateTime "updated_on"   rdr
-            Template       = tryString   "template"     rdr
-            Text           = getString   "post_text"    rdr
-            Episode        =
-                match tryString "media" rdr with
-                | Some media ->
-                    Some {
-                        Media              = media
-                        Length             = getLong     "length"              rdr
-                        Duration           = tryTimeSpan "duration"            rdr
-                        MediaType          = tryString   "media_type"          rdr
-                        ImageUrl           = tryString   "image_url"           rdr
-                        Subtitle           = tryString   "subtitle"            rdr
-                        Explicit           = tryString   "explicit"            rdr |> Option.map ExplicitRating.parse
-                        ChapterFile        = tryString   "chapter_file"        rdr
-                        ChapterType        = tryString   "chapter_type"        rdr
-                        TranscriptUrl      = tryString   "transcript_url"      rdr
-                        TranscriptType     = tryString   "transcript_type"     rdr
-                        TranscriptLang     = tryString   "transcript_lang"     rdr
-                        TranscriptCaptions = tryBoolean  "transcript_captions" rdr
-                        SeasonNumber       = tryInt      "season_number"       rdr
-                        SeasonDescription  = tryString   "season_description"  rdr
-                        EpisodeNumber      = tryString   "episode_number"      rdr |> Option.map Double.Parse
-                        EpisodeDescription = tryString   "episode_description" rdr
-                    }
-                | None -> None
-        }
-    
-    /// Create a revision from the current row in the given data reader
-    let toRevision rdr : Revision =
-        {   AsOf = getDateTime "as_of"         rdr
-            Text = getString   "revision_text" rdr |> MarkupText.parse
-        }
-    
-    /// Create a tag mapping from the current row in the given data reader
-    let toTagMap rdr : TagMap =
-        {   Id       = getString "id"         rdr |> TagMapId
-            WebLogId = getString "web_log_id" rdr |> WebLogId
-            Tag      = getString "tag"        rdr
-            UrlValue = getString "url_value"  rdr
-        }
-    
-    /// Create a theme from the current row in the given data reader (excludes templates)
-    let toTheme rdr : Theme =
-        { Theme.empty with
-            Id      = getString "id"      rdr |> ThemeId
-            Name    = getString "name"    rdr
-            Version = getString "version" rdr
-        }
-    
-    /// Create a theme asset from the current row in the given data reader
-    let toThemeAsset includeData rdr : ThemeAsset =
-        let assetData =
-            if includeData then
-                use dataStream = new MemoryStream ()
-                use blobStream = getStream "data" rdr
-                blobStream.CopyTo dataStream
-                dataStream.ToArray ()
-            else
-                [||]
-        {   Id        = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
-            UpdatedOn = getDateTime "updated_on" rdr
-            Data      = assetData
-        }
-    
-    /// Create a theme template from the current row in the given data reader
-    let toThemeTemplate rdr : ThemeTemplate =
-        {   Name = getString "name"     rdr
-            Text = getString "template" rdr
-        }
-    
-    /// Create an uploaded file from the current row in the given data reader
-    let toUpload includeData rdr : Upload =
-        let data =
-            if includeData then
-                use dataStream = new MemoryStream ()
-                use blobStream = getStream "data" rdr
-                blobStream.CopyTo dataStream
-                dataStream.ToArray ()
-            else
-                [||]
-        {   Id        = getString   "id"           rdr |> UploadId
-            WebLogId  = getString   "web_log_id"   rdr |> WebLogId
-            Path      = getString   "path"         rdr |> Permalink
-            UpdatedOn = getDateTime "updated_on" rdr
-            Data      = data
-        }
-    
-    /// Create a web log from the current row in the given data reader
-    let toWebLog rdr : WebLog =
-        {   Id           = getString  "id"             rdr |> WebLogId
-            Name         = getString  "name"           rdr
-            Slug         = getString  "slug"           rdr
-            Subtitle     = tryString  "subtitle"       rdr
-            DefaultPage  = getString  "default_page"   rdr
-            PostsPerPage = getInt     "posts_per_page" rdr
-            ThemeId      = getString  "theme_id"       rdr |> ThemeId
-            UrlBase      = getString  "url_base"       rdr
-            TimeZone     = getString  "time_zone"      rdr
-            AutoHtmx     = getBoolean "auto_htmx"      rdr
-            Uploads      = getString  "uploads"        rdr |> UploadDestination.parse
-            Rss          = {
-                IsFeedEnabled     = getBoolean "is_feed_enabled"     rdr
-                FeedName          = getString  "feed_name"           rdr
-                ItemsInFeed       = tryInt     "items_in_feed"       rdr
-                IsCategoryEnabled = getBoolean "is_category_enabled" rdr
-                IsTagEnabled      = getBoolean "is_tag_enabled"      rdr
-                Copyright         = tryString  "copyright"           rdr
-                CustomFeeds       = []
-            }
-        }
-    
-    /// Create a web log user from the current row in the given data reader
-    let toWebLogUser rdr : WebLogUser =
-        {   Id            = getString   "id"             rdr |> WebLogUserId
-            WebLogId      = getString   "web_log_id"     rdr |> WebLogId
-            Email         = getString   "email"          rdr
-            FirstName     = getString   "first_name"     rdr
-            LastName      = getString   "last_name"      rdr
-            PreferredName = getString   "preferred_name" rdr
-            PasswordHash  = getString   "password_hash"  rdr
-            Salt          = getGuid     "salt"           rdr
-            Url           = tryString   "url"            rdr
-            AccessLevel   = getString   "access_level"   rdr |> AccessLevel.parse
-            CreatedOn     = getDateTime "created_on"     rdr
-            LastSeenOn    = tryDateTime "last_seen_on"   rdr
-        }
-
-/// Add a possibly-missing parameter, substituting null for None
-let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
-
-/// Add a web log ID parameter
-let addWebLogId (cmd : SqliteCommand) webLogId =
-    cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore

src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs

@@ -1,169 +1,124 @@
 namespace MyWebLog.Data.SQLite
 
 open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
+open Newtonsoft.Json
 
 /// SQLite myWebLog category data implementation
-type SQLiteCategoryData (conn : SqliteConnection) =
+type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
     
-    /// Add parameters for category INSERT or UPDATE statements
+    /// The name of the parent ID field
-    let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
+    let parentIdField = nameof Category.Empty.ParentId
-        [   cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
-            cmd.Parameters.AddWithValue ("@name", cat.Name)
-            cmd.Parameters.AddWithValue ("@slug", cat.Slug)
-            cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
-            cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
-        ] |> ignore
-    
-    /// Add a category
-    let add cat = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- """
-            INSERT INTO category (
-                id, web_log_id, name, slug, description, parent_id
-            ) VALUES (
-                @id, @webLogId, @name, @slug, @description, @parentId
-            )"""
-        addCategoryParameters cmd cat
-        let! _ = cmd.ExecuteNonQueryAsync ()
-        ()
-    }
     
     /// Count all categories for the given web log
-    let countAll webLogId = backgroundTask {
+    let countAll webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Category.countAll"
-        cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId"
+        Document.countByWebLog Table.Category webLogId conn
-        addWebLogId cmd webLogId
-        return! count cmd
-    }
     
     /// Count all top-level categories for the given web log
-    let countTopLevel webLogId = backgroundTask {
+    let countTopLevel webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Category.countTopLevel"
-        cmd.CommandText <-
+        conn.customScalar
-            "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
+            $"{Document.Query.countByWebLog Table.Category} AND data ->> '{parentIdField}' IS NULL"
-        addWebLogId cmd webLogId
+            [ webLogParam webLogId ]
-        return! count cmd
+            (toCount >> int)
-    }
+    
+    /// Find all categories for the given web log
+    let findByWebLog webLogId =
+        log.LogTrace "Category.findByWebLog"
+        Document.findByWebLog<Category> Table.Category webLogId conn
     
     /// Retrieve all categories for the given web log in a DotLiquid-friendly format
     let findAllForView webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Category.findAllForView"
-        cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
+        let! cats    = findByWebLog webLogId
-        addWebLogId cmd webLogId
+        let  ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let cats =
-            seq {
-                while rdr.Read () do
-                    Map.toCategory rdr
-            }
-            |> Seq.sortBy (fun cat -> cat.Name.ToLowerInvariant ())
-            |> List.ofSeq
-        do! rdr.CloseAsync ()
-        let  ordered = Utils.orderByHierarchy cats None None []
         let! counts  =
             ordered
             |> Seq.map (fun it -> backgroundTask {
                 // Parent category post counts include posts in subcategories
-                cmd.Parameters.Clear ()
+                let catSql, catParams =
-                addWebLogId cmd webLogId
-                cmd.CommandText <- """
-                    SELECT COUNT(DISTINCT p.id)
-                      FROM post p
-                           INNER JOIN post_category pc ON pc.post_id = p.id
-                     WHERE p.web_log_id = @webLogId
-                       AND p.status     = 'Published'
-                       AND pc.category_id IN ("""
                     ordered
                     |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
-                |> Seq.map (fun cat -> cat.Id)
+                    |> Seq.map _.Id
                     |> Seq.append (Seq.singleton it.Id)
-                |> Seq.iteri (fun idx item ->
+                    |> List.ofSeq
-                    if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
+                    |> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
-                    cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
+                let query = $"""
-                    cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore)
+                    SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}')
-                cmd.CommandText <- $"{cmd.CommandText})"
+                      FROM {Table.Post}
-                let! postCount = count cmd
+                     WHERE {Document.Query.whereByWebLog}
-                return it.Id, postCount
+                       AND {Query.whereByField (Field.EQ (nameof Post.Empty.Status) "") $"'{string Published}'"}
+                       AND {catSql}"""
+                let! postCount = conn.customScalar query (webLogParam webLogId :: catParams) toCount
+                return it.Id, int postCount
             })
             |> Task.WhenAll
         return
             ordered
             |> Seq.map (fun cat ->
                 { cat with
-                    PostCount = counts
+                    PostCount = defaultArg (counts |> Array.tryFind (fun c -> fst c = cat.Id) |> Option.map snd) 0
-                                |> Array.tryFind (fun c -> fst c = cat.Id)
-                                |> Option.map snd
-                                |> Option.defaultValue 0
                 })
             |> Array.ofSeq
     }
-    /// Find a category by its ID for the given web log
-    let findById catId webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
-        cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return Helpers.verifyWebLog<Category> webLogId (fun c -> c.WebLogId) Map.toCategory rdr
-    }
     
-    /// Find all categories for the given web log
+    /// Find a category by its ID for the given web log
-    let findByWebLog webLogId = backgroundTask {
+    let findById catId webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Category.findById"
-        cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
+        Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId conn
-        cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList Map.toCategory rdr
-    }
     
     /// Delete a category
     let delete catId webLogId = backgroundTask {
+        log.LogTrace "Category.delete"
         match! findById catId webLogId with
-        | Some _ ->
+        | Some cat ->
-            use cmd = conn.CreateCommand ()
+            // Reassign any children to the category's parent category
-            // Delete the category off all posts where it is assigned
+            let! children = conn.countByField Table.Category (Field.EQ parentIdField (string catId))
-            cmd.CommandText <- """
+            if children > 0L then
-                DELETE FROM post_category
+                let parent = Field.EQ parentIdField (string catId)
-                 WHERE category_id = @id
+                match cat.ParentId with
-                   AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
+                | Some _ -> do! conn.patchByField Table.Category parent {| ParentId = cat.ParentId |}
-            let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
+                | None -> do! conn.removeFieldsByField Table.Category parent [ parentIdField ]
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
+            // Delete the category off all posts where it is assigned, and the category itself
-            do! write cmd
+            let catIdField = nameof Post.Empty.CategoryIds
-            // Delete the category itself
+            let! posts =
-            cmd.CommandText <- "DELETE FROM category WHERE id = @id"
+                conn.customList
-            cmd.Parameters.Clear ()
+                    $"SELECT data ->> '{nameof Post.Empty.Id}', data -> '{catIdField}'
-            cmd.Parameters.Add catIdParameter |> ignore
+                        FROM {Table.Post}
-            do! write cmd
+                       WHERE {Document.Query.whereByWebLog}
-            return true
+                         AND EXISTS
-        | None -> return false
+                               (SELECT 1
+                                  FROM json_each({Table.Post}.data -> '{catIdField}')
+                                 WHERE json_each.value = @id)"
+                    [ idParam catId; webLogParam webLogId ]
+                    (fun rdr -> rdr.GetString 0, Utils.deserialize<string list> ser (rdr.GetString 1))
+            for postId, cats in posts do
+                do! conn.patchById
+                        Table.Post postId {| CategoryIds = cats |> List.filter (fun it -> it <> string catId) |}
+            do! conn.deleteById Table.Category catId
+            return if children = 0L then CategoryDeleted else ReassignedChildCategories
+        | None -> return CategoryNotFound
     }
     
+    /// Save a category
+    let save cat =
+        log.LogTrace "Category.save"
+        conn.save<Category> Table.Category cat
+    
     /// Restore categories from a backup
     let restore cats = backgroundTask {
-        for cat in cats do
+        log.LogTrace "Category.restore"
-            do! add cat
+        for cat in cats do do! save cat
-    }
-    
-    /// Update a category
-    let update cat = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- """
-            UPDATE category
-               SET name        = @name,
-                   slug        = @slug,
-                   description = @description,
-                   parent_id   = @parentId
-             WHERE id         = @id
-               AND web_log_id = @webLogId"""
-        addCategoryParameters cmd cat
-        do! write cmd
     }
     
     interface ICategoryData with
-        member _.Add cat = add cat
+        member _.Add cat = save cat
         member _.CountAll webLogId = countAll webLogId
         member _.CountTopLevel webLogId = countTopLevel webLogId
         member _.FindAllForView webLogId = findAllForView webLogId
@@ -171,4 +126,4 @@ type SQLiteCategoryData (conn : SqliteConnection) =
         member _.FindByWebLog webLogId = findByWebLog webLogId
         member _.Delete catId webLogId = delete catId webLogId
         member _.Restore cats = restore cats
-        member _.Update cat = update cat
+        member _.Update cat = save cat

src/MyWebLog.Data/SQLite/SQLiteHelpers.fs

@@ -0,0 +1,307 @@
+/// Helper functions for the SQLite data implementation
+[<AutoOpen>]
+module MyWebLog.Data.SQLite.SQLiteHelpers
+
+/// The table names used in the SQLite implementation
+[<RequireQualifiedAccess>]
+module Table =
+    
+    /// Categories
+    [<Literal>]
+    let Category = "category"
+    
+    /// Database Version
+    [<Literal>]
+    let DbVersion = "db_version"
+    
+    /// Pages
+    [<Literal>]
+    let Page = "page"
+    
+    /// Page Revisions
+    [<Literal>]
+    let PageRevision = "page_revision"
+    
+    /// Posts
+    [<Literal>]
+    let Post = "post"
+    
+    /// Post Comments
+    [<Literal>]
+    let PostComment = "post_comment"
+    
+    /// Post Revisions
+    [<Literal>]
+    let PostRevision = "post_revision"
+    
+    /// Tag/URL Mappings
+    [<Literal>]
+    let TagMap = "tag_map"
+    
+    /// Themes
+    [<Literal>]
+    let Theme = "theme"
+    
+    /// Theme Assets
+    [<Literal>]
+    let ThemeAsset = "theme_asset"
+    
+    /// Uploads
+    [<Literal>]
+    let Upload = "upload"
+    
+    /// Web Logs
+    [<Literal>]
+    let WebLog = "web_log"
+    
+    /// Users
+    [<Literal>]
+    let WebLogUser = "web_log_user"
+
+
+open System
+open Microsoft.Data.Sqlite
+open MyWebLog
+open MyWebLog.Data
+open NodaTime.Text
+
+/// Execute a command that returns no data
+let write (cmd: SqliteCommand) = backgroundTask {
+    let! _ = cmd.ExecuteNonQueryAsync()
+    ()
+}
+
+/// Add a possibly-missing parameter, substituting null for None
+let maybe<'T> (it: 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
+
+/// Create a value for an Instant
+let instantParam =
+    InstantPattern.General.Format
+
+/// Create an optional value for an Instant
+let maybeInstant =
+    Option.map instantParam >> maybe
+
+/// Create the SQL and parameters for an EXISTS applied to a JSON array
+let inJsonArray<'T> table jsonField paramName (items: 'T list) =
+    if List.isEmpty items then "", []
+    else
+        let mutable idx = 0
+        items
+        |> List.skip 1
+        |> List.fold (fun (itemS, itemP) it ->
+            idx <- idx + 1
+            $"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
+            (Seq.ofList items
+             |> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
+             |> Seq.head)
+        |> function
+            sql, ps ->
+                $"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
+
+/// Create the SQL and parameters for an IN clause
+let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
+    if List.isEmpty items then "", []
+    else
+        let mutable idx = 0
+        items
+        |> List.skip 1
+        |> List.fold (fun (itemS, itemP) it ->
+            idx <- idx + 1
+            $"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
+            (Seq.ofList items
+             |> Seq.map (fun it ->
+                 $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
+             |> Seq.head)
+        |> function sql, ps -> $"{sql})", ps
+
+
+/// Functions to map domain items from a data reader
+module Map =
+    
+    open System.IO
+    
+    /// Get a boolean value from a data reader
+    let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col)
+    
+    /// Get a date/time value from a data reader
+    let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col)
+    
+    /// Get a Guid value from a data reader
+    let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col)
+    
+    /// Get an int value from a data reader
+    let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col)
+    
+    /// Get a long (64-bit int) value from a data reader
+    let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col)
+    
+    /// Get a BLOB stream value from a data reader
+    let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col)
+    
+    /// Get a string value from a data reader
+    let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col)
+    
+    /// Parse an Instant from the given value
+    let parseInstant value =
+        match InstantPattern.General.Parse value with
+        | it when it.Success -> it.Value
+        | it -> raise it.Exception
+    
+    /// Get an Instant value from a data reader
+    let getInstant col rdr =
+        getString col rdr |> parseInstant
+    
+    /// Get a timespan value from a data reader
+    let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col)
+    
+    /// Get a possibly null boolean value from a data reader
+    let tryBoolean col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
+    
+    /// Get a possibly null date/time value from a data reader
+    let tryDateTime col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
+    
+    /// Get a possibly null Guid value from a data reader
+    let tryGuid col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr)
+    
+    /// Get a possibly null int value from a data reader
+    let tryInt col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr)
+    
+    /// Get a possibly null string value from a data reader
+    let tryString col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
+    
+    /// Get a possibly null timespan value from a data reader
+    let tryTimeSpan col (rdr: SqliteDataReader) =
+        if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
+    
+    /// Create a permalink from the current row in the given data reader
+    let toPermalink rdr = getString "permalink" rdr |> Permalink
+    
+    /// Create a revision from the current row in the given data reader
+    let toRevision rdr : Revision =
+        { AsOf = getInstant "as_of"         rdr
+          Text = getString  "revision_text" rdr |> MarkupText.Parse }
+    
+    /// Create a theme asset from the current row in the given data reader
+    let toThemeAsset includeData rdr : ThemeAsset =
+        let assetData =
+            if includeData then
+                use dataStream = new MemoryStream()
+                use blobStream = getStream "data" rdr
+                blobStream.CopyTo dataStream
+                dataStream.ToArray()
+            else
+                [||]
+        { Id        = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
+          UpdatedOn = getInstant "updated_on" rdr
+          Data      = assetData }
+    
+    /// Create an uploaded file from the current row in the given data reader
+    let toUpload includeData rdr : Upload =
+        let data =
+            if includeData then
+                use dataStream = new MemoryStream()
+                use blobStream = getStream "data" rdr
+                blobStream.CopyTo dataStream
+                dataStream.ToArray ()
+            else
+                [||]
+        { Id        = getString  "id"         rdr |> UploadId
+          WebLogId  = getString  "web_log_id" rdr |> WebLogId
+          Path      = getString  "path"       rdr |> Permalink
+          UpdatedOn = getInstant "updated_on" rdr
+          Data      = data }
+
+
+/// Create a named parameter
+let sqlParam name (value: obj) =
+    SqliteParameter(name, value)
+    
+/// Create a web log ID parameter
+let webLogParam (webLogId: WebLogId) =
+    sqlParam "@webLogId" (string webLogId)
+
+
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
+open BitBadger.Documents.Sqlite.WithConn
+
+/// Functions for manipulating documents
+module Document =
+    
+    /// Queries to assist with document manipulation
+    module Query =
+        
+        /// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
+        let whereByWebLog =
+            Query.whereByField (Field.EQ "WebLogId" "") "@webLogId"
+        
+        /// A SELECT query to count documents for a given web log ID
+        let countByWebLog table =
+            $"{Query.Count.all table} WHERE {whereByWebLog}"
+        
+        /// A query to select from a table by the document's ID and its web log ID
+        let selectByIdAndWebLog table =
+            $"{Query.Find.byId table} AND {whereByWebLog}"
+        
+        /// A query to select from a table by its web log ID
+        let selectByWebLog table =
+            $"{Query.selectFromTable table} WHERE {whereByWebLog}"
+    
+    /// Count documents for the given web log ID
+    let countByWebLog table (webLogId: WebLogId) conn = backgroundTask {
+        let! count = Count.byField table (Field.EQ "WebLogId" (string webLogId)) conn
+        return int count
+    }
+    
+    /// Find a document by its ID and web log ID
+    let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId conn =
+        Custom.single (Query.selectByIdAndWebLog table) [ idParam key; webLogParam webLogId ] fromData<'TDoc> conn
+    
+    /// Find documents for the given web log
+    let findByWebLog<'TDoc> table (webLogId: WebLogId) conn =
+        Find.byField<'TDoc> table (Field.EQ "WebLogId" (string webLogId)) conn
+
+
+/// Functions to support revisions
+module Revisions =
+    
+    /// Find all revisions for the given entity
+    let findByEntityId<'TKey> revTable entityTable (key: 'TKey) conn =
+        Custom.list
+            $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
+            [ idParam key ]
+            Map.toRevision
+            conn
+    
+    /// Find all revisions for all posts for the given web log
+    let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId conn =
+        Custom.list
+            $"SELECT pr.*
+                FROM %s{revTable} pr
+                     INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id
+               WHERE p.{Document.Query.whereByWebLog}
+               ORDER BY as_of DESC"
+            [ webLogParam webLogId ]
+            (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr)
+            conn
+
+    /// Update a page or post's revisions
+    let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask {
+        let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
+        for delRev in toDelete do
+            do! Custom.nonQuery
+                    $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
+                    [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ]
+                    conn
+        for addRev in toAdd do
+            do! Custom.nonQuery
+                    $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)"
+                    [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ]
+                    conn
+    }

src/MyWebLog.Data/SQLite/SQLitePageData.fs

@@ -1,349 +1,171 @@
 namespace MyWebLog.Data.SQLite
 
 open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
 /// SQLite myWebLog page data implementation
-type SQLitePageData (conn : SqliteConnection) =
+type SQLitePageData(conn: SqliteConnection, log: ILogger) =
+    
+    /// The JSON field name for the permalink
+    let linkName = nameof Page.Empty.Permalink
+    
+    /// The JSON field name for the "is in page list" flag
+    let pgListName = nameof Page.Empty.IsInPageList
+    
+    /// The JSON field for the title of the page
+    let titleField = $"data ->> '{nameof Page.Empty.Title}'"
     
     // SUPPORT FUNCTIONS
     
-    /// Add parameters for page INSERT or UPDATE statements
+    /// Append revisions to a page
-    let addPageParameters (cmd : SqliteCommand) (page : Page) =
+    let appendPageRevisions (page : Page) = backgroundTask {
-        [   cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
+        log.LogTrace "Page.appendPageRevisions"
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
+        let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id conn
-            cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
+        return { page with Revisions = revisions }
-            cmd.Parameters.AddWithValue ("@title", page.Title)
-            cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
-            cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
-            cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
-            cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
-            cmd.Parameters.AddWithValue ("@template", maybe page.Template)
-            cmd.Parameters.AddWithValue ("@text", page.Text)
-        ] |> ignore
-    
-    /// Append meta items to a page
-    let appendPageMeta (page : Page) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
-        cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return { page with Metadata = toList Map.toMetaItem rdr }
     }
     
-    /// Append revisions and permalinks to a page
+    /// Create a page with no prior permalinks
-    let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
+    let pageWithoutLinks rdr =
-        use cmd = conn.CreateCommand ()
+        { fromData<Page> rdr with PriorPermalinks = [] }
-        cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
-        
-        cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let page = { page with PriorPermalinks = toList Map.toPermalink rdr }
-        do! rdr.CloseAsync ()
-        
-        cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return { page with Revisions = toList Map.toRevision rdr }
-    }
-    
-    /// Return a page with no text (or meta items, prior permalinks, or revisions)
-    let pageWithoutTextOrMeta rdr =
-        { Map.toPage rdr with Text = "" }
-    
-    /// Update a page's metadata items
-    let updatePageMeta pageId oldItems newItems = backgroundTask {
-        let toDelete, toAdd = diffMetaItems oldItems newItems
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
-              cmd.Parameters.Add ("@name", SqliteType.Text)
-              cmd.Parameters.Add ("@value", SqliteType.Text)
-            ] |> ignore
-            let runCmd (item : MetaItem) = backgroundTask {
-                cmd.Parameters["@name" ].Value <- item.Name
-                cmd.Parameters["@value"].Value <- item.Value
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
-    
-    /// Update a page's prior permalinks
-    let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
-        let toDelete, toAdd = diffPermalinks oldLinks newLinks
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
-              cmd.Parameters.Add ("@link", SqliteType.Text)
-            ] |> ignore
-            let runCmd link = backgroundTask {
-                cmd.Parameters["@link"].Value <- Permalink.toString link
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
     
     /// Update a page's revisions
-    let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
+    let updatePageRevisions (pageId: PageId) oldRevs newRevs =
-        let toDelete, toAdd = diffRevisions oldRevs newRevs
+        log.LogTrace "Page.updatePageRevisions"
-        if List.isEmpty toDelete && List.isEmpty toAdd then
+        Revisions.update Table.PageRevision Table.Page pageId oldRevs newRevs conn
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            let runCmd withText rev = backgroundTask {
-                cmd.Parameters.Clear ()
-                [ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
-                  cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
-                ] |> ignore
-                if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" 
-            toDelete
-            |> List.map (runCmd false)
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
-            toAdd
-            |> List.map (runCmd true)
-            |> Task.WhenAll
-            |> ignore
-    }
     
     // IMPLEMENTATION FUNCTIONS
     
     /// Add a page
-    let add page = backgroundTask {
+    let add (page: Page) = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.add"
-        // The page itself
+        do! conn.insert Table.Page { page with Revisions = [] } 
-        cmd.CommandText <- """
-            INSERT INTO page (
-                id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
-                page_text
-            ) VALUES (
-                @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
-                @text
-            )"""
-        addPageParameters cmd page
-        do! write cmd
-        do! updatePageMeta       page.Id [] page.Metadata
-        do! updatePagePermalinks page.Id [] page.PriorPermalinks
         do! updatePageRevisions page.Id [] page.Revisions
     }
     
-    /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
+    /// Get all pages for a web log (without text, metadata, revisions, or prior permalinks)
-    let all webLogId = backgroundTask {
+    let all webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.all"
-        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
+        conn.customList
-        addWebLogId cmd webLogId
+            $"{Query.selectFromTable Table.Page} WHERE {Document.Query.whereByWebLog} ORDER BY LOWER({titleField})"
-        use! rdr = cmd.ExecuteReaderAsync ()
+            [ webLogParam webLogId ]
-        return toList pageWithoutTextOrMeta rdr
+            (fun rdr -> { fromData<Page> rdr with Text = ""; Metadata = []; PriorPermalinks = [] })
-    }
     
     /// Count all pages for the given web log
-    let countAll webLogId = backgroundTask {
+    let countAll webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.countAll"
-        cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
+        Document.countByWebLog Table.Page webLogId conn
-        addWebLogId cmd webLogId
-        return! count cmd
-    }
     
     /// Count all pages shown in the page list for the given web log
-    let countListed webLogId = backgroundTask {
+    let countListed webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.countListed"
-        cmd.CommandText <- """
+        conn.customScalar
-            SELECT COUNT(id)
+            $"""{Document.Query.countByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"}"""
-              FROM page
+            [ webLogParam webLogId ]
-             WHERE web_log_id      = @webLogId
+            (toCount >> int)
-               AND is_in_page_list = @isInPageList"""
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
-        return! count cmd
-    }
     
     /// Find a page by its ID (without revisions and prior permalinks)
     let findById pageId webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findById"
-        cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
+        match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with
-        cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
+        | Some page -> return Some { page with PriorPermalinks = [] }
-        use! rdr = cmd.ExecuteReaderAsync ()
-        match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
-        | Some page ->
-            let! page = appendPageMeta page
-            return Some page
         | None -> return None
     }
     
     /// Find a complete page by its ID
     let findFullById pageId webLogId = backgroundTask {
-        match! findById pageId webLogId with
+        log.LogTrace "Page.findFullById"
+        match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with
         | Some page ->
-            let! page = appendPageRevisionsAndPermalinks page
+            let! page = appendPageRevisions page
             return Some page
         | None -> return None
     }
     
+    // TODO: need to handle when the page being deleted is the home page
+    /// Delete a page by its ID
     let delete pageId webLogId = backgroundTask {
+        log.LogTrace "Page.delete"
         match! findById pageId webLogId with
         | Some _ ->
-            use cmd = conn.CreateCommand ()
+            do! conn.customNonQuery
-            cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
+                    $"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.Delete.byId Table.Page}"
-            cmd.CommandText <- """
+                    [ idParam pageId ]
-                DELETE FROM page_revision  WHERE page_id = @id;
-                DELETE FROM page_permalink WHERE page_id = @id;
-                DELETE FROM page_meta      WHERE page_id = @id;
-                DELETE FROM page           WHERE id      = @id"""
-            do! write cmd
             return true
         | None -> return false
     }
     
     /// Find a page by its permalink for the given web log
-    let findByPermalink permalink webLogId = backgroundTask {
+    let findByPermalink (permalink: Permalink) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findByPermalink"
-        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
+        let linkParam = Field.EQ linkName (string permalink)
-        addWebLogId cmd webLogId
+        conn.customSingle
-        cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
+            $"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField linkParam "@link"}"""
-        use! rdr = cmd.ExecuteReaderAsync ()
+            (addFieldParam "@link" linkParam [ webLogParam webLogId ])
-        if rdr.Read () then
+            pageWithoutLinks
-            let! page = appendPageMeta (Map.toPage rdr)
-            return Some page
-        else
-            return None
-    }
     
     /// Find the current permalink within a set of potential prior permalinks for the given web log
-    let findCurrentPermalink permalinks webLogId = backgroundTask {
+    let findCurrentPermalink (permalinks: Permalink list) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findCurrentPermalink"
-        cmd.CommandText <- """
+        let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
-            SELECT p.permalink
+        conn.customSingle
-              FROM page p
+            $"SELECT data ->> '{linkName}' AS permalink
-                   INNER JOIN page_permalink pp ON pp.page_id = p.id
+                FROM {Table.Page}
-             WHERE p.web_log_id = @webLogId
+               WHERE {Document.Query.whereByWebLog} AND {linkSql}"
-               AND pp.permalink IN ("""
+            (webLogParam webLogId :: linkParams)
-        permalinks
+            Map.toPermalink
-        |> List.iteri (fun idx link ->
-            if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
-            cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
-            cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
-        cmd.CommandText <- $"{cmd.CommandText})"
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return if rdr.Read () then Some (Map.toPermalink rdr) else None
-    }
     
     /// Get all complete pages for the given web log
     let findFullByWebLog webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findFullByWebLog"
-        cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
+        let! pages    = Document.findByWebLog<Page> Table.Page webLogId conn
-        addWebLogId cmd webLogId
+        let! withRevs = pages |> List.map appendPageRevisions |> Task.WhenAll
-        use! rdr = cmd.ExecuteReaderAsync ()
+        return List.ofArray withRevs
-        let! pages =
-            toList Map.toPage rdr
-            |> List.map (fun page -> backgroundTask {
-                let! page = appendPageMeta page
-                return! appendPageRevisionsAndPermalinks page
-            })
-            |> Task.WhenAll
-        return List.ofArray pages
     }
     
-    /// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
+    /// Get all listed pages for the given web log (without revisions or text)
-    let findListed webLogId = backgroundTask {
+    let findListed webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findListed"
-        cmd.CommandText <- """
+        conn.customList
-            SELECT *
+            $"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"}
-              FROM page
+                ORDER BY LOWER({titleField})"""
-             WHERE web_log_id      = @webLogId
+            [ webLogParam webLogId ]
-               AND is_in_page_list = @isInPageList
+            (fun rdr -> { fromData<Page> rdr with Text = "" })
-             ORDER BY LOWER(title)"""
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! pages =
-            toList pageWithoutTextOrMeta rdr
-            |> List.map (fun page -> backgroundTask { return! appendPageMeta page })
-            |> Task.WhenAll
-        return List.ofArray pages
-    }
     
-    /// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
+    /// Get a page of pages for the given web log (without revisions)
-    let findPageOfPages webLogId pageNbr = backgroundTask {
+    let findPageOfPages webLogId pageNbr =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Page.findPageOfPages"
-        cmd.CommandText <- """
+        conn.customList
-            SELECT *
+            $"{Document.Query.selectByWebLog Table.Page} ORDER BY LOWER({titleField}) LIMIT @pageSize OFFSET @toSkip"
-              FROM page
+            [ webLogParam webLogId; SqliteParameter("@pageSize", 26); SqliteParameter("@toSkip", (pageNbr - 1) * 25) ]
-             WHERE web_log_id = @webLogId
+            (fun rdr -> { pageWithoutLinks rdr with Metadata = [] })
-             ORDER BY LOWER(title)
+    
-             LIMIT @pageSize OFFSET @toSkip"""
+    /// Update a page
-        addWebLogId cmd webLogId
+    let update (page: Page) = backgroundTask {
-        [ cmd.Parameters.AddWithValue ("@pageSize", 26)
+        log.LogTrace "Page.update"
-          cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
+        match! findFullById page.Id page.WebLogId with
-        ] |> ignore
+        | Some oldPage ->
-        use! rdr = cmd.ExecuteReaderAsync ()
+            do! conn.updateById Table.Page page.Id { page with Revisions = [] } 
-        return toList Map.toPage rdr
+            do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
+        | None -> ()
     }
     
     /// Restore pages from a backup
     let restore pages = backgroundTask {
-        for page in pages do
+        log.LogTrace "Page.restore"
-            do! add page
+        for page in pages do do! add page
-    }
-    
-    /// Update a page
-    let update (page : Page) = backgroundTask {
-        match! findFullById page.Id page.WebLogId with
-        | Some oldPage ->
-            use cmd = conn.CreateCommand ()
-            cmd.CommandText <- """
-                UPDATE page
-                   SET author_id       = @authorId,
-                       title           = @title,
-                       permalink       = @permalink,
-                       published_on    = @publishedOn,
-                       updated_on      = @updatedOn,
-                       is_in_page_list = @isInPageList,
-                       template        = @template,
-                       page_text       = @text
-                 WHERE id         = @pageId
-                   AND web_log_id = @webLogId"""
-            addPageParameters cmd page
-            do! write cmd
-            do! updatePageMeta       page.Id oldPage.Metadata        page.Metadata
-            do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
-            do! updatePageRevisions  page.Id oldPage.Revisions       page.Revisions
-            return ()
-        | None -> return ()
     }
     
     /// Update a page's prior permalinks
-    let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
+    let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
-        match! findFullById pageId webLogId with
+        log.LogTrace "Page.updatePriorPermalinks"
-        | Some page ->
+        match! findById pageId webLogId with
-            do! updatePagePermalinks pageId page.PriorPermalinks permalinks
+        | Some _ ->
+            do! conn.patchById Table.Page pageId {| PriorPermalinks = permalinks |}
             return true
          | None -> return false
     }

src/MyWebLog.Data/SQLite/SQLitePostData.fs

@@ -1,571 +1,213 @@
 namespace MyWebLog.Data.SQLite
 
-open System
 open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
+open NodaTime
 
 /// SQLite myWebLog post data implementation
-type SQLitePostData (conn : SqliteConnection) =
+type SQLitePostData(conn: SqliteConnection, log: ILogger) =
+    
+    /// The name of the JSON field for the post's permalink
+    let linkName = nameof Post.Empty.Permalink
+    
+    /// The JSON field for when the post was published
+    let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'"
+    
+    /// The name of the JSON field for the post's status
+    let statName = nameof Post.Empty.Status
     
     // SUPPORT FUNCTIONS
     
-    /// Add parameters for post INSERT or UPDATE statements
+    /// Append revisions to a post
-    let addPostParameters (cmd : SqliteCommand) (post : Post) =
+    let appendPostRevisions (post: Post) = backgroundTask {
-        [   cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
+        log.LogTrace "Post.appendPostRevisions"
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
+        let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id conn
-            cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
+        return { post with Revisions = revisions }
-            cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
-            cmd.Parameters.AddWithValue ("@title", post.Title)
-            cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
-            cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
-            cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
-            cmd.Parameters.AddWithValue ("@template", maybe post.Template)
-            cmd.Parameters.AddWithValue ("@text", post.Text)
-        ] |> ignore
-    
-    /// Add parameters for episode INSERT or UPDATE statements
-    let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
-        [   cmd.Parameters.AddWithValue ("@media", ep.Media)
-            cmd.Parameters.AddWithValue ("@length", ep.Length)
-            cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration)
-            cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
-            cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
-            cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
-            cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString))
-            cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
-            cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
-            cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
-            cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType)
-            cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang)
-            cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions)
-            cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber)
-            cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription)
-            cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string))
-            cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription)
-        ] |> ignore
-        
-    /// Append category IDs, tags, and meta items to a post
-    let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
-        
-        cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let post = { post with CategoryIds = toList Map.toCategoryId rdr }
-        do! rdr.CloseAsync ()
-        
-        cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let post = { post with Tags = toList (Map.getString "tag") rdr }
-        do! rdr.CloseAsync ()
-        
-        cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return { post with Metadata = toList Map.toMetaItem rdr }
     }
     
-    /// Append revisions and permalinks to a post
+    /// The SELECT statement to retrieve posts with a web log ID parameter
-    let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
+    let postByWebLog = Document.Query.selectByWebLog Table.Post
-        use cmd = conn.CreateCommand ()
-        cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
     
-        cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
+    /// Return a post with no revisions or prior permalinks
-        use! rdr = cmd.ExecuteReaderAsync ()
+    let postWithoutLinks rdr =
-        let post = { post with PriorPermalinks = toList Map.toPermalink rdr }
+        { fromData<Post> rdr with PriorPermalinks = [] }
-        do! rdr.CloseAsync ()
-        
-        cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return { post with Revisions = toList Map.toRevision rdr }
-    }
-    
-    /// The SELECT statement for a post that will include episode data, if it exists
-    let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
-    
-    /// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
-    let findPostById postId webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
-        cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) Map.toPost rdr
-    }
     
     /// Return a post with no revisions, prior permalinks, or text
     let postWithoutText rdr =
-        { Map.toPost rdr with Text = "" }
+        { postWithoutLinks rdr with Text = "" }
     
-    /// Update a post's assigned categories
+    /// The SELECT statement to retrieve published posts with a web log ID parameter
-    let updatePostCategories postId oldCats newCats = backgroundTask {
+    let publishedPostByWebLog =
-        let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString
+        $"""{postByWebLog} AND {Query.whereByField (Field.EQ statName "") $"'{string Published}'"}"""
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
-              cmd.Parameters.Add ("@categoryId", SqliteType.Text)
-            ] |> ignore
-            let runCmd catId = backgroundTask {
-                cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
-    
-    /// Update a post's assigned categories
-    let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
-        let toDelete, toAdd = diffLists oldTags newTags id
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
-              cmd.Parameters.Add ("@tag", SqliteType.Text)
-            ] |> ignore
-            let runCmd (tag : string) = backgroundTask {
-                cmd.Parameters["@tag"].Value <- tag
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
-    
-    /// Update an episode
-    let updatePostEpisode (post : Post) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
-        cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
-        let! count = count cmd
-        if count = 1 then
-            match post.Episode with
-            | Some ep ->
-                cmd.CommandText <- """
-                    UPDATE post_episode
-                       SET media               = @media,
-                           length              = @length,
-                           duration            = @duration,
-                           media_type          = @mediaType,
-                           image_url           = @imageUrl,
-                           subtitle            = @subtitle,
-                           explicit            = @explicit,
-                           chapter_file        = @chapterFile,
-                           chapter_type        = @chapterType,
-                           transcript_url      = @transcriptUrl,
-                           transcript_type     = @transcriptType,
-                           transcript_lang     = @transcriptLang,
-                           transcript_captions = @transcriptCaptions,
-                           season_number       = @seasonNumber,
-                           season_description  = @seasonDescription,
-                           episode_number      = @episodeNumber,
-                           episode_description = @episodeDescription
-                     WHERE post_id = @postId"""
-                addEpisodeParameters cmd ep
-                do! write cmd
-            | None ->
-                cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
-                do! write cmd
-        else
-            match post.Episode with
-            | Some ep ->
-                cmd.CommandText <- """
-                    INSERT INTO post_episode (
-                        post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
-                        chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
-                        season_number, season_description, episode_number, episode_description
-                    ) VALUES (
-                        @postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
-                        @chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
-                        @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
-                    )"""
-                addEpisodeParameters cmd ep
-                do! write cmd
-            | None -> ()
-    }
-    
-    /// Update a post's metadata items
-    let updatePostMeta postId oldItems newItems = backgroundTask {
-        let toDelete, toAdd = diffMetaItems oldItems newItems
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
-              cmd.Parameters.Add ("@name", SqliteType.Text)
-              cmd.Parameters.Add ("@value", SqliteType.Text)
-            ] |> ignore
-            let runCmd (item : MetaItem) = backgroundTask {
-                cmd.Parameters["@name" ].Value <- item.Name
-                cmd.Parameters["@value"].Value <- item.Value
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
-    
-    /// Update a post's prior permalinks
-    let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
-        let toDelete, toAdd = diffPermalinks oldLinks newLinks
-        if List.isEmpty toDelete && List.isEmpty toAdd then
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
-              cmd.Parameters.Add ("@link", SqliteType.Text)
-            ] |> ignore
-            let runCmd link = backgroundTask {
-                cmd.Parameters["@link"].Value <- Permalink.toString link
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link" 
-            toDelete
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
-            toAdd
-            |> List.map runCmd
-            |> Task.WhenAll
-            |> ignore
-    }
     
     /// Update a post's revisions
-    let updatePostRevisions postId oldRevs newRevs = backgroundTask {
+    let updatePostRevisions (postId: PostId) oldRevs newRevs =
-        let toDelete, toAdd = diffRevisions oldRevs newRevs
+        log.LogTrace "Post.updatePostRevisions"
-        if List.isEmpty toDelete && List.isEmpty toAdd then
+        Revisions.update Table.PostRevision Table.Post postId oldRevs newRevs conn
-            return ()
-        else
-            use cmd = conn.CreateCommand ()
-            let runCmd withText rev = backgroundTask {
-                cmd.Parameters.Clear ()
-                [ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
-                  cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
-                ] |> ignore
-                if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
-                do! write cmd
-            }
-            cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" 
-            toDelete
-            |> List.map (runCmd false)
-            |> Task.WhenAll
-            |> ignore
-            cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
-            toAdd
-            |> List.map (runCmd true)
-            |> Task.WhenAll
-            |> ignore
-    }
     
     // IMPLEMENTATION FUNCTIONS
     
     /// Add a post
-    let add post = backgroundTask {
+    let add (post: Post) = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.add"
-        cmd.CommandText <- """
+        do! conn.insert Table.Post { post with Revisions = [] }
-            INSERT INTO post (
-                id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
-            ) VALUES (
-                @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
-            )"""
-        addPostParameters cmd post
-        do! write cmd
-        do! updatePostCategories post.Id [] post.CategoryIds
-        do! updatePostTags       post.Id [] post.Tags
-        do! updatePostEpisode    post
-        do! updatePostMeta       post.Id [] post.Metadata
-        do! updatePostPermalinks post.Id [] post.PriorPermalinks
         do! updatePostRevisions post.Id [] post.Revisions
     }
     
     /// Count posts in a status for the given web log
-    let countByStatus status webLogId = backgroundTask {
+    let countByStatus (status: PostStatus) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.countByStatus"
-        cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
+        let statParam = Field.EQ statName (string status)
-        addWebLogId cmd webLogId
+        conn.customScalar
-        cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
+            $"""{Document.Query.countByWebLog Table.Post} AND {Query.whereByField statParam "@status"}"""
-        return! count cmd
+            (addFieldParam "@status" statParam [ webLogParam webLogId ])
-    }
+            (toCount >> int)
     
-    /// Find a post by its ID for the given web log (excluding revisions and prior permalinks
+    /// Find a post by its ID for the given web log (excluding revisions)
     let findById postId webLogId = backgroundTask {
-        match! findPostById postId webLogId with
+        log.LogTrace "Post.findById"
-        | Some post ->
+        match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with
-            let! post = appendPostCategoryTagAndMeta post
+        | Some post -> return Some { post with PriorPermalinks = [] }
-            return Some post
         | None -> return None
     }
     
-    /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
+    /// Find a post by its permalink for the given web log (excluding revisions)
-    let findByPermalink permalink webLogId = backgroundTask {
+    let findByPermalink (permalink: Permalink) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findByPermalink"
-        cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink  = @link"
+        let linkParam = Field.EQ linkName (string permalink)
-        addWebLogId cmd webLogId
+        conn.customSingle
-        cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
+            $"""{Document.Query.selectByWebLog Table.Post} AND {Query.whereByField linkParam "@link"}"""
-        use! rdr = cmd.ExecuteReaderAsync ()
+            (addFieldParam "@link" linkParam [ webLogParam webLogId ])
-        if rdr.Read () then
+            postWithoutLinks
-            let! post = appendPostCategoryTagAndMeta (Map.toPost rdr)
-            return Some post
-        else
-            return None
-    }
     
     /// Find a complete post by its ID for the given web log
     let findFullById postId webLogId = backgroundTask {
-        match! findById postId webLogId with
+        log.LogTrace "Post.findFullById"
+        match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with
         | Some post ->
-            let! post = appendPostRevisionsAndPermalinks post
+            let! post = appendPostRevisions post
             return Some post
         | None -> return None
     }
     
     /// Delete a post by its ID for the given web log
     let delete postId webLogId = backgroundTask {
-        match! findFullById postId webLogId with
+        log.LogTrace "Post.delete"
+        match! findById postId webLogId with
         | Some _ ->
-            use cmd = conn.CreateCommand ()
+            do! conn.customNonQuery
-            cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
+                    $"""DELETE FROM {Table.PostRevision} WHERE post_id = @id;
-            cmd.CommandText <- """
+                        DELETE FROM {Table.PostComment}
-                DELETE FROM post_revision  WHERE post_id = @id;
+                         WHERE {Query.whereByField (Field.EQ (nameof Comment.Empty.PostId) "") "@id"};
-                DELETE FROM post_permalink WHERE post_id = @id;
+                        {Query.Delete.byId Table.Post}"""
-                DELETE FROM post_meta      WHERE post_id = @id;
+                    [ idParam postId ]
-                DELETE FROM post_episode   WHERE post_id = @id;
-                DELETE FROM post_tag       WHERE post_id = @id;
-                DELETE FROM post_category  WHERE post_id = @id;
-                DELETE FROM post           WHERE id      = @id"""
-            do! write cmd
             return true
         | None -> return false
     }
     
     /// Find the current permalink from a list of potential prior permalinks for the given web log
-    let findCurrentPermalink permalinks webLogId = backgroundTask {
+    let findCurrentPermalink (permalinks: Permalink list) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findCurrentPermalink"
-        cmd.CommandText <- """
+        let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
-            SELECT p.permalink
+        conn.customSingle
-              FROM post p
+            $"SELECT data ->> '{linkName}' AS permalink
-                   INNER JOIN post_permalink pp ON pp.post_id = p.id
+                FROM {Table.Post}
-             WHERE p.web_log_id = @webLogId
+               WHERE {Document.Query.whereByWebLog} AND {linkSql}"
-               AND pp.permalink IN ("""
+            (webLogParam webLogId :: linkParams)
-        permalinks
+            Map.toPermalink
-        |> List.iteri (fun idx link ->
-            if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
-            cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
-            cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
-        cmd.CommandText <- $"{cmd.CommandText})"
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return if rdr.Read () then Some (Map.toPermalink rdr) else None
-    }
     
     /// Get all complete posts for the given web log
     let findFullByWebLog webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findFullByWebLog"
-        cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId"
+        let! posts    = Document.findByWebLog<Post> Table.Post webLogId conn
-        addWebLogId cmd webLogId
+        let! withRevs = posts |> List.map appendPostRevisions |> Task.WhenAll
-        use! rdr = cmd.ExecuteReaderAsync ()
+        return List.ofArray withRevs
-        let! posts =
-            toList Map.toPost rdr
-            |> List.map (fun post -> backgroundTask {
-                let! post = appendPostCategoryTagAndMeta post
-                return! appendPostRevisionsAndPermalinks post
-            })
-            |> Task.WhenAll
-        return List.ofArray posts
     }
     
-    /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
+    /// Get a page of categorized posts for the given web log (excludes revisions)
-    let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
+    let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findPageOfCategorizedPosts"
-        cmd.CommandText <- $"""
+        let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
-            {selectPost}
+        conn.customList
-                   INNER JOIN post_category pc ON pc.post_id = p.id
+            $"{publishedPostByWebLog} AND {catSql}
-             WHERE p.web_log_id = @webLogId
+               ORDER BY {publishField} DESC
-               AND p.status     = @status
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-               AND pc.category_id IN ("""
+            (webLogParam webLogId :: catParams)
-        categoryIds
+            postWithoutLinks
-        |> List.iteri (fun idx catId ->
-            if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
-            cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
-            cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
-        cmd.CommandText <-
-            $"""{cmd.CommandText})
-                ORDER BY published_on DESC
-                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList Map.toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
-            |> Task.WhenAll
-        return List.ofArray posts
-    }
     
-    /// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
+    /// Get a page of posts for the given web log (excludes text and revisions)
-    let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
+    let findPageOfPosts webLogId pageNbr postsPerPage =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findPageOfPosts"
-        cmd.CommandText <- $"""
+        conn.customList
-            {selectPost}
+            $"{postByWebLog}
-              WHERE p.web_log_id = @webLogId
+               ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
-              ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
+            [ webLogParam webLogId ]
-        addWebLogId cmd webLogId
+            postWithoutText
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList postWithoutText rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
-            |> Task.WhenAll
-        return List.ofArray posts
-    }
     
-    /// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
+    /// Get a page of published posts for the given web log (excludes revisions)
-    let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
+    let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findPageOfPublishedPosts"
-        cmd.CommandText <- $"""
+        conn.customList
-            {selectPost}
+            $"{publishedPostByWebLog}
-              WHERE p.web_log_id = @webLogId
+               ORDER BY {publishField} DESC
-                AND p.status     = @status
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-              ORDER BY p.published_on DESC
+            [ webLogParam webLogId ]
-              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
+            postWithoutLinks
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList Map.toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
-            |> Task.WhenAll
-        return List.ofArray posts
-    }
     
-    /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
+    /// Get a page of tagged posts for the given web log (excludes revisions)
-    let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
+    let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findPageOfTaggedPosts"
-        cmd.CommandText <- $"""
+        let tagSql, tagParams = inJsonArray Table.Post (nameof Post.Empty.Tags) "tag" [ tag ]
-            {selectPost}
+        conn.customList
-                    INNER JOIN post_tag pt ON pt.post_id = p.id
+            $"{publishedPostByWebLog} AND {tagSql}
-              WHERE p.web_log_id = @webLogId
+               ORDER BY {publishField} DESC
-                AND p.status     = @status
+               LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-                AND pt.tag       = @tag
+            (webLogParam webLogId :: tagParams)
-              ORDER BY p.published_on DESC
+            postWithoutLinks
-              LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
-        addWebLogId cmd webLogId
-        [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
-          cmd.Parameters.AddWithValue ("@tag", tag)
-        ] |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList Map.toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
-            |> Task.WhenAll
-        return List.ofArray posts
-    }
     
     /// Find the next newest and oldest post from a publish date for the given web log
-    let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
+    let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Post.findSurroundingPosts"
-        cmd.CommandText <- $"""
+        let! older =
-            {selectPost}
+            conn.customSingle
-             WHERE p.web_log_id   = @webLogId
+                $"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
-               AND p.status       = @status
+                [ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ]
-               AND p.published_on < @publishedOn
+                postWithoutLinks
-             ORDER BY p.published_on DESC
+        let! newer =
-             LIMIT 1"""
+            conn.customSingle
-        addWebLogId cmd webLogId
+                $"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
-        [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
+                [ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ]
-          cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
+                postWithoutLinks
-        ] |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! older = backgroundTask {
-            if rdr.Read () then
-                let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
-                return Some post
-            else
-                return None
-        }
-        do! rdr.CloseAsync ()
-        cmd.CommandText <- $"""
-            {selectPost}
-             WHERE p.web_log_id   = @webLogId
-               AND p.status       = @status
-               AND p.published_on > @publishedOn
-             ORDER BY p.published_on
-             LIMIT 1"""
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! newer = backgroundTask {
-            if rdr.Read () then
-                let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
-                return Some post
-            else
-                return None
-        }
         return older, newer
     }
     
-    /// Restore posts from a backup
-    let restore posts = backgroundTask {
-        for post in posts do
-            do! add post
-    }
-    
     /// Update a post
     let update (post: Post) = backgroundTask {
+        log.LogTrace "Post.update"
         match! findFullById post.Id post.WebLogId with
         | Some oldPost ->
-            use cmd = conn.CreateCommand ()
+            do! conn.updateById Table.Post post.Id { post with Revisions = [] }
-            cmd.CommandText <- """
-                UPDATE post
-                   SET author_id    = @authorId,
-                       status       = @status,
-                       title        = @title,
-                       permalink    = @permalink,
-                       published_on = @publishedOn,
-                       updated_on   = @updatedOn,
-                       template     = @template,
-                       post_text    = @text
-                 WHERE id         = @id
-                   AND web_log_id = @webLogId"""
-            addPostParameters cmd post
-            do! write cmd
-            do! updatePostCategories post.Id oldPost.CategoryIds     post.CategoryIds
-            do! updatePostTags       post.Id oldPost.Tags            post.Tags
-            do! updatePostEpisode    post
-            do! updatePostMeta       post.Id oldPost.Metadata        post.Metadata
-            do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
             do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
-        | None -> return ()
+        | None -> ()
+    }
+    
+    /// Restore posts from a backup
+    let restore posts = backgroundTask {
+        log.LogTrace "Post.restore"
+        for post in posts do do! add post
     }
     
     /// Update prior permalinks for a post
-    let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
+    let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
-        match! findFullById postId webLogId with
+        match! findById postId webLogId with
-        | Some post ->
+        | Some _ ->
-            do! updatePostPermalinks postId post.PriorPermalinks permalinks
+            do! conn.patchById Table.Post postId {| PriorPermalinks = permalinks |}
             return true
           | None -> return false
     }

src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs

@@ -1,101 +1,62 @@
 namespace MyWebLog.Data.SQLite
 
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
 /// SQLite myWebLog tag mapping data implementation
-type SQLiteTagMapData (conn : SqliteConnection) =
+type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) =
 
     /// Find a tag mapping by its ID for the given web log
-    let findById tagMapId webLogId = backgroundTask {
+    let findById tagMapId webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "TagMap.findById"
-        cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
+        Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId conn
-        cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.WebLogId) Map.toTagMap rdr
-    }
     
     /// Delete a tag mapping for the given web log
     let delete tagMapId webLogId = backgroundTask {
+        log.LogTrace "TagMap.delete"
         match! findById tagMapId webLogId with
         | Some _ ->
-            use cmd = conn.CreateCommand ()
+            do! conn.deleteById Table.TagMap tagMapId
-            cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
-            cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
-            do! write cmd
             return true
         | None -> return false
     }
     
     /// Find a tag mapping by its URL value for the given web log
-    let findByUrlValue (urlValue : string) webLogId = backgroundTask {
+    let findByUrlValue (urlValue: string) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "TagMap.findByUrlValue"
-        cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
+        let urlParam = Field.EQ (nameof TagMap.Empty.UrlValue) urlValue
-        addWebLogId cmd webLogId
+        conn.customSingle
-        cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
+            $"""{Document.Query.selectByWebLog Table.TagMap} AND {Query.whereByField urlParam "@urlValue"}"""
-        use! rdr = cmd.ExecuteReaderAsync ()
+            (addFieldParam "@urlValue" urlParam [ webLogParam webLogId ])
-        return if rdr.Read () then Some (Map.toTagMap rdr) else None
+            fromData<TagMap>
-    }
     
     /// Get all tag mappings for the given web log
-    let findByWebLog webLogId = backgroundTask {
+    let findByWebLog webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "TagMap.findByWebLog"
-        cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
+        Document.findByWebLog<TagMap> Table.TagMap webLogId conn
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList Map.toTagMap rdr
-    }
     
     /// Find any tag mappings in a list of tags for the given web log
-    let findMappingForTags (tags : string list) webLogId = backgroundTask {
+    let findMappingForTags (tags: string list) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "TagMap.findMappingForTags"
-        cmd.CommandText <- """
+        let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
-            SELECT *
+        conn.customList
-              FROM tag_map
+            $"{Document.Query.selectByWebLog Table.TagMap} {mapSql}"
-             WHERE web_log_id = @webLogId
+            (webLogParam webLogId :: mapParams)
-               AND tag IN ("""
+            fromData<TagMap>
-        tags
-        |> List.iteri (fun idx tag ->
-            if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
-            cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
-            cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
-        cmd.CommandText <- $"{cmd.CommandText})"
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList Map.toTagMap rdr
-    }
     
     /// Save a tag mapping
-    let save (tagMap : TagMap) = backgroundTask {
+    let save (tagMap: TagMap) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "TagMap.save"
-        match! findById tagMap.Id tagMap.WebLogId with
+        conn.save Table.TagMap tagMap
-        | Some _ ->
-            cmd.CommandText <- """
-                UPDATE tag_map
-                   SET tag       = @tag,
-                       url_value = @urlValue
-                 WHERE id         = @id
-                   AND web_log_id = @webLogId"""
-        | None ->
-            cmd.CommandText <- """
-                INSERT INTO tag_map (
-                    id, web_log_id, tag, url_value
-                ) VALUES (
-                    @id, @webLogId, @tag, @urlValue
-                )"""
-        addWebLogId cmd tagMap.WebLogId
-        [ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
-          cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
-          cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
-        ] |> ignore
-        do! write cmd
-    }
     
     /// Restore tag mappings from a backup
     let restore tagMaps = backgroundTask {
-        for tagMap in tagMaps do
+        log.LogTrace "TagMap.restore"
-            do! save tagMap
+        for tagMap in tagMaps do do! save tagMap
     }
     
     interface ITagMapData with

src/MyWebLog.Data/SQLite/SQLiteThemeData.fs

@@ -1,107 +1,71 @@
 namespace MyWebLog.Data.SQLite
 
-open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
 /// SQLite myWebLog theme data implementation
-type SQLiteThemeData (conn : SqliteConnection) =
+type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
     
-    /// Retrieve all themes (except 'admin'; excludes templates)
+    /// The JSON field for the theme ID
-    let all () = backgroundTask {
+    let idField = $"data ->> '{nameof Theme.Empty.Id}'"
-        use cmd = conn.CreateCommand ()
+    
-        cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
+    /// Convert a document to a theme with no template text
-        use! rdr = cmd.ExecuteReaderAsync ()
+    let withoutTemplateText (rdr: SqliteDataReader) =
-        return toList Map.toTheme rdr
+        let theme = fromData<Theme> rdr
-    }
+        { theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })}
+    
+    /// Remove the template text from a theme
+    let withoutTemplateText' (it: Theme) =
+        { it with Templates = it.Templates |> List.map (fun t -> { t with Text = "" }) }
+    
+    /// Retrieve all themes (except 'admin'; excludes template text)
+    let all () =
+        log.LogTrace "Theme.all"
+        conn.customList
+            $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
+            []
+            withoutTemplateText
+    
+    /// Does a given theme exist?
+    let exists (themeId: ThemeId) =
+        log.LogTrace "Theme.exists"
+        conn.existsById Table.Theme themeId
     
     /// Find a theme by its ID
-    let findById themeId = backgroundTask {
+    let findById themeId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Theme.findById"
-        cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
+        conn.findById<ThemeId, Theme> Table.Theme themeId
-        cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        if rdr.Read () then
-            let theme = Map.toTheme rdr
-            let templateCmd = conn.CreateCommand ()
-            templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
-            templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
-            use! templateRdr = templateCmd.ExecuteReaderAsync ()
-            return Some { theme with Templates = toList Map.toThemeTemplate templateRdr }
-        else
-            return None
-    }
     
     /// Find a theme by its ID (excludes the text of templates)
-    let findByIdWithoutText themeId = backgroundTask {
+    let findByIdWithoutText (themeId: ThemeId) =
-        match! findById themeId with
+        log.LogTrace "Theme.findByIdWithoutText"
-        | Some theme ->
+        conn.customSingle (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
-            return Some {
+    
-                theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
+    /// Delete a theme by its ID
-            }
+    let delete themeId = backgroundTask {
-        | None -> return None
+        log.LogTrace "Theme.delete"
+        match! findByIdWithoutText themeId with
+        | Some _ ->
+            do! conn.customNonQuery
+                    $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}"
+                    [ idParam themeId ]
+            return true
+        | None -> return false
     }
     
     /// Save a theme
-    let save (theme : Theme) = backgroundTask {
+    let save (theme: Theme) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Theme.save"
-        let! oldTheme = findById theme.Id
+        conn.save Table.Theme theme
-        cmd.CommandText <-
-            match oldTheme with
-            | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
-            | None -> "INSERT INTO theme VALUES (@id, @name, @version)"
-        [ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
-          cmd.Parameters.AddWithValue ("@name", theme.Name)
-          cmd.Parameters.AddWithValue ("@version", theme.Version)
-        ] |> ignore
-        do! write cmd
-        
-        let toDelete, toAdd =
-            diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
-                      theme.Templates (fun t -> t.Name)
-        let toUpdate =
-            theme.Templates
-            |> List.filter (fun t ->
-                not (toDelete |> List.exists (fun d -> d.Name = t.Name))
-                && not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
-        cmd.CommandText <-
-            "UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
-        cmd.Parameters.Clear ()
-        [ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
-          cmd.Parameters.Add ("@name", SqliteType.Text)
-          cmd.Parameters.Add ("@template", SqliteType.Text)
-        ] |> ignore
-        toUpdate
-        |> List.map (fun template -> backgroundTask {
-            cmd.Parameters["@name"    ].Value <- template.Name
-            cmd.Parameters["@template"].Value <- template.Text
-            do! write cmd
-        })
-        |> Task.WhenAll
-        |> ignore
-        cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
-        toAdd
-        |> List.map (fun template -> backgroundTask {
-            cmd.Parameters["@name"    ].Value <- template.Name
-            cmd.Parameters["@template"].Value <- template.Text
-            do! write cmd
-        })
-        |> Task.WhenAll
-        |> ignore
-        cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
-        cmd.Parameters.Remove cmd.Parameters["@template"]
-        toDelete
-        |> List.map (fun template -> backgroundTask {
-            cmd.Parameters["@name"].Value <- template.Name
-            do! write cmd
-        })
-        |> Task.WhenAll
-        |> ignore
-    }
     
     interface IThemeData with
         member _.All() = all ()
+        member _.Delete themeId = delete themeId
+        member _.Exists themeId = exists themeId
         member _.FindById themeId = findById themeId
         member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
         member _.Save theme = save theme
@@ -110,91 +74,69 @@ type SQLiteThemeData (conn : SqliteConnection) =
 open System.IO
 
 /// SQLite myWebLog theme data implementation
-type SQLiteThemeAssetData (conn : SqliteConnection) =
+type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
+    
+    /// Create parameters for a theme asset ID
+    let assetIdParams assetId =
+        let (ThemeAssetId (ThemeId themeId, path)) = assetId
+        [ idParam themeId; sqlParam "@path" path ]
     
     /// Get all theme assets (excludes data)
-    let all () = backgroundTask {
+    let all () =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.all"
-        cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
+        conn.customList $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList (Map.toThemeAsset false) rdr
-    }
     
     /// Delete all assets for the given theme
-    let deleteByTheme themeId = backgroundTask {
+    let deleteByTheme (themeId: ThemeId) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.deleteByTheme"
-        cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
+        conn.customNonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
-        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
-        do! write cmd
-    }
     
     /// Find a theme asset by its ID
-    let findById assetId = backgroundTask {
+    let findById assetId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.findById"
-        cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
+        conn.customSingle
-        let (ThemeAssetId (ThemeId themeId, path)) = assetId
+            $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
-        [ cmd.Parameters.AddWithValue ("@themeId", themeId)
+            (assetIdParams assetId)
-          cmd.Parameters.AddWithValue ("@path", path)
+            (Map.toThemeAsset true)
-        ] |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
-    }
     
     /// Get theme assets for the given theme (excludes data)
-    let findByTheme themeId = backgroundTask {
+    let findByTheme (themeId: ThemeId) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.findByTheme"
-        cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
+        conn.customList
-        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
+            $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id"
-        use! rdr = cmd.ExecuteReaderAsync ()
+            [ idParam themeId ]
-        return toList (Map.toThemeAsset false) rdr
+            (Map.toThemeAsset false)
-    }
     
     /// Get theme assets for the given theme
-    let findByThemeWithData themeId = backgroundTask {
+    let findByThemeWithData (themeId: ThemeId) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.findByThemeWithData"
-        cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
+        conn.customList
-        cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
+            $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id"
-        use! rdr = cmd.ExecuteReaderAsync ()
+            [ idParam themeId ]
-        return toList (Map.toThemeAsset true) rdr
+            (Map.toThemeAsset true)
-    }
     
     /// Save a theme asset
     let save (asset: ThemeAsset) = backgroundTask {
-        use sideCmd = conn.CreateCommand ()
+        log.LogTrace "ThemeAsset.save"
-        sideCmd.CommandText <-
+        do! conn.customNonQuery
-            "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
+                $"INSERT INTO {Table.ThemeAsset} (
-        let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
-        [ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
-          sideCmd.Parameters.AddWithValue ("@path", path)
-        ] |> ignore
-        let! exists = count sideCmd
-        
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <-
-            if exists = 1 then
-                """UPDATE theme_asset
-                      SET updated_on = @updatedOn,
-                          data       = ZEROBLOB(@dataLength)
-                    WHERE theme_id = @themeId
-                      AND path     = @path"""
-            else
-                """INSERT INTO theme_asset (
                     theme_id, path, updated_on, data
                   ) VALUES (
-                       @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
+                    @id, @path, @updatedOn, ZEROBLOB(@dataLength)
-                   )"""
+                  ) ON CONFLICT (theme_id, path) DO UPDATE
-        [ cmd.Parameters.AddWithValue ("@themeId", themeId)
+                  SET updated_on = @updatedOn,
-          cmd.Parameters.AddWithValue ("@path", path)
+                      data       = ZEROBLOB(@dataLength)"
-          cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
+                [ sqlParam "@updatedOn" (instantParam asset.UpdatedOn)
-          cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
+                  sqlParam "@dataLength" asset.Data.Length
-        ] |> ignore
+                  yield! (assetIdParams asset.Id) ]
-        do! write cmd
-        
-        sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
-        let! rowId = sideCmd.ExecuteScalarAsync ()
         
+        let! rowId =
+            conn.customScalar
+                $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
+                (assetIdParams asset.Id)
+                _.GetInt64(0)
         use dataStream = new MemoryStream(asset.Data)
-        use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
+        use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId)
         do! dataStream.CopyToAsync blobStream
     }
     

src/MyWebLog.Data/SQLite/SQLiteUploadData.fs

@@ -1,93 +1,78 @@
 namespace MyWebLog.Data.SQLite
 
 open System.IO
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
 /// SQLite myWebLog web log data implementation
-type SQLiteUploadData (conn : SqliteConnection) =
+type SQLiteUploadData(conn: SqliteConnection, log: ILogger) =
-
-    /// Add parameters for uploaded file INSERT and UPDATE statements
-    let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
-        [   cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
-            cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
-            cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
-            cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
-        ] |> ignore
 
     /// Save an uploaded file
-    let add upload = backgroundTask {
+    let add (upload: Upload) = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Upload.add"
-        cmd.CommandText <- """
+        do! conn.customNonQuery
-            INSERT INTO upload (
+                $"INSERT INTO {Table.Upload} (
                     id, web_log_id, path, updated_on, data
                   ) VALUES (
                     @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
-            )"""
+                  )"
-        addUploadParameters cmd upload
+                [ idParam     upload.Id
-        do! write cmd
+                  webLogParam upload.WebLogId
-        
+                  sqlParam "@path"       (string upload.Path)
-        cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
+                  sqlParam "@updatedOn"  (instantParam upload.UpdatedOn)
-        let! rowId = cmd.ExecuteScalarAsync ()
+                  sqlParam "@dataLength" upload.Data.Length ]
-        
+        let! rowId =
+            conn.customScalar $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" [ idParam upload.Id ] _.GetInt64(0)
         use dataStream = new MemoryStream(upload.Data)
-        use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
+        use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId)
         do! dataStream.CopyToAsync blobStream
     }
     
     /// Delete an uploaded file by its ID
-    let delete uploadId webLogId = backgroundTask {
+    let delete (uploadId: UploadId) webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Upload.delete"
-        cmd.CommandText <- """
+        let! upload =
-            SELECT id, web_log_id, path, updated_on
+            conn.customSingle
-              FROM upload
+                $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
-             WHERE id         = @id
+                [ idParam uploadId; webLogParam webLogId ]
-               AND web_log_id = @webLogId"""
+                (Map.toUpload false)
-        addWebLogId cmd webLogId
+        match upload with
-        cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
+        | Some up ->
-        let! rdr = cmd.ExecuteReaderAsync ()
+            do! conn.customNonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" [ idParam up.Id ]
-        if (rdr.Read ()) then
+            return Ok (string up.Path)
-            let upload = Map.toUpload false rdr
+        | None -> return Error $"Upload ID {string uploadId} not found"
-            do! rdr.CloseAsync ()
-            cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
-            do! write cmd
-            return Ok (Permalink.toString upload.Path)
-        else
-            return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
     }
     
     /// Find an uploaded file by its path for the given web log
-    let findByPath (path : string) webLogId = backgroundTask {
+    let findByPath (path: string) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Upload.findByPath"
-        cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path"
+        conn.customSingle
-        addWebLogId cmd webLogId
+            $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
-        cmd.Parameters.AddWithValue ("@path", path) |> ignore
+            [ webLogParam webLogId; sqlParam "@path" path ]
-        let! rdr = cmd.ExecuteReaderAsync ()
+            (Map.toUpload true)
-        return if rdr.Read () then Some (Map.toUpload true rdr) else None
-    }
     
     /// Find all uploaded files for the given web log (excludes data)
-    let findByWebLog webLogId = backgroundTask {
+    let findByWebLog webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Upload.findByWebLog"
-        cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
+        conn.customList
-        addWebLogId cmd webLogId
+            $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
-        let! rdr = cmd.ExecuteReaderAsync ()
+            [ webLogParam webLogId ]
-        return toList (Map.toUpload false) rdr
+            (Map.toUpload false)
-    }
     
     /// Find all uploaded files for the given web log
-    let findByWebLogWithData webLogId = backgroundTask {
+    let findByWebLogWithData webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Upload.findByWebLogWithData"
-        cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId"
+        conn.customList
-        addWebLogId cmd webLogId
+            $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId"
-        let! rdr = cmd.ExecuteReaderAsync ()
+            [ webLogParam webLogId ]
-        return toList (Map.toUpload true) rdr
+            (Map.toUpload true)
-    }
     
     /// Restore uploads from a backup
     let restore uploads = backgroundTask {
+        log.LogTrace "Upload.restore"
         for upload in uploads do do! add upload
     }
     

src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs

@@ -1,328 +1,67 @@
 namespace MyWebLog.Data.SQLite
 
-open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
-// The web log podcast insert loop is not statically compilable; this is OK
-#nowarn "3511"
-
 /// SQLite myWebLog web log data implementation
-type SQLiteWebLogData (conn : SqliteConnection) =
+type SQLiteWebLogData(conn: SqliteConnection, log: ILogger) =
-    
-    // SUPPORT FUNCTIONS
-    
-    /// Add parameters for web log INSERT or web log/RSS options UPDATE statements
-    let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
-        [   cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
-            cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
-            cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
-            cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
-            cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
-            cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
-        ] |> ignore
-    
-    /// Add parameters for web log INSERT or UPDATE statements
-    let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
-        [   cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
-            cmd.Parameters.AddWithValue ("@name", webLog.Name)
-            cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
-            cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
-            cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
-            cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
-            cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
-            cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
-            cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
-            cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
-            cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
-        ] |> ignore
-        addWebLogRssParameters cmd webLog
-    
-    /// Add parameters for custom feed INSERT or UPDATE statements
-    let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
-        [   cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
-            cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
-            cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
-        ] |> ignore
-    
-    /// Add parameters for podcast INSERT or UPDATE statements
-    let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
-        [   cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
-            cmd.Parameters.AddWithValue ("@title", podcast.Title)
-            cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle)
-            cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed)
-            cmd.Parameters.AddWithValue ("@summary", podcast.Summary)
-            cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor)
-            cmd.Parameters.AddWithValue ("@email", podcast.Email)
-            cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl)
-            cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory)
-            cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
-            cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit)
-            cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType)
-            cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl)
-            cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
-            cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
-            cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
-            cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString))
-        ] |> ignore
-
-    /// Get the current custom feeds for a web log
-    let getCustomFeeds (webLog : WebLog) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- """
-            SELECT f.*, p.*
-              FROM web_log_feed f
-                   LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
-             WHERE f.web_log_id = @webLogId"""
-        addWebLogId cmd webLog.Id
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList Map.toCustomFeed rdr
-    }
-    
-    /// Append custom feeds to a web log
-    let appendCustomFeeds (webLog : WebLog) = backgroundTask {
-        let! feeds = getCustomFeeds webLog
-        return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
-    }
-    
-    /// Add a podcast to a custom feed
-    let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- """
-            INSERT INTO web_log_feed_podcast (
-                feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
-                apple_category, apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid,
-                funding_url, funding_text, medium
-            ) VALUES (
-                @feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
-                @appleCategory, @appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid,
-                @fundingUrl, @fundingText, @medium
-            )"""
-        addPodcastParameters cmd feedId podcast
-        do! write cmd
-    }
-    
-    /// Update the custom feeds for a web log
-    let updateCustomFeeds (webLog : WebLog) = backgroundTask {
-        let! feeds = getCustomFeeds webLog
-        let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
-        let toId (feed : CustomFeed) = feed.Id
-        let toUpdate =
-            webLog.Rss.CustomFeeds
-            |> List.filter (fun f ->
-                not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
-        use cmd = conn.CreateCommand ()
-        cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
-        toDelete
-        |> List.map (fun it -> backgroundTask {
-            cmd.CommandText <- """
-                DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
-                DELETE FROM web_log_feed         WHERE id      = @id"""
-            cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
-            do! write cmd
-        })
-        |> Task.WhenAll
-        |> ignore
-        cmd.Parameters.Clear ()
-        toAdd
-        |> List.map (fun it -> backgroundTask {
-            cmd.CommandText <- """
-                INSERT INTO web_log_feed (
-                    id, web_log_id, source, path
-                ) VALUES (
-                    @id, @webLogId, @source, @path
-                )"""
-            cmd.Parameters.Clear ()
-            addCustomFeedParameters cmd webLog.Id it
-            do! write cmd
-            match it.Podcast with
-            | Some podcast -> do! addPodcast it.Id podcast
-            | None -> ()
-        })
-        |> Task.WhenAll
-        |> ignore
-        toUpdate
-        |> List.map (fun it -> backgroundTask {
-            cmd.CommandText <- """
-                UPDATE web_log_feed
-                   SET source = @source,
-                       path   = @path
-                 WHERE id         = @id
-                   AND web_log_id = @webLogId"""
-            cmd.Parameters.Clear ()
-            addCustomFeedParameters cmd webLog.Id it
-            do! write cmd
-            let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
-            match it.Podcast with
-            | Some podcast ->
-                if hadPodcast then
-                    cmd.CommandText <- """
-                        UPDATE web_log_feed_podcast
-                           SET title              = @title,
-                               subtitle           = @subtitle,
-                               items_in_feed      = @itemsInFeed,
-                               summary            = @summary,
-                               displayed_author   = @displayedAuthor,
-                               email              = @email,
-                               image_url          = @imageUrl,
-                               apple_category     = @appleCategory,
-                               apple_subcategory  = @appleSubcategory,
-                               explicit           = @explicit,
-                               default_media_type = @defaultMediaType,
-                               media_base_url     = @mediaBaseUrl,
-                               podcast_guid       = @podcastGuid,
-                               funding_url        = @fundingUrl,
-                               funding_text       = @fundingText,
-                               medium             = @medium
-                         WHERE feed_id = @feedId"""
-                    cmd.Parameters.Clear ()
-                    addPodcastParameters cmd it.Id podcast
-                    do! write cmd
-                else
-                    do! addPodcast it.Id podcast
-            | None ->
-                if hadPodcast then
-                    cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
-                    cmd.Parameters.Clear ()
-                    cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
-                    do! write cmd
-                else
-                    ()
-        })
-        |> Task.WhenAll
-        |> ignore
-    }
-    
-    // IMPLEMENTATION FUNCTIONS
     
     /// Add a web log
-    let add webLog = backgroundTask {
+    let add webLog =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.add"
-        cmd.CommandText <- """
+        conn.insert<WebLog> Table.WebLog webLog
-            INSERT INTO web_log (
-                id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
-                uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
-            ) VALUES (
-                @id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
-                @uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
-            )"""
-        addWebLogParameters cmd webLog
-        do! write cmd
-        do! updateCustomFeeds webLog
-    }
     
     /// Retrieve all web logs
-    let all () = backgroundTask {
+    let all () =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.all"
-        cmd.CommandText <- "SELECT * FROM web_log"
+        conn.findAll<WebLog> Table.WebLog
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! webLogs =
-            toList Map.toWebLog rdr
-            |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
-            |> Task.WhenAll
-        return List.ofArray webLogs
-    }
     
     /// Delete a web log by its ID
-    let delete webLogId = backgroundTask {
+    let delete webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.delete"
-        addWebLogId cmd webLogId
+        let webLogMatches = Query.whereByField (Field.EQ "WebLogId" "") "@webLogId"
-        let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
+        let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {webLogMatches})"
-        let postSubQuery = subQuery "post"
+        Custom.nonQuery
-        let pageSubQuery = subQuery "page"
+            $"""DELETE FROM {Table.PostComment}  WHERE data ->> 'PostId' IN {subQuery Table.Post};
-        cmd.CommandText <- $"""
+                DELETE FROM {Table.PostRevision} WHERE post_id           IN {subQuery Table.Post};
-            DELETE FROM post_comment         WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.PageRevision} WHERE page_id           IN {subQuery Table.Page};
-            DELETE FROM post_revision        WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.Post}         WHERE {webLogMatches};
-            DELETE FROM post_permalink       WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.Page}         WHERE {webLogMatches};
-            DELETE FROM post_episode         WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.Category}     WHERE {webLogMatches};
-            DELETE FROM post_tag             WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.TagMap}       WHERE {webLogMatches};
-            DELETE FROM post_category        WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.Upload}       WHERE web_log_id = @webLogId;
-            DELETE FROM post_meta            WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.WebLogUser}   WHERE {webLogMatches};
-            DELETE FROM post                 WHERE web_log_id = @webLogId;
+                DELETE FROM {Table.WebLog}       WHERE {Query.whereById "@webLogId"}"""
-            DELETE FROM page_revision        WHERE page_id IN {pageSubQuery};
+            [ webLogParam webLogId ]
-            DELETE FROM page_permalink       WHERE page_id IN {pageSubQuery};
-            DELETE FROM page_meta            WHERE page_id IN {pageSubQuery};
-            DELETE FROM page                 WHERE web_log_id = @webLogId;
-            DELETE FROM category             WHERE web_log_id = @webLogId;
-            DELETE FROM tag_map              WHERE web_log_id = @webLogId;
-            DELETE FROM upload               WHERE web_log_id = @webLogId;
-            DELETE FROM web_log_user         WHERE web_log_id = @webLogId;
-            DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
-            DELETE FROM web_log_feed         WHERE web_log_id = @webLogId;
-            DELETE FROM web_log              WHERE id         = @webLogId"""
-        do! write cmd
-    }
     
     /// Find a web log by its host (URL base)
-    let findByHost (url : string) = backgroundTask {
+    let findByHost (url: string) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.findByHost"
-        cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
+        conn.findFirstByField<WebLog> Table.WebLog (Field.EQ (nameof WebLog.Empty.UrlBase) url)
-        cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        if rdr.Read () then
-            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
-            return Some webLog
-        else
-            return None
-    }
     
     /// Find a web log by its ID
-    let findById webLogId = backgroundTask {
+    let findById webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.findById"
-        cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
+        conn.findById<WebLogId, WebLog> Table.WebLog webLogId
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        if rdr.Read () then
-            let! webLog = appendCustomFeeds (Map.toWebLog rdr)
-            return Some webLog
-        else
-            return None
-    }
     
-    /// Update settings for a web log
+    /// Update redirect rules for a web log
-    let updateSettings webLog = backgroundTask {
+    let updateRedirectRules (webLog: WebLog) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.updateRedirectRules"
-        cmd.CommandText <- """
+        conn.patchById Table.WebLog webLog.Id {| RedirectRules = webLog.RedirectRules |}
-            UPDATE web_log
-               SET name                = @name,
-                   slug                = @slug,
-                   subtitle            = @subtitle,
-                   default_page        = @defaultPage,
-                   posts_per_page      = @postsPerPage,
-                   theme_id            = @themeId,
-                   url_base            = @urlBase,
-                   time_zone           = @timeZone,
-                   auto_htmx           = @autoHtmx,
-                   uploads             = @uploads,
-                   is_feed_enabled     = @isFeedEnabled,
-                   feed_name           = @feedName,
-                   items_in_feed       = @itemsInFeed,
-                   is_category_enabled = @isCategoryEnabled,
-                   is_tag_enabled      = @isTagEnabled,
-                   copyright           = @copyright
-             WHERE id = @id"""
-        addWebLogParameters cmd webLog
-        do! write cmd
-    }
 
     /// Update RSS options for a web log
-    let updateRssOptions webLog = backgroundTask {
+    let updateRssOptions (webLog: WebLog) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLog.updateRssOptions"
-        cmd.CommandText <- """
+        conn.patchById Table.WebLog webLog.Id {| Rss = webLog.Rss |}
-            UPDATE web_log
+    
-               SET is_feed_enabled     = @isFeedEnabled,
+    /// Update settings for a web log
-                   feed_name           = @feedName,
+    let updateSettings (webLog: WebLog) =
-                   items_in_feed       = @itemsInFeed,
+        log.LogTrace "WebLog.updateSettings"
-                   is_category_enabled = @isCategoryEnabled,
+        conn.updateById Table.WebLog webLog.Id webLog
-                   is_tag_enabled      = @isTagEnabled,
-                   copyright           = @copyright
-             WHERE id = @id"""
-        addWebLogRssParameters cmd webLog
-        do! write cmd
-        do! updateCustomFeeds webLog
-    }
     
     interface IWebLogData with
         member _.Add webLog = add webLog
@@ -330,5 +69,6 @@ type SQLiteWebLogData (conn : SqliteConnection) =
         member _.Delete webLogId = delete webLogId
         member _.FindByHost url = findByHost url
         member _.FindById webLogId = findById webLogId
-        member _.UpdateSettings webLog = updateSettings webLog
+        member _.UpdateRedirectRules webLog = updateRedirectRules webLog
         member _.UpdateRssOptions webLog = updateRssOptions webLog
+        member _.UpdateSettings webLog = updateSettings webLog

src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs

@@ -1,154 +1,86 @@
 namespace MyWebLog.Data.SQLite
 
-open System
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
+open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
 
 /// SQLite myWebLog user data implementation
-type SQLiteWebLogUserData (conn : SqliteConnection) =
+type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) =
-    
-    // SUPPORT FUNCTIONS
-
-    /// Add parameters for web log user INSERT or UPDATE statements
-    let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
-        [   cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
-            cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
-            cmd.Parameters.AddWithValue ("@email", user.Email)
-            cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
-            cmd.Parameters.AddWithValue ("@lastName", user.LastName)
-            cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
-            cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
-            cmd.Parameters.AddWithValue ("@salt", user.Salt)
-            cmd.Parameters.AddWithValue ("@url", maybe user.Url)
-            cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
-            cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
-            cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
-        ] |> ignore
-    
-    // IMPLEMENTATION FUNCTIONS
     
     /// Add a user
-    let add user = backgroundTask {
+    let add user =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.add"
-        cmd.CommandText <- """
+        conn.insert<WebLogUser> Table.WebLogUser user
-            INSERT INTO web_log_user (
-                id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
-                created_on, last_seen_on
-            ) VALUES (
-                @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
-                @createdOn, @lastSeenOn
-            )"""
-        addWebLogUserParameters cmd user
-        do! write cmd
-    }
     
     /// Find a user by their ID for the given web log
-    let findById userId webLogId = backgroundTask {
+    let findById userId webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.findById"
-        cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
+        Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId conn
-        cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr 
-    }
     
     /// Delete a user if they have no posts or pages
     let delete userId webLogId = backgroundTask {
+        log.LogTrace "WebLogUser.delete"
         match! findById userId webLogId with
         | Some _ ->
-            use cmd = conn.CreateCommand ()
+            let! pageCount = conn.countByField Table.Page (Field.EQ (nameof Page.Empty.AuthorId) (string userId))
-            cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId"
+            let! postCount = conn.countByField Table.Post (Field.EQ (nameof Post.Empty.AuthorId) (string userId))
-            cmd.Parameters.AddWithValue ("@userId", WebLogUserId.toString userId) |> ignore
-            let! pageCount = count cmd
-            cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
-            let! postCount = count cmd
             if pageCount + postCount > 0 then
                 return Error "User has pages or posts; cannot delete"
             else
-                cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId"
+                do! conn.deleteById Table.WebLogUser userId
-                let! _ = cmd.ExecuteNonQueryAsync ()
                 return Ok true
         | None -> return Error "User does not exist"
     }
     
     /// Find a user by their e-mail address for the given web log
-    let findByEmail (email : string) webLogId = backgroundTask {
+    let findByEmail (email: string) webLogId =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.findByEmail"
-        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
+        let emailParam = Field.EQ (nameof WebLogUser.Empty.Email) email
-        addWebLogId cmd webLogId
+        conn.customSingle
-        cmd.Parameters.AddWithValue ("@email", email) |> ignore
+            $"""{Document.Query.selectByWebLog Table.WebLogUser}
-        use! rdr = cmd.ExecuteReaderAsync ()
+                  AND {Query.whereByField emailParam "@email"}"""
-        return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
+            (addFieldParam "@email" emailParam [ webLogParam webLogId ])
-    }
+            fromData<WebLogUser>
     
     /// Get all users for the given web log
     let findByWebLog webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.findByWebLog"
-        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
+        let! users = Document.findByWebLog<WebLogUser> Table.WebLogUser webLogId conn
-        addWebLogId cmd webLogId
+        return users |> List.sortBy _.PreferredName.ToLowerInvariant()
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList Map.toWebLogUser rdr
     }
     
     /// Find the names of users by their IDs for the given web log
-    let findNames webLogId userIds = backgroundTask {
+    let findNames webLogId (userIds: WebLogUserId list) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.findNames"
-        cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
+        let nameSql, nameParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" string userIds 
-        userIds
+        conn.customList
-        |> List.iteri (fun idx userId ->
+            $"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}"
-            if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
+            (webLogParam webLogId :: nameParams)
-            cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
+            (fun rdr ->
-            cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
+                let user = fromData<WebLogUser> rdr
-        cmd.CommandText <- $"{cmd.CommandText})"
+                { Name = string user.Id; Value = user.DisplayName })
-        addWebLogId cmd webLogId
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return
-            toList Map.toWebLogUser rdr
-            |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
-    }
     
     /// Restore users from a backup
     let restore users = backgroundTask {
-        for user in users do
+        log.LogTrace "WebLogUser.restore"
-            do! add user
+        for user in users do do! add user
     }
     
     /// Set a user's last seen date/time to now
     let setLastSeen userId webLogId = backgroundTask {
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.setLastSeen"
-        cmd.CommandText <- """
+        match! findById userId webLogId with
-            UPDATE web_log_user
+        | Some _ -> do! conn.patchById Table.WebLogUser userId {| LastSeenOn = Noda.now () |}
-               SET last_seen_on = @lastSeenOn
+        | None -> ()
-             WHERE id         = @id
-               AND web_log_id = @webLogId"""
-        addWebLogId cmd webLogId
-        [ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
-          cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow)
-        ] |> ignore
-        let! _ = cmd.ExecuteNonQueryAsync ()
-        ()
     }
     
     /// Update a user
-    let update user = backgroundTask {
+    let update (user: WebLogUser) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "WebLogUser.update"
-        cmd.CommandText <- """
+        conn.updateById Table.WebLogUser user.Id user
-            UPDATE web_log_user
-               SET email          = @email,
-                   first_name     = @firstName,
-                   last_name      = @lastName,
-                   preferred_name = @preferredName,
-                   password_hash  = @passwordHash,
-                   salt           = @salt,
-                   url            = @url,
-                   access_level   = @accessLevel,
-                   created_on     = @createdOn,
-                   last_seen_on   = @lastSeenOn
-             WHERE id         = @id
-               AND web_log_id = @webLogId"""
-        addWebLogUserParameters cmd user
-        do! write cmd
-    }
     
     interface IWebLogUserData with
         member _.Add user = add user

src/MyWebLog.Data/SQLiteData.fs

@@ -1,385 +1,485 @@
 namespace MyWebLog.Data
 
+open System
+open System.Threading.Tasks
+open BitBadger.Documents
+open BitBadger.Documents.Sqlite
 open Microsoft.Data.Sqlite
 open Microsoft.Extensions.Logging
+open MyWebLog
 open MyWebLog.Data.SQLite
+open Newtonsoft.Json
+open NodaTime
 
 /// SQLite myWebLog data implementation
-type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
+type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSerializer) =
     
-    /// Determine if the given table exists
+    /// Create tables (and their associated indexes) if they do not exist
-    let tableExists (table : string) = backgroundTask {
+    let ensureTables () = backgroundTask {
+        
+        Configuration.useSerializer (Utils.createDocumentSerializer ser)
+        
+        let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
+        
+        let needsTable table =
+            not (List.contains table tables)
+        
+        let jsonTable table =
+            $"{Query.Definition.ensureTable table}; {Query.Definition.ensureKey table}"
+        
+        let tasks =
+            seq {
+                // Theme tables
+                if needsTable Table.Theme then jsonTable Table.Theme
+                if needsTable Table.ThemeAsset then
+                    $"CREATE TABLE {Table.ThemeAsset} (
+                        theme_id    TEXT NOT NULL,
+                        path        TEXT NOT NULL,
+                        updated_on  TEXT NOT NULL,
+                        data        BLOB NOT NULL,
+                        PRIMARY KEY (theme_id, path))"
+                
+                // Web log table
+                if needsTable Table.WebLog then jsonTable Table.WebLog
+                
+                // Category table
+                if needsTable Table.Category then
+                    $"""{jsonTable Table.Category};
+                        {Query.Definition.ensureIndexOn Table.Category "web_log" [ nameof Category.Empty.WebLogId ]}"""
+                
+                // Web log user table
+                if needsTable Table.WebLogUser then
+                    $"""{jsonTable Table.WebLogUser};
+                        {Query.Definition.ensureIndexOn
+                             Table.WebLogUser
+                             "email"
+                             [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]}"""
+                
+                // Page tables
+                if needsTable Table.Page then
+                    $"""{jsonTable Table.Page};
+                        {Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]};
+                        {Query.Definition.ensureIndexOn
+                             Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]}"""
+                if needsTable Table.PageRevision then
+                    $"CREATE TABLE {Table.PageRevision} (
+                        page_id        TEXT NOT NULL,
+                        as_of          TEXT NOT NULL,
+                        revision_text  TEXT NOT NULL,
+                        PRIMARY KEY (page_id, as_of))"
+                
+                // Post tables
+                if needsTable Table.Post then
+                    $"""{jsonTable Table.Post};
+                        {Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]};
+                        {Query.Definition.ensureIndexOn
+                             Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]};
+                        {Query.Definition.ensureIndexOn
+                             Table.Post
+                             "status"
+                             [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]}"""
+                      // TODO: index categories by post?
+                if needsTable Table.PostRevision then
+                    $"CREATE TABLE {Table.PostRevision} (
+                        post_id        TEXT NOT NULL,
+                        as_of          TEXT NOT NULL,
+                        revision_text  TEXT NOT NULL,
+                        PRIMARY KEY (post_id, as_of))"
+                if needsTable Table.PostComment then
+                    $"""{jsonTable Table.PostComment};
+                        {Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]}"""
+                
+                // Tag map table
+                if needsTable Table.TagMap then
+                    $"""{jsonTable Table.TagMap};
+                        {Query.Definition.ensureIndexOn
+                             Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]}"""
+                
+                // Uploaded file table
+                if needsTable Table.Upload then
+                    $"CREATE TABLE {Table.Upload} (
+                        id          TEXT PRIMARY KEY,
+                        web_log_id  TEXT NOT NULL,
+                        path        TEXT NOT NULL,
+                        updated_on  TEXT NOT NULL,
+                        data        BLOB NOT NULL);
+                      CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)"
+                
+                // Database version table
+                if needsTable Table.DbVersion then
+                    $"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
+                      INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
+            }
+            |> Seq.map (fun sql ->
+                log.LogInformation $"""Creating {(sql.Replace("IF NOT EXISTS ", "").Split ' ')[2]} table..."""
+                conn.customNonQuery sql [])
+        
+        let! _ = Task.WhenAll tasks
+        ()
+    }
+    
+    /// Set the database version to the specified version
+    let setDbVersion version =
+        conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" []
+        
+    /// Implement the changes between v2-rc1 and v2-rc2
+    let migrateV2Rc1ToV2Rc2 () = backgroundTask {
+        let logStep = Utils.Migration.logStep log "v2-rc1 to v2-rc2"
+        // Move meta items, podcast settings, and episode details to JSON-encoded text fields
         use cmd = conn.CreateCommand()
-        cmd.CommandText <- "SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = @table"
+        logStep "Adding new columns"
-        cmd.Parameters.AddWithValue ("@table", table) |> ignore
+        cmd.CommandText <-
-        let! count = count cmd
+            "ALTER TABLE web_log_feed ADD COLUMN podcast    TEXT;
-        return count = 1
+             ALTER TABLE page         ADD COLUMN meta_items TEXT;
+             ALTER TABLE post         ADD COLUMN meta_items TEXT;
+             ALTER TABLE post         ADD COLUMN episode    TEXT"
+        do! write cmd
+        logStep "Migrating meta items"
+        let migrateMeta entity = backgroundTask {
+            cmd.CommandText <- $"SELECT * FROM %s{entity}_meta"
+            use! metaRdr = cmd.ExecuteReaderAsync()
+            let allMetas =
+                seq {
+                    while metaRdr.Read() do
+                        Map.getString $"{entity}_id" metaRdr,
+                        { Name = Map.getString "name" metaRdr; Value = Map.getString "value" metaRdr }
+                } |> List.ofSeq
+            metaRdr.Close ()
+            let metas =
+                allMetas
+                |> List.map fst
+                |> List.distinct
+                |> List.map (fun it -> it, allMetas |> List.filter (fun meta -> fst meta = it))
+            metas
+            |> List.iter (fun (entityId, items) ->
+                cmd.CommandText <-
+                    "UPDATE post
+                        SET meta_items = @metaItems
+                      WHERE id = @postId"
+                [ cmd.Parameters.AddWithValue("@metaItems", Utils.serialize ser items)
+                  cmd.Parameters.AddWithValue("@id",        entityId) ] |> ignore
+                let _ = cmd.ExecuteNonQuery()
+                cmd.Parameters.Clear())
+        }
+        do! migrateMeta "page"
+        do! migrateMeta "post"
+        logStep "Migrating podcasts and episodes"
+        cmd.CommandText <- "SELECT * FROM web_log_feed_podcast"
+        use! podcastRdr = cmd.ExecuteReaderAsync()
+        let podcasts =
+            seq {
+                while podcastRdr.Read() do
+                    CustomFeedId (Map.getString "feed_id" podcastRdr),
+                    { Title             = Map.getString "title"              podcastRdr
+                      Subtitle          = Map.tryString "subtitle"           podcastRdr
+                      ItemsInFeed       = Map.getInt    "items_in_feed"      podcastRdr
+                      Summary           = Map.getString "summary"            podcastRdr
+                      DisplayedAuthor   = Map.getString "displayed_author"   podcastRdr
+                      Email             = Map.getString "email"              podcastRdr
+                      ImageUrl          = Map.getString "image_url"          podcastRdr |> Permalink
+                      AppleCategory     = Map.getString "apple_category"     podcastRdr
+                      AppleSubcategory  = Map.tryString "apple_subcategory"  podcastRdr
+                      Explicit          = Map.getString "explicit"           podcastRdr |> ExplicitRating.Parse
+                      DefaultMediaType  = Map.tryString "default_media_type" podcastRdr
+                      MediaBaseUrl      = Map.tryString "media_base_url"     podcastRdr
+                      PodcastGuid       = Map.tryGuid   "podcast_guid"       podcastRdr
+                      FundingUrl        = Map.tryString "funding_url"        podcastRdr
+                      FundingText       = Map.tryString "funding_text"       podcastRdr
+                      Medium            = Map.tryString "medium"             podcastRdr
+                                          |> Option.map PodcastMedium.Parse }
+            } |> List.ofSeq
+        podcastRdr.Close()
+        podcasts
+        |> List.iter (fun (feedId, podcast) ->
+            cmd.CommandText <- "UPDATE web_log_feed SET podcast = @podcast WHERE id = @id"
+            [ cmd.Parameters.AddWithValue("@podcast", Utils.serialize ser podcast)
+              cmd.Parameters.AddWithValue("@id",      string feedId) ] |> ignore
+            let _ = cmd.ExecuteNonQuery()
+            cmd.Parameters.Clear())
+        cmd.CommandText <- "SELECT * FROM post_episode"
+        use! epRdr = cmd.ExecuteReaderAsync()
+        let episodes =
+            seq {
+                while epRdr.Read() do
+                    PostId (Map.getString "post_id" epRdr),
+                    { Media              = Map.getString   "media"               epRdr
+                      Length             = Map.getLong     "length"              epRdr
+                      Duration           = Map.tryTimeSpan "duration"            epRdr
+                                           |> Option.map Duration.FromTimeSpan
+                      MediaType          = Map.tryString   "media_type"          epRdr
+                      ImageUrl           = Map.tryString   "image_url"           epRdr
+                      Subtitle           = Map.tryString   "subtitle"            epRdr
+                      Explicit           = Map.tryString   "explicit"            epRdr
+                                           |> Option.map ExplicitRating.Parse
+                      Chapters           = Map.tryString   "chapters"            epRdr
+                                           |> Option.map (Utils.deserialize<Chapter list> ser)
+                      ChapterFile        = Map.tryString   "chapter_file"        epRdr
+                      ChapterType        = Map.tryString   "chapter_type"        epRdr
+                      ChapterWaypoints   = None 
+                      TranscriptUrl      = Map.tryString   "transcript_url"      epRdr
+                      TranscriptType     = Map.tryString   "transcript_type"     epRdr
+                      TranscriptLang     = Map.tryString   "transcript_lang"     epRdr
+                      TranscriptCaptions = Map.tryBoolean  "transcript_captions" epRdr
+                      SeasonNumber       = Map.tryInt      "season_number"       epRdr
+                      SeasonDescription  = Map.tryString   "season_description"  epRdr
+                      EpisodeNumber      = Map.tryString   "episode_number"      epRdr |> Option.map Double.Parse
+                      EpisodeDescription = Map.tryString   "episode_description" epRdr }
+            } |> List.ofSeq
+        epRdr.Close()
+        episodes
+        |> List.iter (fun (postId, episode) ->
+            cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
+            [ cmd.Parameters.AddWithValue("@episode", Utils.serialize ser episode)
+              cmd.Parameters.AddWithValue("@id",      string postId) ] |> ignore
+            let _ = cmd.ExecuteNonQuery()
+            cmd.Parameters.Clear())
+        
+        logStep "Migrating dates/times"
+        let inst (dt: DateTime) =
+            DateTime(dt.Ticks, DateTimeKind.Utc)
+            |> (Instant.FromDateTimeUtc >> Noda.toSecondsPrecision)
+        // page.updated_on, page.published_on
+        cmd.CommandText <- "SELECT id, updated_on, published_on FROM page"
+        use! pageRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while pageRdr.Read() do
+                    Map.getString "id" pageRdr,
+                    inst (Map.getDateTime "updated_on"   pageRdr),
+                    inst (Map.getDateTime "published_on" pageRdr)
+            } |> List.ofSeq
+        pageRdr.Close()
+        cmd.CommandText <- "UPDATE page SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
+        [ cmd.Parameters.Add("@id",          SqliteType.Text)
+          cmd.Parameters.Add("@updatedOn",   SqliteType.Text)
+          cmd.Parameters.Add("@publishedOn", SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (pageId, updatedOn, publishedOn) ->
+            cmd.Parameters["@id"         ].Value <- pageId
+            cmd.Parameters["@updatedOn"  ].Value <- instantParam updatedOn
+            cmd.Parameters["@publishedOn"].Value <- instantParam publishedOn
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // page_revision.as_of
+        cmd.CommandText <- "SELECT * FROM page_revision"
+        use! pageRevRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while pageRevRdr.Read() do
+                    let asOf = Map.getDateTime "as_of" pageRevRdr
+                    Map.getString "page_id" pageRevRdr, asOf, inst asOf, Map.getString "revision_text" pageRevRdr
+            } |> List.ofSeq
+        pageRevRdr.Close ()
+        cmd.CommandText <-
+            "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @oldAsOf;
+             INSERT INTO page_revision (page_id, as_of, revision_text) VALUES (@pageId, @asOf, @text)"
+        [ cmd.Parameters.Add("@pageId",  SqliteType.Text)
+          cmd.Parameters.Add("@oldAsOf", SqliteType.Text)
+          cmd.Parameters.Add("@asOf",    SqliteType.Text)
+          cmd.Parameters.Add("@text",    SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (pageId, oldAsOf, asOf, text) ->
+            cmd.Parameters["@pageId" ].Value <- pageId
+            cmd.Parameters["@oldAsOf"].Value <- oldAsOf
+            cmd.Parameters["@asOf"   ].Value <- instantParam asOf
+            cmd.Parameters["@text"   ].Value <- text
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // post.updated_on, post.published_on (opt)
+        cmd.CommandText <- "SELECT id, updated_on, published_on FROM post"
+        use! postRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while postRdr.Read() do
+                    Map.getString "id" postRdr,
+                    inst (Map.getDateTime "updated_on" postRdr),
+                    (Map.tryDateTime "published_on" postRdr |> Option.map inst)
+            } |> List.ofSeq
+        postRdr.Close()
+        cmd.CommandText <- "UPDATE post SET updated_on = @updatedOn, published_on = @publishedOn WHERE id = @id"
+        [ cmd.Parameters.Add("@id",          SqliteType.Text)
+          cmd.Parameters.Add("@updatedOn",   SqliteType.Text)
+          cmd.Parameters.Add("@publishedOn", SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (postId, updatedOn, publishedOn) ->
+            cmd.Parameters["@id"         ].Value <- postId
+            cmd.Parameters["@updatedOn"  ].Value <- instantParam updatedOn
+            cmd.Parameters["@publishedOn"].Value <- maybeInstant publishedOn
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // post_revision.as_of
+        cmd.CommandText <- "SELECT * FROM post_revision"
+        use! postRevRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while postRevRdr.Read() do
+                    let asOf = Map.getDateTime "as_of" postRevRdr
+                    Map.getString "post_id" postRevRdr, asOf, inst asOf, Map.getString "revision_text" postRevRdr
+            } |> List.ofSeq
+        postRevRdr.Close()
+        cmd.CommandText <-
+            "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @oldAsOf;
+             INSERT INTO post_revision (post_id, as_of, revision_text) VALUES (@postId, @asOf, @text)"
+        [ cmd.Parameters.Add("@postId",  SqliteType.Text)
+          cmd.Parameters.Add("@oldAsOf", SqliteType.Text)
+          cmd.Parameters.Add("@asOf",    SqliteType.Text)
+          cmd.Parameters.Add("@text",    SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (postId, oldAsOf, asOf, text) ->
+            cmd.Parameters["@postId" ].Value <- postId
+            cmd.Parameters["@oldAsOf"].Value <- oldAsOf
+            cmd.Parameters["@asOf"   ].Value <- instantParam asOf
+            cmd.Parameters["@text"   ].Value <- text
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // theme_asset.updated_on
+        cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
+        use! assetRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while assetRdr.Read() do
+                    Map.getString "theme_id" assetRdr, Map.getString "path" assetRdr,
+                    inst (Map.getDateTime "updated_on" assetRdr)
+            } |> List.ofSeq
+        assetRdr.Close ()
+        cmd.CommandText <- "UPDATE theme_asset SET updated_on = @updatedOn WHERE theme_id = @themeId AND path = @path"
+        [ cmd.Parameters.Add("@updatedOn", SqliteType.Text)
+          cmd.Parameters.Add("@themeId",   SqliteType.Text)
+          cmd.Parameters.Add("@path",      SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (themeId, path, updatedOn) ->
+            cmd.Parameters["@themeId"  ].Value <- themeId
+            cmd.Parameters["@path"     ].Value <- path
+            cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // upload.updated_on
+        cmd.CommandText <- "SELECT id, updated_on FROM upload"
+        use! upRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while upRdr.Read() do
+                    Map.getString "id" upRdr, inst (Map.getDateTime "updated_on" upRdr)
+            } |> List.ofSeq
+        upRdr.Close ()
+        cmd.CommandText <- "UPDATE upload SET updated_on = @updatedOn WHERE id = @id"
+        [ cmd.Parameters.Add("@updatedOn", SqliteType.Text)
+          cmd.Parameters.Add("@id",        SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (upId, updatedOn) ->
+            cmd.Parameters["@id"       ].Value <- upId
+            cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        // web_log_user.created_on, web_log_user.last_seen_on (opt)
+        cmd.CommandText <- "SELECT id, created_on, last_seen_on FROM web_log_user"
+        use! userRdr = cmd.ExecuteReaderAsync()
+        let toUpdate =
+            seq {
+                while userRdr.Read() do
+                    Map.getString "id" userRdr,
+                    inst (Map.getDateTime "created_on" userRdr),
+                    (Map.tryDateTime "last_seen_on" userRdr |> Option.map inst)
+            } |> List.ofSeq
+        userRdr.Close()
+        cmd.CommandText <- "UPDATE web_log_user SET created_on = @createdOn, last_seen_on = @lastSeenOn WHERE id = @id"
+        [ cmd.Parameters.Add("@id",         SqliteType.Text)
+          cmd.Parameters.Add("@createdOn",  SqliteType.Text)
+          cmd.Parameters.Add("@lastSeenOn", SqliteType.Text) ] |> ignore
+        toUpdate
+        |> List.iter (fun (userId, createdOn, lastSeenOn) ->
+            cmd.Parameters["@id"        ].Value <- userId
+            cmd.Parameters["@createdOn" ].Value <- instantParam createdOn
+            cmd.Parameters["@lastSeenOn"].Value <- maybeInstant lastSeenOn
+            let _ = cmd.ExecuteNonQuery()
+            ())
+        cmd.Parameters.Clear()
+        
+        conn.Close()
+        conn.Open()
+        
+        logStep "Dropping old tables and columns"
+        cmd.CommandText <-
+            "ALTER TABLE web_log_user DROP COLUMN salt;
+             DROP  TABLE post_episode;
+             DROP  TABLE post_meta;
+             DROP  TABLE page_meta;
+             DROP  TABLE web_log_feed_podcast"
+        do! write cmd
+        
+        logStep "Setting database version to v2-rc2"
+        do! setDbVersion "v2-rc2"
+    }
+    
+    /// Migrate from v2-rc2 to v2
+    let migrateV2Rc2ToV2 () = backgroundTask {
+        Utils.Migration.logStep log "v2-rc2 to v2" "Setting database version; no migration required"
+        do! setDbVersion "v2"
+    }
+
+    /// Migrate from v2 to v2.1
+    let migrateV2ToV2point1 () = backgroundTask {
+        let! webLogs =
+            Custom.list $"SELECT url_base, slug FROM {Table.WebLog}" [] (fun rdr -> rdr.GetString(0), rdr.GetString(1))
+        Utils.Migration.backupAndRestoreRequired log "v2" "v2.1" webLogs
+    }
+
+    /// Migrate from v2.1 to v2.1.1
+    let migrateV2ToV2point1point1 () = backgroundTask {
+        Utils.Migration.logStep log "v2.1 to v2.1.1" "Setting database version; no migration required"
+        do! setDbVersion "v2.1.1"
+    }
+
+    /// Migrate data among versions (up only)
+    let migrate version = backgroundTask {
+        let mutable v = defaultArg version ""
+
+        if v = "v2-rc1" then
+            do! migrateV2Rc1ToV2Rc2 ()
+            v <- "v2-rc2"
+        
+        if v = "v2-rc2" then
+            do! migrateV2Rc2ToV2 ()
+            v <- "v2"
+        
+        if v = "v2" then
+            do! migrateV2ToV2point1 ()
+            v <- "v2.1"
+        
+        if v = "v2.1" then
+            do! migrateV2ToV2point1point1 ()
+            v <- "v2.1.1"
+        
+        if v <> Utils.Migration.currentDbVersion then
+            log.LogWarning $"Unknown database version; assuming {Utils.Migration.currentDbVersion}"
+            do! setDbVersion Utils.Migration.currentDbVersion
     }
     
     /// The connection for this instance
     member _.Conn = conn
     
-    /// Make a SQLite connection ready to execute commends
-    static member setUpConnection (conn : SqliteConnection) = backgroundTask {
-        do! conn.OpenAsync ()
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- "PRAGMA foreign_keys = TRUE"
-        let! _ = cmd.ExecuteNonQueryAsync ()
-        ()
-    }
-    
     interface IData with
     
-        member _.Category   = SQLiteCategoryData   conn
+        member _.Category   = SQLiteCategoryData   (conn, ser, log)
-        member _.Page       = SQLitePageData       conn
+        member _.Page       = SQLitePageData       (conn, log)
-        member _.Post       = SQLitePostData       conn
+        member _.Post       = SQLitePostData       (conn, log)
-        member _.TagMap     = SQLiteTagMapData     conn
+        member _.TagMap     = SQLiteTagMapData     (conn, log)
-        member _.Theme      = SQLiteThemeData      conn
+        member _.Theme      = SQLiteThemeData      (conn, log)
-        member _.ThemeAsset = SQLiteThemeAssetData conn
+        member _.ThemeAsset = SQLiteThemeAssetData (conn, log)
-        member _.Upload     = SQLiteUploadData     conn
+        member _.Upload     = SQLiteUploadData     (conn, log)
-        member _.WebLog     = SQLiteWebLogData     conn
+        member _.WebLog     = SQLiteWebLogData     (conn, log)
-        member _.WebLogUser = SQLiteWebLogUserData conn
+        member _.WebLogUser = SQLiteWebLogUserData (conn, log)
+        
+        member _.Serializer = ser
         
         member _.StartUp () = backgroundTask {
-
+            do! ensureTables ()
-            use cmd = conn.CreateCommand ()
+            let! version = conn.customSingle<string> $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0)
-            
+            do! migrate version
-            // Theme tables
-            match! tableExists "theme" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating theme table..."
-                cmd.CommandText <- """
-                    CREATE TABLE theme (
-                        id       TEXT PRIMARY KEY,
-                        name     TEXT NOT NULL,
-                        version  TEXT NOT NULL)"""
-                do! write cmd
-            match! tableExists "theme_template" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating theme_template table..."
-                cmd.CommandText <- """
-                    CREATE TABLE theme_template (
-                        theme_id  TEXT NOT NULL REFERENCES theme (id),
-                        name      TEXT NOT NULL,
-                        template  TEXT NOT NULL,
-                        PRIMARY KEY (theme_id, name))"""
-                do! write cmd
-            match! tableExists "theme_asset" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating theme_asset table..."
-                cmd.CommandText <- """
-                    CREATE TABLE theme_asset (
-                        theme_id    TEXT NOT NULL REFERENCES theme (id),
-                        path        TEXT NOT NULL,
-                        updated_on  TEXT NOT NULL,
-                        data        BLOB NOT NULL,
-                        PRIMARY KEY (theme_id, path))"""
-                do! write cmd
-            
-            // Web log tables
-            match! tableExists "web_log" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating web_log table..."
-                cmd.CommandText <- """
-                    CREATE TABLE web_log (
-                        id                   TEXT PRIMARY KEY,
-                        name                 TEXT NOT NULL,
-                        slug                 TEXT NOT NULL,
-                        subtitle             TEXT,
-                        default_page         TEXT NOT NULL,
-                        posts_per_page       INTEGER NOT NULL,
-                        theme_id             TEXT NOT NULL REFERENCES theme (id),
-                        url_base             TEXT NOT NULL,
-                        time_zone            TEXT NOT NULL,
-                        auto_htmx            INTEGER NOT NULL DEFAULT 0,
-                        uploads              TEXT NOT NULL,
-                        is_feed_enabled      INTEGER NOT NULL DEFAULT 0,
-                        feed_name            TEXT NOT NULL,
-                        items_in_feed        INTEGER,
-                        is_category_enabled  INTEGER NOT NULL DEFAULT 0,
-                        is_tag_enabled       INTEGER NOT NULL DEFAULT 0,
-                        copyright            TEXT);
-                    CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
-                do! write cmd
-            match! tableExists "web_log_feed" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating web_log_feed table..."
-                cmd.CommandText <- """
-                    CREATE TABLE web_log_feed (
-                        id          TEXT PRIMARY KEY,
-                        web_log_id  TEXT NOT NULL REFERENCES web_log (id),
-                        source      TEXT NOT NULL,
-                        path        TEXT NOT NULL);
-                    CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
-                do! write cmd
-            match! tableExists "web_log_feed_podcast" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating web_log_feed_podcast table..."
-                cmd.CommandText <- """
-                    CREATE TABLE web_log_feed_podcast (
-                        feed_id             TEXT PRIMARY KEY REFERENCES web_log_feed (id),
-                        title               TEXT NOT NULL,
-                        subtitle            TEXT,
-                        items_in_feed       INTEGER NOT NULL,
-                        summary             TEXT NOT NULL,
-                        displayed_author    TEXT NOT NULL,
-                        email               TEXT NOT NULL,
-                        image_url           TEXT NOT NULL,
-                        apple_category      TEXT NOT NULL,
-                        apple_subcategory   TEXT,
-                        explicit            TEXT NOT NULL,
-                        default_media_type  TEXT,
-                        media_base_url      TEXT,
-                        podcast_guid        TEXT,
-                        funding_url         TEXT,
-                        funding_text        TEXT,
-                        medium              TEXT)"""
-                do! write cmd
-            
-            // Category table
-            match! tableExists "category" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating category table..."
-                cmd.CommandText <- """
-                    CREATE TABLE category (
-                        id           TEXT PRIMARY KEY,
-                        web_log_id   TEXT NOT NULL REFERENCES web_log (id),
-                        name         TEXT NOT NULL,
-                        slug         TEXT NOT NULL,
-                        description  TEXT,
-                        parent_id    TEXT);
-                    CREATE INDEX category_web_log_idx ON category (web_log_id)"""
-                do! write cmd
-            
-            // Web log user table
-            match! tableExists "web_log_user" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating web_log_user table..."
-                cmd.CommandText <- """
-                    CREATE TABLE web_log_user (
-                        id              TEXT PRIMARY KEY,
-                        web_log_id      TEXT NOT NULL REFERENCES web_log (id),
-                        email           TEXT NOT NULL,
-                        first_name      TEXT NOT NULL,
-                        last_name       TEXT NOT NULL,
-                        preferred_name  TEXT NOT NULL,
-                        password_hash   TEXT NOT NULL,
-                        salt            TEXT NOT NULL,
-                        url             TEXT,
-                        access_level    TEXT NOT NULL,
-                        created_on      TEXT NOT NULL,
-                        last_seen_on    TEXT);
-                    CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
-                    CREATE INDEX web_log_user_email_idx   ON web_log_user (web_log_id, email)"""
-                do! write cmd
-            
-            // Page tables
-            match! tableExists "page" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating page table..."
-                cmd.CommandText <- """
-                    CREATE TABLE page (
-                        id               TEXT PRIMARY KEY,
-                        web_log_id       TEXT NOT NULL REFERENCES web_log (id),
-                        author_id        TEXT NOT NULL REFERENCES web_log_user (id),
-                        title            TEXT NOT NULL,
-                        permalink        TEXT NOT NULL,
-                        published_on     TEXT NOT NULL,
-                        updated_on       TEXT NOT NULL,
-                        is_in_page_list  INTEGER NOT NULL DEFAULT 0,
-                        template         TEXT,
-                        page_text        TEXT NOT NULL);
-                    CREATE INDEX page_web_log_idx   ON page (web_log_id);
-                    CREATE INDEX page_author_idx    ON page (author_id);
-                    CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
-                do! write cmd
-            match! tableExists "page_meta" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating page_meta table..."
-                cmd.CommandText <- """
-                    CREATE TABLE page_meta (
-                        page_id  TEXT NOT NULL REFERENCES page (id),
-                        name     TEXT NOT NULL,
-                        value    TEXT NOT NULL,
-                        PRIMARY KEY (page_id, name, value))"""
-                do! write cmd
-            match! tableExists "page_permalink" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating page_permalink table..."
-                cmd.CommandText <- """
-                    CREATE TABLE page_permalink (
-                        page_id    TEXT NOT NULL REFERENCES page (id),
-                        permalink  TEXT NOT NULL,
-                        PRIMARY KEY (page_id, permalink))"""
-                do! write cmd
-            match! tableExists "page_revision" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating page_revision table..."
-                cmd.CommandText <- """
-                    CREATE TABLE page_revision (
-                        page_id        TEXT NOT NULL REFERENCES page (id),
-                        as_of          TEXT NOT NULL,
-                        revision_text  TEXT NOT NULL,
-                        PRIMARY KEY (page_id, as_of))"""
-                do! write cmd
-            
-            // Post tables
-            match! tableExists "post" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post (
-                        id            TEXT PRIMARY KEY,
-                        web_log_id    TEXT NOT NULL REFERENCES web_log (id),
-                        author_id     TEXT NOT NULL REFERENCES web_log_user (id),
-                        status        TEXT NOT NULL,
-                        title         TEXT NOT NULL,
-                        permalink     TEXT NOT NULL,
-                        published_on  TEXT,
-                        updated_on    TEXT NOT NULL,
-                        template      TEXT,
-                        post_text     TEXT NOT NULL);
-                    CREATE INDEX post_web_log_idx   ON post (web_log_id);
-                    CREATE INDEX post_author_idx    ON post (author_id);
-                    CREATE INDEX post_status_idx    ON post (web_log_id, status, updated_on);
-                    CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
-                do! write cmd
-            match! tableExists "post_category" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_category table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_category (
-                        post_id      TEXT NOT NULL REFERENCES post (id),
-                        category_id  TEXT NOT NULL REFERENCES category (id),
-                        PRIMARY KEY (post_id, category_id));
-                    CREATE INDEX post_category_category_idx ON post_category (category_id)"""
-                do! write cmd
-            match! tableExists "post_episode" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_episode table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_episode (
-                        post_id              TEXT PRIMARY KEY REFERENCES post(id),
-                        media                TEXT NOT NULL,
-                        length               INTEGER NOT NULL,
-                        duration             TEXT,
-                        media_type           TEXT,
-                        image_url            TEXT,
-                        subtitle             TEXT,
-                        explicit             TEXT,
-                        chapter_file         TEXT,
-                        chapter_type         TEXT,
-                        transcript_url       TEXT,
-                        transcript_type      TEXT,
-                        transcript_lang      TEXT,
-                        transcript_captions  INTEGER,
-                        season_number        INTEGER,
-                        season_description   TEXT,
-                        episode_number       TEXT,
-                        episode_description  TEXT)"""
-                do! write cmd
-            match! tableExists "post_tag" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_tag table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_tag (
-                        post_id  TEXT NOT NULL REFERENCES post (id),
-                        tag      TEXT NOT NULL,
-                        PRIMARY KEY (post_id, tag))"""
-                do! write cmd
-            match! tableExists "post_meta" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_meta table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_meta (
-                        post_id  TEXT NOT NULL REFERENCES post (id),
-                        name     TEXT NOT NULL,
-                        value    TEXT NOT NULL,
-                        PRIMARY KEY (post_id, name, value))"""
-                do! write cmd
-            match! tableExists "post_permalink" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_permalink table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_permalink (
-                        post_id    TEXT NOT NULL REFERENCES post (id),
-                        permalink  TEXT NOT NULL,
-                        PRIMARY KEY (post_id, permalink))"""
-                do! write cmd
-            match! tableExists "post_revision" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_revision table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_revision (
-                        post_id        TEXT NOT NULL REFERENCES post (id),
-                        as_of          TEXT NOT NULL,
-                        revision_text  TEXT NOT NULL,
-                        PRIMARY KEY (post_id, as_of))"""
-                do! write cmd
-            match! tableExists "post_comment" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating post_comment table..."
-                cmd.CommandText <- """
-                    CREATE TABLE post_comment (
-                        id              TEXT PRIMARY KEY,
-                        post_id         TEXT NOT NULL REFERENCES post(id),
-                        in_reply_to_id  TEXT,
-                        name            TEXT NOT NULL,
-                        email           TEXT NOT NULL,
-                        url             TEXT,
-                        status          TEXT NOT NULL,
-                        posted_on       TEXT NOT NULL,
-                        comment_text    TEXT NOT NULL);
-                    CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
-                do! write cmd
-            
-            // Tag map table
-            match! tableExists "tag_map" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating tag_map table..."
-                cmd.CommandText <- """
-                    CREATE TABLE tag_map (
-                        id          TEXT PRIMARY KEY,
-                        web_log_id  TEXT NOT NULL REFERENCES web_log (id),
-                        tag         TEXT NOT NULL,
-                        url_value   TEXT NOT NULL);
-                    CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
-                do! write cmd
-            
-            // Uploaded file table
-            match! tableExists "upload" with
-            | true -> ()
-            | false ->
-                log.LogInformation "Creating upload table..."
-                cmd.CommandText <- """
-                    CREATE TABLE upload (
-                        id          TEXT PRIMARY KEY,
-                        web_log_id  TEXT NOT NULL REFERENCES web_log (id),
-                        path        TEXT NOT NULL,
-                        updated_on  TEXT NOT NULL,
-                        data        BLOB NOT NULL);
-                    CREATE INDEX upload_web_log_idx ON upload (web_log_id);
-                    CREATE INDEX upload_path_idx    ON upload (web_log_id, path)"""
-                do! write cmd
         }

src/MyWebLog.Data/Utils.fs

@@ -9,14 +9,72 @@ open MyWebLog.ViewModels
 let rec orderByHierarchy (cats: Category list) parentId slugBase parentNames = seq {
     for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do
         let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug
-        { Id          = CategoryId.toString cat.Id
+        { Id          = string cat.Id
           Slug        = fullSlug
           Name        = cat.Name
           Description = cat.Description
           ParentNames = Array.ofList parentNames
           // Post counts are filled on a second pass
-          PostCount   = 0
+          PostCount   = 0 }
-        }
         yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames)
 }
 
+/// Get lists of items removed from and added to the given lists
+let diffLists<'T, 'U when 'U: equality> oldItems newItems (f: 'T -> 'U) =
+    let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
+    List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
+
+/// Find the revisions added and removed
+let diffRevisions (oldRevs: Revision list) newRevs =
+    diffLists oldRevs newRevs (fun rev -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text}")
+
+open MyWebLog.Converters
+open Newtonsoft.Json
+
+/// Serialize an object to JSON
+let serialize<'T> ser (item: 'T) =
+    JsonConvert.SerializeObject(item, Json.settings ser)
+
+/// Deserialize a JSON string 
+let deserialize<'T> (ser: JsonSerializer) value =
+    JsonConvert.DeserializeObject<'T>(value, Json.settings ser)
+
+open BitBadger.Documents
+
+/// Create a document serializer using the given JsonSerializer
+let createDocumentSerializer ser =
+    { new IDocumentSerializer with
+        member _.Serialize<'T>(it: 'T) : string = serialize ser it
+        member _.Deserialize<'T>(it: string) : 'T = deserialize ser it
+    }
+
+/// Data migration utilities
+module Migration =
+    
+    open Microsoft.Extensions.Logging
+
+    /// The current database version
+    let currentDbVersion = "v2.1.1"
+
+    /// Log a migration step
+    let logStep<'T> (log: ILogger<'T>) migration message =
+        log.LogInformation $"Migrating %s{migration}: %s{message}"
+
+    /// Notify the user that a backup/restore
+    let backupAndRestoreRequired log oldVersion newVersion webLogs =
+        logStep log $"%s{oldVersion} to %s{newVersion}" "Requires Using Action"
+
+        [ "** MANUAL DATABASE UPGRADE REQUIRED **"; ""
+          $"The data structure changed between {oldVersion} and {newVersion}."
+          "To migrate your data:"
+          $" - Use a {oldVersion} executable to back up each web log"
+          " - Drop all tables from the database"
+          " - Use this executable to restore each backup"; ""
+          "Commands to back up all web logs:"
+          yield! webLogs |> List.map (fun (url, slug) -> $"./myWebLog backup %s{url} {oldVersion}.%s{slug}.json") ]
+        |> String.concat "\n"
+        |> log.LogWarning
+        
+        log.LogCritical "myWebLog will now exit"
+        exit 1 |> ignore
+        

src/MyWebLog.Domain/DataTypes.fs

@@ -1,12 +1,12 @@
 namespace MyWebLog
 
-open System
 open MyWebLog
+open NodaTime
 
 /// A category under which a post may be identified
 [<CLIMutable; NoComparison; NoEquality>]
-type Category =
+type Category = {
-    {   /// The ID of the category
+    /// The ID of the category
     Id: CategoryId
 
     /// The ID of the web log to which the category belongs
@@ -23,26 +23,22 @@ type Category =
 
     /// The parent ID of this category (if a subcategory)
     ParentId: CategoryId option
-    }
+} with
-
-/// Functions to support categories
-module Category =
     
     /// An empty category
-    let empty =
+    static member Empty =
-        {   Id          = CategoryId.empty
+        { Id          = CategoryId.Empty
-            WebLogId    = WebLogId.empty
+          WebLogId    = WebLogId.Empty
           Name        = ""
           Slug        = ""
           Description = None
-            ParentId    = None
+          ParentId    = None }
-        }
 
 
 /// A comment on a post
 [<CLIMutable; NoComparison; NoEquality>]
-type Comment =
+type Comment = {
-    {   /// The ID of the comment
+    /// The ID of the comment
     Id: CommentId
 
     /// The ID of the post to which this comment applies
@@ -64,33 +60,29 @@ type Comment =
     Status: CommentStatus
 
     /// When the comment was posted
-        PostedOn : DateTime
+    PostedOn: Instant
 
     /// The text of the comment
     Text: string
-    }
+} with
-
-/// Functions to support comments
-module Comment =
     
     /// An empty comment
-    let empty =
+    static member Empty =
-        {   Id          = CommentId.empty
+        { Id          = CommentId.Empty
-            PostId      = PostId.empty
+          PostId      = PostId.Empty
           InReplyToId = None
           Name        = ""
           Email       = ""
           Url         = None
           Status      = Pending
-            PostedOn    = DateTime.UtcNow
+          PostedOn    = Noda.epoch
-            Text        = ""
+          Text        = "" }
-        }
 
 
 /// A page (text not associated with a date/time)
 [<CLIMutable; NoComparison; NoEquality>]
-type Page =
+type Page = {
-    {   /// The ID of this page
+    /// The ID of this page
     Id: PageId
 
     /// The ID of the web log to which this page belongs
@@ -106,10 +98,10 @@ type Page =
     Permalink: Permalink
 
     /// When this page was published
-        PublishedOn : DateTime
+    PublishedOn: Instant
 
     /// When this page was last updated
-        UpdatedOn : DateTime
+    UpdatedOn: Instant
 
     /// Whether this page shows as part of the web log's navigation
     IsInPageList: bool
@@ -128,33 +120,29 @@ type Page =
 
     /// Revisions of this page
     Revisions: Revision list
-    }
+} with
-
-/// Functions to support pages
-module Page =
     
     /// An empty page
-    let empty =
+    static member Empty =
-        {   Id              = PageId.empty
+        { Id              = PageId.Empty
-            WebLogId        = WebLogId.empty
+          WebLogId        = WebLogId.Empty
-            AuthorId        = WebLogUserId.empty
+          AuthorId        = WebLogUserId.Empty
           Title           = ""
-            Permalink       = Permalink.empty
+          Permalink       = Permalink.Empty
-            PublishedOn     = DateTime.MinValue
+          PublishedOn     = Noda.epoch
-            UpdatedOn       = DateTime.MinValue
+          UpdatedOn       = Noda.epoch
           IsInPageList    = false
           Template        = None
           Text            = ""
           Metadata        = []
           PriorPermalinks = []
-            Revisions       = []
+          Revisions       = [] }
-        }
 
 
 /// A web log post
 [<CLIMutable; NoComparison; NoEquality>]
-type Post =
+type Post = {
-    {   /// The ID of this post
+    /// The ID of this post
     Id: PostId
 
     /// The ID of the web log to which this post belongs
@@ -173,10 +161,10 @@ type Post =
     Permalink: Permalink
 
     /// The instant on which the post was originally published
-        PublishedOn : DateTime option
+    PublishedOn: Instant option
 
     /// The instant on which the post was last updated
-        UpdatedOn : DateTime
+    UpdatedOn: Instant
 
     /// The template to use in displaying the post
     Template: string option
@@ -201,21 +189,18 @@ type Post =
 
     /// The revisions for this post
     Revisions: Revision list
-    }
+} with
-
-/// Functions to support posts
-module Post =
     
     /// An empty post
-    let empty =
+    static member Empty =
-        {   Id              = PostId.empty
+        { Id              = PostId.Empty
-            WebLogId        = WebLogId.empty
+          WebLogId        = WebLogId.Empty
-            AuthorId        = WebLogUserId.empty
+          AuthorId        = WebLogUserId.Empty
           Status          = Draft
           Title           = ""
-            Permalink       = Permalink.empty
+          Permalink       = Permalink.Empty
           PublishedOn     = None
-            UpdatedOn       = DateTime.MinValue
+          UpdatedOn       = Noda.epoch
           Text            = ""
           Template        = None
           CategoryIds     = []
@@ -223,13 +208,13 @@ module Post =
           Episode         = None
           Metadata        = []
           PriorPermalinks = []
-            Revisions       = []
+          Revisions       = [] }
-        }
 
 
 /// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1")
-type TagMap =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The ID of this tag mapping
+type TagMap = {
+    /// The ID of this tag mapping
     Id: TagMapId
     
     /// The ID of the web log to which this tag mapping belongs
@@ -240,23 +225,17 @@ type TagMap =
     
     /// The value by which the tag should be linked
     UrlValue: string
-    }
+} with
-
-/// Functions to support tag mappings
-module TagMap =
     
     /// An empty tag mapping
-    let empty =
+    static member Empty =
-        {   Id       = TagMapId.empty
+        { Id = TagMapId.Empty; WebLogId = WebLogId.Empty; Tag = ""; UrlValue = "" }
-            WebLogId = WebLogId.empty
-            Tag      = ""
-            UrlValue = ""
-        }
 
 
 /// A theme
-type Theme =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The ID / path of the theme
+type Theme = {
+    /// The ID / path of the theme
     Id: ThemeId
     
     /// A long name of the theme
@@ -267,47 +246,35 @@ type Theme =
     
     /// The templates for this theme
     Templates: ThemeTemplate list
-    }
+} with
-
-/// Functions to support themes
-module Theme =
     
     /// An empty theme
-    let empty =
+    static member Empty =
-        {   Id        = ThemeId ""
+        { Id = ThemeId.Empty; Name = ""; Version = ""; Templates = [] }
-            Name      = ""
-            Version   = ""
-            Templates = []
-        }
 
 
 /// A theme asset (a file served as part of a theme, at /themes/[theme]/[asset-path])
-type ThemeAsset =
+[<CLIMutable; NoComparison; NoEquality>]
-    {
+type ThemeAsset = {
     /// The ID of the asset (consists of theme and path)
     Id: ThemeAssetId
     
     /// The updated date (set from the file date from the ZIP archive)
-        UpdatedOn : DateTime
+    UpdatedOn: Instant
     
     /// The data for the asset
-        Data : byte[]
+    Data: byte array
-    }
+} with
-
-/// Functions to support theme assets
-module ThemeAsset =
     
     /// An empty theme asset
-    let empty =
+    static member Empty =
-        {   Id        = ThemeAssetId (ThemeId "", "")
+        { Id = ThemeAssetId.Empty; UpdatedOn = Noda.epoch; Data = [||] }
-            UpdatedOn = DateTime.MinValue
-            Data      = [||]
-        }
 
 
 /// An uploaded file
-type Upload =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The ID of the upload
+type Upload = {
+    /// The ID of the upload
     Id: UploadId
     
     /// The ID of the web log to which this upload belongs
@@ -317,29 +284,23 @@ type Upload =
     Path: Permalink
     
     /// The updated date/time for this upload
-        UpdatedOn : DateTime
+    UpdatedOn: Instant
     
     /// The data for the upload
-        Data : byte[]
+    Data: byte array
-    }
+} with
-
-/// Functions to support uploaded files
-module Upload =
     
     /// An empty upload
-    let empty =
+    static member Empty =
-        {   Id        = UploadId.empty
+        { Id = UploadId.Empty; WebLogId = WebLogId.Empty; Path = Permalink.Empty; UpdatedOn = Noda.epoch; Data = [||] }
-            WebLogId  = WebLogId.empty
-            Path      = Permalink.empty
-            UpdatedOn = DateTime.MinValue
-            Data      = [||]
-        }
 
 
+open Newtonsoft.Json
+
 /// A web log
 [<CLIMutable; NoComparison; NoEquality>]
-type WebLog =
+type WebLog = {
-    {   /// The ID of the web log
+    /// The ID of the web log
     Id: WebLogId
 
     /// The name of the web log
@@ -374,14 +335,14 @@ type WebLog =
     
     /// Where uploads are placed
     Uploads: UploadDestination
-    }
 
-/// Functions to support web logs
+    /// Redirect rules for this weblog
-module WebLog =
+    RedirectRules: RedirectRule list
+} with
     
     /// An empty web log
-    let empty =
+    static member Empty =
-        {   Id           = WebLogId.empty
+        { Id            = WebLogId.Empty
           Name          = ""
           Slug          = ""
           Subtitle      = None
@@ -390,36 +351,41 @@ module WebLog =
           ThemeId       = ThemeId "default"
           UrlBase       = ""
           TimeZone      = ""
-            Rss          = RssOptions.empty
+          Rss           = RssOptions.Empty
           AutoHtmx      = false
           Uploads       = Database
-        }
+          RedirectRules = [] }
     
-    /// Get the host (including scheme) and extra path from the URL base
+    /// Any extra path where this web log is hosted (blank if web log is hosted at the root of the domain)
-    let hostAndPath webLog =
+    [<JsonIgnore>]
-        let scheme = webLog.UrlBase.Split "://"
+    member this.ExtraPath =
-        let host   = scheme[1].Split "/"
+        let pathParts = this.UrlBase.Split "://"
-        $"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join ("/", host |> Array.skip 1)}""" else ""
+        if pathParts.Length < 2 then
+            ""
+        else
+            let path = pathParts[1].Split "/"
+            if path.Length > 1 then $"""/{path |> Array.skip 1 |> String.concat "/"}""" else ""
     
     /// Generate an absolute URL for the given link
-    let absoluteUrl webLog permalink =
+    member this.AbsoluteUrl(permalink: Permalink) =
-        $"{webLog.UrlBase}/{Permalink.toString permalink}"
+        $"{this.UrlBase}/{permalink}"
     
     /// Generate a relative URL for the given link
-    let relativeUrl webLog permalink =
+    member this.RelativeUrl(permalink: Permalink) =
-        let _, leadPath = hostAndPath webLog
+        $"{this.ExtraPath}/{permalink}"
-        $"{leadPath}/{Permalink.toString permalink}"
     
-    /// Convert a UTC date/time to the web log's local date/time
+    /// Convert an Instant (UTC reference) to the web log's local date/time
-    let localTime webLog (date : DateTime) =
+    member this.LocalTime(date: Instant) =
-        TimeZoneInfo.ConvertTimeFromUtc
+        DateTimeZoneProviders.Tzdb.GetZoneOrNull this.TimeZone
-            (DateTime (date.Ticks, DateTimeKind.Utc), TimeZoneInfo.FindSystemTimeZoneById webLog.TimeZone) 
+        |> Option.ofObj
+        |> Option.map (fun tz -> date.InZone(tz).ToDateTimeUnspecified())
+        |> Option.defaultValue (date.ToDateTimeUtc())
 
 
 /// A user of the web log
 [<CLIMutable; NoComparison; NoEquality>]
-type WebLogUser =
+type WebLogUser = {
-    {   /// The ID of the user
+    /// The ID of the user
     Id: WebLogUserId
 
     /// The ID of the web log to which this user belongs
@@ -440,9 +406,6 @@ type WebLogUser =
     /// The hash of the user's password
     PasswordHash: string
 
-        /// Salt used to calculate the user's password hash
-        Salt : Guid
-
     /// The URL of the user's personal site
     Url: string option
 
@@ -450,38 +413,28 @@ type WebLogUser =
     AccessLevel: AccessLevel
     
     /// When the user was created
-        CreatedOn : DateTime
+    CreatedOn: Instant
     
     /// When the user last logged on
-        LastSeenOn : DateTime option
+    LastSeenOn: Instant option
-    }
+} with
-
-/// Functions to support web log users
-module WebLogUser =
     
     /// An empty web log user
-    let empty =
+    static member Empty =
-        {   Id            = WebLogUserId.empty
+        { Id            = WebLogUserId.Empty
-            WebLogId      = WebLogId.empty
+          WebLogId      = WebLogId.Empty
           Email         = ""
           FirstName     = ""
           LastName      = ""
           PreferredName = ""
           PasswordHash  = ""
-            Salt          = Guid.Empty
           Url           = None
           AccessLevel   = Author
-            CreatedOn     = DateTime.UnixEpoch
+          CreatedOn     = Noda.epoch
-            LastSeenOn    = None
+          LastSeenOn    = None }
-        }
     
     /// Get the user's displayed name
-    let displayName user =
+    [<JsonIgnore>]
-        let name =
+    member this.DisplayName =
-            seq { match user.PreferredName with "" -> user.FirstName | n -> n; " "; user.LastName }
+        (seq { (match this.PreferredName with "" -> this.FirstName | n -> n); " "; this.LastName }
-            |> Seq.reduce (+)
+         |> Seq.reduce (+)).Trim()
-        name.Trim ()
-    
-    /// Does a user have the required access level?
-    let hasAccess level user =
-        AccessLevel.hasAccess level user.AccessLevel

src/MyWebLog.Domain/MyWebLog.Domain.fsproj

@@ -1,11 +1,5 @@
 <Project Sdk="Microsoft.NET.Sdk">
 
-  <PropertyGroup>
-    <TargetFramework>net6.0</TargetFramework>
-    <GenerateDocumentationFile>true</GenerateDocumentationFile>
-    <DebugType>embedded</DebugType>
-  </PropertyGroup>
-
   <ItemGroup>
     <Compile Include="SupportTypes.fs" />
     <Compile Include="DataTypes.fs" />
@@ -13,9 +7,11 @@
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="Markdig" Version="0.30.2" />
+    <PackageReference Include="Markdig" Version="0.36.2" />
-    <PackageReference Update="FSharp.Core" Version="6.0.5" />
+    <PackageReference Include="Markdown.ColorCode" Version="2.2.1" />
-    <PackageReference Include="Markdown.ColorCode" Version="1.0.1" />
+    <PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
+    <PackageReference Include="NodaTime" Version="3.1.11" />
+    <PackageReference Update="FSharp.Core" Version="8.0.200" />
   </ItemGroup>
 
 </Project>

src/MyWebLog.Domain/SupportTypes.fs

@@ -1,18 +1,48 @@
 namespace MyWebLog
 
 open System
+open Markdig
+open NodaTime
 
 /// Support functions for domain definition
 [<AutoOpen>]
 module private Helpers =
 
+    open Markdown.ColorCode
+
     /// Create a new ID (short GUID)
     // https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
     let newId () =
-        Convert.ToBase64String(Guid.NewGuid().ToByteArray ()).Replace('/', '_').Replace('+', '-').Substring (0, 22)
+        Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..21]
+    
+    /// Pipeline with most extensions enabled
+    let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build()
+
+
+/// Functions to support NodaTime manipulation
+module Noda =
+    
+    /// The clock to use when getting "now" (will make mutable for testing)
+    let clock: IClock = SystemClock.Instance
+    
+    /// The Unix epoch
+    let epoch = Instant.FromUnixTimeSeconds 0L
+        
+    /// Truncate an instant to remove fractional seconds
+    let toSecondsPrecision (value: Instant) =
+        Instant.FromUnixTimeSeconds(value.ToUnixTimeSeconds())
+    
+    /// The current Instant, with fractional seconds truncated
+    let now =
+        clock.GetCurrentInstant >> toSecondsPrecision
+    
+    /// Convert a date/time to an Instant with whole seconds
+    let fromDateTime (dt: DateTime) =
+        Instant.FromDateTimeUtc(DateTime(dt.Ticks, DateTimeKind.Utc)) |> toSecondsPrecision
 
 
 /// A user's access level
+[<Struct>]
 type AccessLevel =
     /// The user may create and publish posts and edit the ones they have created
     | Author
@@ -23,73 +53,70 @@ type AccessLevel =
     /// The user may manage themes (which affects all web logs for an installation)
     | Administrator
     
-/// Functions to support access levels
+    /// Parse an access level from its string representation
-module AccessLevel =
+    static member Parse level =
+        match level with
+        | "Author" -> Author
+        | "Editor" -> Editor
+        | "WebLogAdmin" -> WebLogAdmin
+        | "Administrator" -> Administrator
+        | _ -> invalidArg (nameof level) $"{level} is not a valid access level"
 
-    /// Weightings for access levels
+    /// The string representation of this access level
-    let private weights =
+    override this.ToString() =
-        [   Author,        10
+        match this with
-            Editor,        20
-            WebLogAdmin,   30
-            Administrator, 40
-        ]
-        |> Map.ofList
-    
-    /// Convert an access level to its string representation
-    let toString =
-        function
         | Author -> "Author"
         | Editor -> "Editor"
         | WebLogAdmin -> "WebLogAdmin"
         | Administrator -> "Administrator"
     
-    /// Parse an access level from its string representation
-    let parse it =
-        match it with
-        | "Author"        -> Author
-        | "Editor"        -> Editor
-        | "WebLogAdmin"   -> WebLogAdmin
-        | "Administrator" -> Administrator
-        | _               -> invalidOp $"{it} is not a valid access level"
-    
     /// Does a given access level allow an action that requires a certain access level?
-    let hasAccess needed held =
+    member this.HasAccess(needed: AccessLevel) =
-        weights[needed] <= weights[held]
+        let weights =
+            [   Author, 10
+                Editor, 20
+                WebLogAdmin, 30
+                Administrator, 40 ]
+            |> Map.ofList
+        weights[needed] <= weights[this]
 
 
 /// An identifier for a category
-type CategoryId = CategoryId of string
+[<Struct>]
-
+type CategoryId =
-/// Functions to support category IDs
+    | CategoryId of string
-module CategoryId =
     
     /// An empty category ID
-    let empty = CategoryId ""
+    static member Empty = CategoryId ""
-
-    /// Convert a category ID to a string
-    let toString = function CategoryId ci -> ci
     
     /// Create a new category ID
-    let create () = CategoryId (newId ())
+    static member Create =
+        newId >> CategoryId
+
+    /// The string representation of this category ID
+    override this.ToString() =
+        match this with CategoryId it -> it
 
 
 /// An identifier for a comment
-type CommentId = CommentId of string
+[<Struct>]
-
+type CommentId =
-/// Functions to support comment IDs
+    | CommentId of string
-module CommentId =
     
     /// An empty comment ID
-    let empty = CommentId ""
+    static member Empty = CommentId ""
-
-    /// Convert a comment ID to a string
-    let toString = function CommentId ci -> ci
     
     /// Create a new comment ID
-    let create () = CommentId (newId ())
+    static member Create =
+        newId >> CommentId
+
+    /// The string representation of this comment ID
+    override this.ToString() =
+        match this with CommentId it -> it
 
 
 /// Statuses for post comments
+[<Struct>]
 type CommentStatus =
     /// The comment is approved
     | Approved
@@ -98,55 +125,99 @@ type CommentStatus =
     /// The comment was unsolicited and unwelcome
     | Spam
 
-/// Functions to support post comment statuses
-module CommentStatus =
-    
-    /// Convert a comment status to a string
-    let toString = function Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
-    
     /// Parse a string into a comment status
-    let parse value =
+    static member Parse status =
-        match value with
+        match status with
         | "Approved" -> Approved
         | "Pending" -> Pending
         | "Spam" -> Spam
-        | it         -> invalidOp $"{it} is not a valid post status"
+        | _ -> invalidArg (nameof status) $"{status} is not a valid comment status"
+
+    /// Convert a comment status to a string
+    override this.ToString() =
+        match this with Approved -> "Approved" | Pending -> "Pending" | Spam -> "Spam"
 
 
 /// Valid values for the iTunes explicit rating
+[<Struct>]
 type ExplicitRating =
     | Yes
     | No
     | Clean
     
-/// Functions to support iTunes explicit ratings
-module ExplicitRating =
-    /// Convert an explicit rating to a string
-    let toString : ExplicitRating -> string =
-        function
-        | Yes   -> "yes"
-        | No    -> "no"
-        | Clean -> "clean"
-    
     /// Parse a string into an explicit rating
-    let parse : string -> ExplicitRating =
+    static member Parse rating =
-        function
+        match rating with
         | "yes" -> Yes
         | "no" -> No
         | "clean" -> Clean
-        | x       -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
+        | _ -> invalidArg (nameof rating) $"{rating} is not a valid explicit rating"
     
+    /// The string value of this rating
+    override this.ToString() =
+        match this with Yes -> "yes" | No -> "no" | Clean -> "clean"
+
+
+/// A location (specified by Podcast Index)
+type Location = {
+    /// The name of the location (free-form text)
+    Name: string
+
+    /// A geographic coordinate string (RFC 5870)
+    Geo: string
+
+    /// An OpenStreetMap query
+    Osm: string option
+}
+
+
+/// A chapter in a podcast episode
+type Chapter = {
+    /// The start time for the chapter
+    StartTime: Duration
+
+    /// The title for this chapter
+    Title: string option
+
+    /// A URL for an image for this chapter
+    ImageUrl: string option
+
+    /// A URL with information pertaining to this chapter
+    Url: string option
+
+    /// Whether this chapter is hidden
+    IsHidden: bool option
+
+    /// The episode end time for the chapter
+    EndTime: Duration option
+
+    /// A location that applies to a chapter
+    Location: Location option
+} with
+    
+    /// An empty chapter
+    static member Empty =
+        { StartTime = Duration.Zero
+          Title     = None
+          ImageUrl  = None
+          Url       = None
+          IsHidden  = None
+          EndTime   = None
+          Location  = None }
+
+
+open NodaTime.Text
 
 /// A podcast episode
-type Episode =
+type Episode = {
-    {   /// The URL to the media file for the episode (may be permalink)
+    /// The URL to the media file for the episode (may be permalink)
     Media: string
     
     /// The length of the media file, in bytes
     Length: int64
     
     /// The duration of the episode
-        Duration : TimeSpan option
+    Duration: Duration option
     
     /// The media type of the file (overrides podcast default if present)
     MediaType: string option
@@ -160,12 +231,18 @@ type Episode =
     /// This episode's explicit rating (overrides podcast rating if present)
     Explicit: ExplicitRating option
     
+    /// Chapters for this episode
+    Chapters: Chapter list option
+
     /// A link to a chapter file
     ChapterFile: string option
     
     /// The MIME type for the chapter file
     ChapterType: string option
     
+    /// Whether the chapters have locations that should be displayed as waypoints
+    ChapterWaypoints: bool option
+    
     /// The URL for the transcript of the episode (may be permalink)
     TranscriptUrl: string option
     
@@ -189,13 +266,10 @@ type Episode =
     
     /// A description of the episode
     EpisodeDescription: string option
-    }
+} with
-
-/// Functions to support episodes
-module Episode =
     
     /// An empty episode
-    let empty =
+    static member Empty =
         { Media              = ""
           Length             = 0L
           Duration           = None
@@ -203,8 +277,10 @@ module Episode =
           ImageUrl           = None
           Subtitle           = None
           Explicit           = None
+          Chapters           = None
           ChapterFile        = None
           ChapterType        = None
+          ChapterWaypoints   = None 
           TranscriptUrl      = None
           TranscriptType     = None
           TranscriptLang     = None
@@ -212,12 +288,12 @@ module Episode =
           SeasonNumber       = None
           SeasonDescription  = None
           EpisodeNumber      = None
-            EpisodeDescription = None
+          EpisodeDescription = None }
-        }
     
+    /// Format a duration for an episode
+    member this.FormatDuration() =
+        this.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
 
-open Markdig
-open Markdown.ColorCode
 
 /// Types of markup text
 type MarkupText =
@@ -226,100 +302,92 @@ type MarkupText =
     /// HTML text
     | Html of string
 
-/// Functions to support markup text
-module MarkupText =
-    
-    /// Pipeline with most extensions enabled
-    let private _pipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().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) =
+    static member Parse(text: string) =
-        match it with
+        match text with
-        | text when text.StartsWith "Markdown: " -> Markdown (text.Substring 10)
+        | _ when text.StartsWith "Markdown: " -> Markdown text[10..]
-        | text when text.StartsWith "HTML: " -> Html (text.Substring 6)
+        | _ when text.StartsWith "HTML: " -> Html text[6..]
-        | text -> invalidOp $"Cannot derive type of text ({text})"
+        | _ -> invalidArg (nameof text) $"Cannot derive type of text ({text})"
+    
+    /// The source type for the markup text
+    member this.SourceType =
+        match this with Markdown _ -> "Markdown" | Html _ -> "HTML"
+
+    /// The raw text, regardless of type
+    member this.Text =
+        match this with Markdown text -> text | Html text -> text
+    
+    /// The string representation of the markup text
+    override this.ToString() =
+        $"{this.SourceType}: {this.Text}"
+    
+    /// The HTML representation of the markup text
+    member this.AsHtml() =
+        match this with Markdown text -> Markdown.ToHtml(text, markdownPipeline) | Html text -> text
 
 
 /// An item of metadata
-[<CLIMutable; NoComparison; NoEquality>]
+[<CLIMutable>]
-type MetaItem =
+type MetaItem = {
-    {   /// The name of the metadata value
+    /// The name of the metadata value
     Name: string
     
     /// The metadata value
     Value: string
-    }
+} with
-
-/// Functions to support metadata items
-module MetaItem =
     
     /// An empty metadata item
-    let empty =
+    static member Empty =
         { Name = ""; Value = "" }
 
 
 /// A revision of a page or post
-[<CLIMutable; NoComparison; NoEquality>]
+[<CLIMutable>]
-type Revision =
+type Revision = {
-    {   /// When this revision was saved
+    /// When this revision was saved
-        AsOf : DateTime
+    AsOf: Instant
 
     /// The text of the revision
     Text: MarkupText
-    }
+} with
-
-/// Functions to support revisions
-module Revision =
     
     /// An empty revision
-    let empty =
+    static member Empty =
-        {   AsOf = DateTime.UtcNow
+        { AsOf = Noda.epoch; Text = Html "" }
-            Text = Html ""
-        }
 
 
 /// A permanent link
-type Permalink = Permalink of string
+[<Struct>]
-
+type Permalink =
-/// Functions to support permalinks
+    | Permalink of string
-module Permalink =
 
     /// An empty permalink
-    let empty = Permalink ""
+    static member Empty = Permalink ""
     
-    /// Convert a permalink to a string
+    /// The string value of this permalink
-    let toString = function Permalink p -> p
+    override this.ToString() =
+        match this with Permalink it -> it
 
 
 /// An identifier for a page
-type PageId = PageId of string
+[<Struct>]
-
+type PageId =
-/// Functions to support page IDs
+    | PageId of string
-module PageId =
 
     /// An empty page ID
-    let empty = PageId ""
+    static member Empty = PageId ""
-
-    /// Convert a page ID to a string
-    let toString = function PageId pi -> pi
     
     /// Create a new page ID
-    let create () = PageId (newId ())
+    static member Create =
+        newId >> PageId
+    
+    /// The string value of this page ID
+    override this.ToString() =
+        match this with PageId it -> it
 
 
 /// PodcastIndex.org podcast:medium allowed values
+[<Struct>]
 type PodcastMedium =
     | Podcast
     | Music
@@ -329,12 +397,21 @@ type PodcastMedium =
     | Newsletter
     | Blog
 
-/// Functions to support podcast medium
+    /// Parse a string into a podcast medium
-module PodcastMedium =
+    static member Parse medium =
+        match medium with
+        | "podcast" -> Podcast
+        | "music" -> Music
+        | "video" -> Video
+        | "film" -> Film
+        | "audiobook" -> Audiobook
+        | "newsletter" -> Newsletter
+        | "blog" -> Blog
+        | _ -> invalidArg (nameof medium) $"{medium} is not a valid podcast medium"
     
-    /// Convert a podcast medium to a string
+    /// The string value of this podcast medium
-    let toString =
+    override this.ToString() =
-        function
+        match this with
         | Podcast -> "podcast"
         | Music -> "music"
         | Video -> "video"
@@ -343,70 +420,77 @@ module PodcastMedium =
         | Newsletter -> "newsletter"
         | Blog -> "blog"
 
-    /// Parse a string into a podcast medium
-    let parse value =
-        match value with
-        | "podcast"    -> Podcast
-        | "music"      -> Music
-        | "video"      -> Video
-        | "film"       -> Film
-        | "audiobook"  -> Audiobook
-        | "newsletter" -> Newsletter
-        | "blog"       -> Blog
-        | it           -> invalidOp $"{it} is not a valid podcast medium"
-
 
 /// Statuses for posts
+[<Struct>]
 type PostStatus =
     /// The post should not be publicly available
     | Draft
     /// The post is publicly viewable
     | Published
 
-/// Functions to support post statuses
-module PostStatus =
-    
-    /// Convert a post status to a string
-    let toString = function Draft -> "Draft" | Published -> "Published"
-    
     /// Parse a string into a post status
-    let parse value =
+    static member Parse status =
-        match value with
+        match status with
         | "Draft" -> Draft
         | "Published" -> Published
-        | it          -> invalidOp $"{it} is not a valid post status"
+        | _ -> invalidArg (nameof status) $"{status} is not a valid post status"
+    
+    /// The string representation of this post status
+    override this.ToString() =
+        match this with Draft -> "Draft" | Published -> "Published"
 
 
 /// An identifier for a post
-type PostId = PostId of string
+[<Struct>]
-
+type PostId =
-/// Functions to support post IDs
+    | PostId of string
-module PostId =
 
     /// An empty post ID
-    let empty = PostId ""
+    static member Empty = PostId ""
-
-    /// Convert a post ID to a string
-    let toString = function PostId pi -> pi
     
     /// Create a new post ID
-    let create () = PostId (newId ())
+    static member Create =
+        newId >> PostId
+    
+    /// Convert a post ID to a string
+    override this.ToString() =
+        match this with PostId it -> it
+
+
+/// A redirection for a previously valid URL
+[<CLIMutable>]
+type RedirectRule = {
+    /// The From string or pattern
+    From: string
+    
+    /// The To string or pattern
+    To: string
+    
+    /// Whether to use regular expressions on this rule
+    IsRegex: bool
+} with
+    
+    /// An empty redirect rule
+    static member Empty =
+        { From = ""; To = ""; IsRegex = false }
 
 
 /// An identifier for a custom feed
-type CustomFeedId = CustomFeedId of string
+[<Struct>]
-
+type CustomFeedId =
-/// Functions to support custom feed IDs
+    | CustomFeedId of string
-module CustomFeedId =
 
     /// An empty custom feed ID
-    let empty = CustomFeedId ""
+    static member Empty = CustomFeedId ""
-
-    /// Convert a custom feed ID to a string
-    let toString = function CustomFeedId pi -> pi
     
     /// Create a new custom feed ID
-    let create () = CustomFeedId (newId ())
+    static member Create =
+        newId >> CustomFeedId
+    
+    /// Convert a custom feed ID to a string
+    override this.ToString() =
+        match this with CustomFeedId it -> it
 
 
 /// The source for a custom feed
@@ -416,26 +500,23 @@ type CustomFeedSource =
     /// A feed based on a particular tag
     | Tag of string
     
-/// Functions to support feed sources
-module CustomFeedSource =
-    /// Create a string version of a feed source
-    let toString : CustomFeedSource -> string =
-        function
-        | Category (CategoryId catId) -> $"category:{catId}"
-        | Tag tag -> $"tag:{tag}"
-    
     /// Parse a feed source from its string version
-    let parse : string -> CustomFeedSource =
+    static member Parse(source: string) =
         let value (it : string) = it.Split(":").[1]
-        function
+        match source with
-        | source when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
+        | _ when source.StartsWith "category:" -> (value >> CategoryId >> Category) source
-        | source when source.StartsWith "tag:"      -> (value >> Tag) source
+        | _ when source.StartsWith "tag:"      -> (value >> Tag) source
-        | source -> invalidArg "feedSource" $"{source} is not a valid feed source"
+        | _ -> invalidArg (nameof source) $"{source} is not a valid feed source"
+    
+    /// Create a string version of a feed source
+    override this.ToString() =
+        match this with | Category (CategoryId catId) -> $"category:{catId}" | Tag tag -> $"tag:{tag}"
 
 
 /// Options for a feed that describes a podcast
-type PodcastOptions =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The title of the podcast
+type PodcastOptions = {
+    /// The title of the podcast
     Title: string
     
     /// A subtitle for the podcast
@@ -482,12 +563,32 @@ type PodcastOptions =
     
     /// The medium (what the podcast IS, not what it is ABOUT)
     Medium: PodcastMedium option
-    }
+} with
+    
+    /// A default set of podcast options
+    static member Empty =
+        { Title            = ""
+          Subtitle         = None
+          ItemsInFeed      = 0
+          Summary          = ""
+          DisplayedAuthor  = ""
+          Email            = ""
+          ImageUrl         = Permalink.Empty
+          AppleCategory    = ""
+          AppleSubcategory = None
+          Explicit         = No
+          DefaultMediaType = None
+          MediaBaseUrl     = None
+          PodcastGuid      = None
+          FundingUrl       = None
+          FundingText      = None
+          Medium           = None }
 
 
 /// A custom feed
-type CustomFeed =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The ID of the custom feed
+type CustomFeed = {
+    /// The ID of the custom feed
     Id: CustomFeedId
     
     /// The source for the custom feed
@@ -498,24 +599,20 @@ type CustomFeed =
     
     /// Podcast options, if the feed defines a podcast
     Podcast: PodcastOptions option
-    }
+} with
-
-/// Functions to support custom feeds
-module CustomFeed =
     
     /// An empty custom feed
-    let empty =
+    static member Empty =
-        {   Id      = CustomFeedId ""
+        { Id      = CustomFeedId.Empty
-            Source  = Category (CategoryId "")
+          Source  = Category CategoryId.Empty
-            Path    = Permalink ""
+          Path    = Permalink.Empty
-            Podcast = None
+          Podcast = None }
-        }
 
 
 /// Really Simple Syndication (RSS) options for this web log
 [<CLIMutable; NoComparison; NoEquality>]
-type RssOptions =
+type RssOptions = {
-    {   /// Whether the site feed of posts is enabled
+    /// Whether the site feed of posts is enabled
     IsFeedEnabled: bool
     
     /// The name of the file generated for the site feed
@@ -535,146 +632,149 @@ type RssOptions =
     
     /// Custom feeds for this web log
     CustomFeeds: CustomFeed list
-    }
+} with
-
-/// Functions to support RSS options
-module RssOptions =
     
     /// An empty set of RSS options
-    let empty =
+    static member Empty =
         { IsFeedEnabled     = true
           FeedName          = "feed.xml"
           ItemsInFeed       = None
           IsCategoryEnabled = true
           IsTagEnabled      = true
           Copyright         = None
-            CustomFeeds       = []
+          CustomFeeds       = [] }
-        }
 
 
 /// An identifier for a tag mapping
-type TagMapId = TagMapId of string
+[<Struct>]
-
+type TagMapId =
-/// Functions to support tag mapping IDs
+    | TagMapId of string
-module TagMapId =
 
     /// An empty tag mapping ID
-    let empty = TagMapId ""
+    static member Empty = TagMapId ""
-    
-    /// Convert a tag mapping ID to a string
-    let toString = function TagMapId tmi -> tmi
     
     /// Create a new tag mapping ID
-    let create () = TagMapId (newId ())
+    static member Create =
+        newId >> TagMapId
+    
+    /// Convert a tag mapping ID to a string
+    override this.ToString() =
+        match this with TagMapId it -> it
 
 
 /// An identifier for a theme (represents its path)
-type ThemeId = ThemeId of string
+[<Struct>]
+type ThemeId =
+    | ThemeId of string
     
-/// Functions to support theme IDs
+    /// An empty theme ID
-module ThemeId =
+    static member Empty = ThemeId ""
-    let toString = function ThemeId ti -> ti
+    
+    /// The string representation of a theme ID
+    override this.ToString() =
+        match this with ThemeId it -> it
 
 
 /// An identifier for a theme asset
-type ThemeAssetId = ThemeAssetId of ThemeId * string
+[<Struct>]
+type ThemeAssetId =
+    | ThemeAssetId of ThemeId * string
 
-/// Functions to support theme asset IDs
+    /// An empty theme asset ID
-module ThemeAssetId =
+    static member Empty = ThemeAssetId(ThemeId.Empty, "")
-    
-    /// Convert a theme asset ID into a path string
-    let toString =  function ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}"
     
     /// Convert a string into a theme asset ID
-    let ofString (it : string) =
+    static member Parse(it : string) =
         let themeIdx = it.IndexOf "/"
+        if themeIdx < 0 then
+            invalidArg "id" $"Invalid format; expected [theme_id]/[asset_id] (received {it})"
+        else
             ThemeAssetId(ThemeId it[..(themeIdx - 1)], it[(themeIdx + 1)..])
     
+    /// Convert a theme asset ID into a path string
+    override this.ToString() =
+        match this with ThemeAssetId (ThemeId theme, asset) -> $"{theme}/{asset}"
+
 
 /// A template for a theme
-type ThemeTemplate =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The name of the template
+type ThemeTemplate = {
+    /// The name of the template
     Name: string
     
     /// The text of the template
     Text: string
-    }
+} with
-
-/// Functions to support theme templates
-module ThemeTemplate =
     
     /// An empty theme template
-    let empty =
+    static member Empty =
-        {   Name = ""
+        { Name = ""; Text = "" }
-            Text = ""
-        }
 
 
 /// Where uploads should be placed
+[<Struct>]
 type UploadDestination =
     | Database
     | Disk
 
-/// Functions to support upload destinations
-module UploadDestination =
-    
-    /// Convert an upload destination to its string representation
-    let toString = function Database -> "Database" | Disk -> "Disk"
-    
     /// Parse an upload destination from its string representation
-    let parse value =
+    static member Parse destination =
-        match value with
+        match destination with
         | "Database" -> Database
         | "Disk" -> Disk
-        | it         -> invalidOp $"{it} is not a valid upload destination"
+        | _ -> invalidArg (nameof destination) $"{destination} is not a valid upload destination"
+    
+    /// The string representation of an upload destination
+    override this.ToString() =
+        match this with Database -> "Database" | Disk -> "Disk"
 
 
 /// An identifier for an upload
-type UploadId = UploadId of string
+[<Struct>]
-
+type UploadId =
-/// Functions to support upload IDs
+    | UploadId of string
-module UploadId =
 
     /// An empty upload ID
-    let empty = UploadId ""
+    static member Empty = UploadId ""
-    
-    /// Convert an upload ID to a string
-    let toString = function UploadId ui -> ui
     
     /// Create a new upload ID
-    let create () = UploadId (newId ())
+    static member Create =
+        newId >> UploadId
+    
+    /// The string representation of an upload ID
+    override this.ToString() =
+        match this with UploadId it -> it
 
 
 /// An identifier for a web log
-type WebLogId = WebLogId of string
+[<Struct>]
-
+type WebLogId =
-/// Functions to support web log IDs
+    | WebLogId of string
-module WebLogId =
 
     /// An empty web log ID
-    let empty = WebLogId ""
+    static member Empty = WebLogId ""
-
-    /// Convert a web log ID to a string
-    let toString = function WebLogId wli -> wli
     
     /// Create a new web log ID
-    let create () = WebLogId (newId ())
+    static member Create =
+        newId >> WebLogId
     
+    /// Convert a web log ID to a string
+    override this.ToString() =
+        match this with WebLogId it -> it
 
 
 /// An identifier for a web log user
-type WebLogUserId = WebLogUserId of string
+[<Struct>]
-
+type WebLogUserId =
-/// Functions to support web log user IDs
+    | WebLogUserId of string
-module WebLogUserId =
     
     /// An empty web log user ID
-    let empty = WebLogUserId ""
+    static member Empty = WebLogUserId ""
-
-    /// Convert a web log user ID to a string
-    let toString = function WebLogUserId wli -> wli
     
     /// Create a new web log user ID
-    let create () = WebLogUserId (newId ())
+    static member Create =
-
+        newId >> WebLogUserId
     
+    /// The string representation of a web log user ID
+    override this.ToString() =
+        match this with WebLogUserId it -> it

src/MyWebLog.Tests/Data/CategoryDataTests.fs

@@ -0,0 +1,150 @@
+/// <summary>
+/// Integration tests for <see cref="ICategoryData" /> implementations
+/// </summary> 
+module CategoryDataTests
+
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+
+/// The ID of the root web log
+let rootId = WebLogId "uSitJEuD3UyzWC9jgOHc8g"
+
+/// The ID of the Favorites category
+let private favoritesId = CategoryId "S5JflPsJ9EG7gA2LD4m92A"
+
+let ``Add succeeds`` (data: IData) = task {
+    let category =
+        { Category.Empty with Id = CategoryId "added-cat"; WebLogId = WebLogId "test"; Name = "Added"; Slug = "added" }
+    do! data.Category.Add category 
+    let! stored = data.Category.FindById (CategoryId "added-cat") (WebLogId "test")
+    Expect.isSome stored "The category should have been added"
+}
+
+let ``CountAll succeeds when categories exist`` (data: IData) = task {
+    let! count = data.Category.CountAll rootId
+    Expect.equal count 3 "There should have been 3 categories"
+}
+
+let ``CountAll succeeds when categories do not exist`` (data: IData) = task {
+    let! count = data.Category.CountAll WebLogId.Empty
+    Expect.equal count 0 "There should have been no categories"
+}
+
+let ``CountTopLevel succeeds when top-level categories exist`` (data: IData) = task {
+    let! count = data.Category.CountTopLevel rootId
+    Expect.equal count 2 "There should have been 2 top-level categories"
+}
+
+let ``CountTopLevel succeeds when no top-level categories exist`` (data: IData) = task {
+    let! count = data.Category.CountTopLevel WebLogId.Empty
+    Expect.equal count 0 "There should have been no top-level categories"
+}
+
+let ``FindAllForView succeeds`` (data: IData) = task {
+    let! all = data.Category.FindAllForView rootId
+    Expect.equal all.Length 3 "There should have been 3 categories returned"
+    Expect.equal all[0].Name "Favorites" "The first category is incorrect"
+    Expect.equal all[0].PostCount 1 "There should be one post in this category"
+    Expect.equal all[1].Name "Spitball" "The second category is incorrect"
+    Expect.equal all[1].PostCount 2 "There should be two posts in this category"
+    Expect.equal all[2].Name "Moonshot" "The third category is incorrect"
+    Expect.equal all[2].PostCount 1 "There should be one post in this category"
+}
+
+let ``FindById succeeds when a category is found`` (data: IData) = task {
+    let! cat = data.Category.FindById favoritesId rootId
+    Expect.isSome cat "There should have been a category returned"
+    Expect.equal cat.Value.Name "Favorites" "The category retrieved is incorrect"
+    Expect.equal cat.Value.Slug "favorites" "The slug is incorrect"
+    Expect.equal cat.Value.Description (Some "Favorite posts") "The description is incorrect"
+    Expect.isNone cat.Value.ParentId "There should have been no parent ID"
+}
+
+let ``FindById succeeds when a category is not found`` (data: IData) = task {
+    let! cat = data.Category.FindById CategoryId.Empty rootId
+    Expect.isNone cat "There should not have been a category returned"
+}
+
+let ``FindByWebLog succeeds when categories exist`` (data: IData) = task {
+    let! cats = data.Category.FindByWebLog rootId
+    Expect.equal cats.Length 3 "There should be 3 categories"
+    Expect.exists cats (fun it -> it.Name = "Favorites") "Favorites category not found"
+    Expect.exists cats (fun it -> it.Name = "Spitball") "Spitball category not found"
+    Expect.exists cats (fun it -> it.Name = "Moonshot") "Moonshot category not found"
+}
+
+let ``FindByWebLog succeeds when no categories exist`` (data: IData) = task {
+    let! cats = data.Category.FindByWebLog WebLogId.Empty
+    Expect.isEmpty cats "There should have been no categories returned"
+}
+
+let ``Update succeeds`` (data: IData) = task {
+    match! data.Category.FindById favoritesId rootId with
+    | Some cat ->
+        do! data.Category.Update { cat with Name = "My Favorites"; Slug = "my-favorites"; Description = None }
+        match! data.Category.FindById favoritesId rootId with
+        | Some updated ->
+            Expect.equal updated.Name "My Favorites" "Name not updated properly"
+            Expect.equal updated.Slug "my-favorites" "Slug not updated properly"
+            Expect.isNone updated.Description "Description should have been removed"
+        | None -> Expect.isTrue false "The updated favorites category could not be retrieved"
+    | None -> Expect.isTrue false "The favorites category could not be retrieved"
+}
+
+let ``Delete succeeds when the category is deleted (no posts)`` (data: IData) = task {
+    let! result = data.Category.Delete (CategoryId "added-cat") (WebLogId "test")
+    Expect.equal result CategoryDeleted "The category should have been deleted"
+    let! cat = data.Category.FindById (CategoryId "added-cat") (WebLogId "test")
+    Expect.isNone cat "The deleted category should not still exist"
+}
+
+let ``Delete succeeds when the category does not exist`` (data: IData) = task {
+    let! result = data.Category.Delete CategoryId.Empty (WebLogId "none")
+    Expect.equal result CategoryNotFound "The category should not have been found"
+}
+
+let ``Delete succeeds when reassigning parent category to None`` (data: IData) = task {
+    let moonshotId = CategoryId "ScVpyu1e7UiP7bDdge3ZEw"
+    let spitballId = CategoryId "jw6N69YtTEWVHAO33jHU-w"
+    let! result = data.Category.Delete spitballId rootId
+    Expect.equal result ReassignedChildCategories "Child categories should have been reassigned"
+    match! data.Category.FindById moonshotId rootId with
+    | Some cat -> Expect.isNone cat.ParentId "Parent ID should have been cleared"
+    | None -> Expect.isTrue false "Unable to find former child category"
+}
+
+let ``Delete succeeds when reassigning parent category to Some`` (data: IData) = task {
+    do! data.Category.Add { Category.Empty with Id = CategoryId "a"; WebLogId = WebLogId "test"; Name = "A" }
+    do! data.Category.Add
+            { Category.Empty with
+                Id       = CategoryId "b"
+                WebLogId = WebLogId "test"
+                Name     = "B"
+                ParentId = Some (CategoryId "a") }
+    do! data.Category.Add
+            { Category.Empty with
+                Id       = CategoryId "c"
+                WebLogId = WebLogId "test"
+                Name     = "C"
+                ParentId = Some (CategoryId "b") }
+    let! result = data.Category.Delete (CategoryId "b") (WebLogId "test")
+    Expect.equal result ReassignedChildCategories "Child categories should have been reassigned"
+    match! data.Category.FindById (CategoryId "c") (WebLogId "test") with
+    | Some cat -> Expect.equal cat.ParentId (Some (CategoryId "a")) "Parent category ID not reassigned properly"
+    | None -> Expect.isTrue false "Expected former child category not found"
+}
+
+let ``Delete succeeds and removes category from posts`` (data: IData) = task {
+    let moonshotId = CategoryId "ScVpyu1e7UiP7bDdge3ZEw"
+    let postId     = PostId "RCsCU2puYEmkpzotoi8p4g"
+    match! data.Post.FindById postId rootId with
+    | Some post ->
+        Expect.equal post.CategoryIds [ moonshotId ] "Post category IDs are not as expected"
+        let! result = data.Category.Delete moonshotId rootId
+        Expect.equal result CategoryDeleted "The category should have been deleted (no children)"
+        match! data.Post.FindById postId rootId with
+        | Some p -> Expect.isEmpty p.CategoryIds "Category ID was not removed"
+        | None -> Expect.isTrue false "The expected updated post was not found"
+    | None -> Expect.isTrue false "The expected test post was not found"
+}

src/MyWebLog.Tests/Data/ConvertersTests.fs

@@ -0,0 +1,296 @@
+module ConvertersTests
+
+open Expecto
+open Microsoft.FSharpLu.Json
+open MyWebLog
+open MyWebLog.Converters.Json
+open Newtonsoft.Json
+
+/// Unit tests for the CategoryIdConverter type
+let categoryIdConverterTests = testList "CategoryIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(CategoryIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(CategoryId "test-cat-id", opts)
+        Expect.equal after "\"test-cat-id\"" "Category ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<CategoryId>("\"test-cat-id\"", opts)
+        Expect.equal after (CategoryId "test-cat-id") "Category ID not serialized incorrectly"
+    }
+]
+
+/// Unit tests for the CommentIdConverter type
+let commentIdConverterTests = testList "CommentIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(CommentIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(CommentId "test-id", opts)
+        Expect.equal after "\"test-id\"" "Comment ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<CommentId>("\"my-test\"", opts)
+        Expect.equal after (CommentId "my-test") "Comment ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the CommentStatusConverter type
+let commentStatusConverterTests = testList "CommentStatusConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(CommentStatusConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Approved, opts)
+        Expect.equal after "\"Approved\"" "Comment status serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<CommentStatus>("\"Spam\"", opts)
+        Expect.equal after Spam "Comment status deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the CustomFeedIdConverter type
+let customFeedIdConverterTests = testList "CustomFeedIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(CustomFeedIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(CustomFeedId "my-feed", opts)
+        Expect.equal after "\"my-feed\"" "Custom feed ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<CustomFeedId>("\"feed-me\"", opts)
+        Expect.equal after (CustomFeedId "feed-me") "Custom feed ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the CustomFeedSourceConverter type
+let customFeedSourceConverterTests = testList "CustomFeedSourceConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(CustomFeedSourceConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Category (CategoryId "abc-123"), opts)
+        Expect.equal after "\"category:abc-123\"" "Custom feed source serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<CustomFeedSource>("\"tag:testing\"", opts)
+        Expect.equal after (Tag "testing") "Custom feed source deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the ExplicitRating type
+let explicitRatingConverterTests = testList "ExplicitRatingConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(ExplicitRatingConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Yes, opts)
+        Expect.equal after "\"yes\"" "Explicit rating serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<ExplicitRating>("\"clean\"", opts)
+        Expect.equal after Clean "Explicit rating deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the MarkupText type
+let markupTextConverterTests = testList "MarkupTextConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(MarkupTextConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Html "<h4>test</h4>", opts)
+        Expect.equal after "\"HTML: <h4>test</h4>\"" "Markup text serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<MarkupText>("\"Markdown: #### test\"", opts)
+        Expect.equal after (Markdown "#### test") "Markup text deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the PermalinkConverter type
+let permalinkConverterTests = testList "PermalinkConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(PermalinkConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Permalink "2022/test", opts)
+        Expect.equal after "\"2022/test\"" "Permalink serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<Permalink>("\"2023/unit.html\"", opts)
+        Expect.equal after (Permalink "2023/unit.html") "Permalink deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the PageIdConverter type
+let pageIdConverterTests = testList "PageIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(PageIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(PageId "test-page", opts)
+        Expect.equal after "\"test-page\"" "Page ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<PageId>("\"page-test\"", opts)
+        Expect.equal after (PageId "page-test") "Page ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the PodcastMedium type
+let podcastMediumConverterTests = testList "PodcastMediumConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(PodcastMediumConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(Audiobook, opts)
+        Expect.equal after "\"audiobook\"" "Podcast medium serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<PodcastMedium>("\"newsletter\"", opts)
+        Expect.equal after Newsletter "Podcast medium deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the PostIdConverter type
+let postIdConverterTests = testList "PostIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(PostIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(PostId "test-post", opts)
+        Expect.equal after "\"test-post\"" "Post ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<PostId>("\"post-test\"", opts)
+        Expect.equal after (PostId "post-test") "Post ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the TagMapIdConverter type
+let tagMapIdConverterTests = testList "TagMapIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(TagMapIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(TagMapId "test-map", opts)
+        Expect.equal after "\"test-map\"" "Tag map ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<TagMapId>("\"map-test\"", opts)
+        Expect.equal after (TagMapId "map-test") "Tag map ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the ThemeAssetIdConverter type
+let themeAssetIdConverterTests = testList "ThemeAssetIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(ThemeAssetIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(ThemeAssetId (ThemeId "test", "unit.jpg"), opts)
+        Expect.equal after "\"test/unit.jpg\"" "Theme asset ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<ThemeAssetId>("\"theme/test.png\"", opts)
+        Expect.equal after (ThemeAssetId (ThemeId "theme", "test.png")) "Theme asset ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the ThemeIdConverter type
+let themeIdConverterTests = testList "ThemeIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(ThemeIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(ThemeId "test-theme", opts)
+        Expect.equal after "\"test-theme\"" "Theme ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<ThemeId>("\"theme-test\"", opts)
+        Expect.equal after (ThemeId "theme-test") "Theme ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the UploadIdConverter type
+let uploadIdConverterTests = testList "UploadIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(UploadIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(UploadId "test-up", opts)
+        Expect.equal after "\"test-up\"" "Upload ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<UploadId>("\"up-test\"", opts)
+        Expect.equal after (UploadId "up-test") "Upload ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the WebLogIdConverter type
+let webLogIdConverterTests = testList "WebLogIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(WebLogIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(WebLogId "test-web", opts)
+        Expect.equal after "\"test-web\"" "Web log ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<WebLogId>("\"web-test\"", opts)
+        Expect.equal after (WebLogId "web-test") "Web log ID deserialized incorrectly"
+    }
+]
+
+/// Unit tests for the WebLogUserIdConverter type
+let webLogUserIdConverterTests = testList "WebLogUserIdConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(WebLogUserIdConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(WebLogUserId "test-user", opts)
+        Expect.equal after "\"test-user\"" "Web log user ID serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<WebLogUserId>("\"user-test\"", opts)
+        Expect.equal after (WebLogUserId "user-test") "Web log user ID deserialized incorrectly"
+    }
+]
+
+open NodaTime.Serialization.JsonNet
+
+/// Unit tests for the Json.configure function
+let configureTests = test "Json.configure succeeds" {
+    let has typ (converter: JsonConverter) = converter.GetType() = typ
+    let ser = configure (JsonSerializer.Create())
+    Expect.hasCountOf ser.Converters 1u (has typeof<CategoryIdConverter>) "Category ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<CommentIdConverter>) "Comment ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<CommentStatusConverter>) "Comment status converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedIdConverter>) "Custom feed ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<CustomFeedSourceConverter>) "Custom feed source converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<ExplicitRatingConverter>) "Explicit rating converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<MarkupTextConverter>) "Markup text converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<PermalinkConverter>) "Permalink converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<PageIdConverter>) "Page ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<PodcastMediumConverter>) "Podcast medium converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<PostIdConverter>) "Post ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<TagMapIdConverter>) "Tag map ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<ThemeAssetIdConverter>) "Theme asset ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<ThemeIdConverter>) "Theme ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<UploadIdConverter>) "Upload ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<WebLogIdConverter>) "Web log ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<WebLogUserIdConverter>) "Web log user ID converter not found"
+    Expect.hasCountOf ser.Converters 1u (has typeof<CompactUnionJsonConverter>) "F# type converter not found"
+    Expect.hasCountOf ser.Converters 1u (has (NodaConverters.InstantConverter.GetType())) "NodaTime converter not found"
+    Expect.equal ser.NullValueHandling NullValueHandling.Ignore "Null handling set incorrectly"
+    Expect.equal ser.MissingMemberHandling MissingMemberHandling.Ignore "Missing member handling set incorrectly"
+}
+
+/// All tests for the Data.Converters file
+let all = testList "Converters" [
+    categoryIdConverterTests
+    commentIdConverterTests
+    commentStatusConverterTests
+    customFeedIdConverterTests
+    customFeedSourceConverterTests
+    explicitRatingConverterTests
+    markupTextConverterTests
+    permalinkConverterTests
+    pageIdConverterTests
+    podcastMediumConverterTests
+    postIdConverterTests
+    tagMapIdConverterTests
+    themeAssetIdConverterTests
+    themeIdConverterTests
+    uploadIdConverterTests
+    webLogIdConverterTests
+    webLogUserIdConverterTests
+    configureTests
+]

src/MyWebLog.Tests/Data/PageDataTests.fs

@@ -0,0 +1,267 @@
+/// <summary>
+/// Integration tests for <see cref="IPageData" /> implementations
+/// </summary> 
+module PageDataTests
+
+open System
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+/// The ID of the "A cool page" page
+let coolPageId = PageId "hgc_BLEZ50SoAWLuPNISvA"
+
+/// The published and updated time of the "A cool page" page
+let private coolPagePublished = Instant.FromDateTimeOffset(DateTimeOffset.Parse "2024-01-20T22:14:28Z")
+
+/// The ID of the "Yet Another Page" page
+let private otherPageId = PageId "KouRjvSmm0Wz6TMD8xf67A"
+
+let ``Add succeeds`` (data: IData) = task {
+    let page =
+        { Id              = PageId "added-page"
+          WebLogId        = WebLogId "test"
+          AuthorId        = WebLogUserId "the-author"
+          Title           = "A New Page"
+          Permalink       = Permalink "2024/the-page.htm"
+          PublishedOn     = Noda.epoch + Duration.FromDays 3
+          UpdatedOn       = Noda.epoch + Duration.FromDays 3 + Duration.FromMinutes 2L
+          IsInPageList    = true
+          Template        = Some "new-page-template"
+          Text            = "<h1>A new page</h1>"
+          Metadata        = [ { Name = "Meta Item"; Value = "Meta Value" } ]
+          PriorPermalinks = [ Permalink "2024/the-new-page.htm" ]
+          Revisions       = [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<h1>A new page</h1>" } ] }
+    do! data.Page.Add page 
+    let! stored = data.Page.FindFullById (PageId "added-page") (WebLogId "test")
+    Expect.isSome stored "The page should have been added"
+    let pg = stored.Value
+    Expect.equal pg.Id page.Id "ID not saved properly"
+    Expect.equal pg.WebLogId page.WebLogId "Web log ID not saved properly"
+    Expect.equal pg.AuthorId page.AuthorId "Author ID not saved properly"
+    Expect.equal pg.Title page.Title "Title not saved properly"
+    Expect.equal pg.Permalink page.Permalink "Permalink not saved properly"
+    Expect.equal pg.PublishedOn page.PublishedOn "Published On not saved properly"
+    Expect.equal pg.UpdatedOn page.UpdatedOn "Updated On not saved properly"
+    Expect.equal pg.IsInPageList page.IsInPageList "Is in page list flag not saved properly"
+    Expect.equal pg.Template page.Template "Template not saved properly"
+    Expect.equal pg.Text page.Text "Text not saved properly"
+    Expect.equal pg.Metadata page.Metadata "Metadata not saved properly"
+    Expect.equal pg.PriorPermalinks page.PriorPermalinks "Prior permalinks not saved properly"
+    Expect.equal pg.Revisions page.Revisions "Revisions not saved properly"
+}
+
+let ``All succeeds`` (data: IData) = task {
+    let! pages = data.Page.All rootId
+    Expect.hasLength pages 2 "There should have been 2 pages retrieved"
+    pages |> List.iteri (fun idx pg ->
+        Expect.equal pg.Text "" $"Page {idx} should have had no text"
+        Expect.isEmpty pg.Metadata $"Page {idx} should have had no metadata"
+        Expect.isEmpty pg.Revisions $"Page {idx} should have had no revisions"
+        Expect.isEmpty pg.PriorPermalinks $"Page {idx} should have had no prior permalinks")
+    let! others = data.Page.All (WebLogId "not-there")
+    Expect.isEmpty others "There should not be pages retrieved"
+}
+
+let ``CountAll succeeds`` (data: IData) = task {
+    let! pages = data.Page.CountAll rootId
+    Expect.equal pages 2 "There should have been 2 pages counted"
+}
+
+let ``CountListed succeeds`` (data: IData) = task {
+    let! pages = data.Page.CountListed rootId
+    Expect.equal pages 1 "There should have been 1 page in the page list"
+}
+
+let ``FindById succeeds when a page is found`` (data: IData) = task {
+    let! page = data.Page.FindById coolPageId rootId
+    Expect.isSome page "A page should have been returned"
+    let pg = page.Value
+    Expect.equal pg.Id coolPageId "The wrong page was retrieved"
+    Expect.equal pg.WebLogId rootId "The page's web log did not match the called parameter"
+    Expect.equal pg.AuthorId (WebLogUserId "5EM2rimH9kONpmd2zQkiVA") "Author ID is incorrect"
+    Expect.equal pg.Title "Page Title" "Title is incorrect"
+    Expect.equal pg.Permalink (Permalink "a-cool-page.html") "Permalink is incorrect"
+    Expect.equal pg.PublishedOn coolPagePublished "Published On is incorrect"
+    Expect.equal pg.UpdatedOn coolPagePublished "Updated On is incorrect"
+    Expect.isFalse pg.IsInPageList "Is in page list flag should not have been set"
+    Expect.equal pg.Text "<h1 id=\"a-cool-page\">A Cool Page</h1>\n<p>It really is cool!</p>\n" "Text is incorrect"
+    Expect.equal
+        pg.Metadata [ { Name = "Cool"; Value = "true" }; { Name = "Warm"; Value = "false" } ] "Metadata is incorrect"
+    Expect.isEmpty pg.Revisions "Revisions should not have been retrieved"
+    Expect.isEmpty pg.PriorPermalinks "Prior permalinks should not have been retrieved"
+}
+
+let ``FindById succeeds when a page is not found (incorrect weblog)`` (data: IData) = task {
+    let! page = data.Page.FindById coolPageId (WebLogId "wrong")
+    Expect.isNone page "The page should not have been retrieved"
+}
+
+let ``FindById succeeds when a page is not found (bad page ID)`` (data: IData) = task {
+    let! page = data.Page.FindById (PageId "missing") rootId
+    Expect.isNone page "The page should not have been retrieved"
+}
+
+let ``FindByPermalink succeeds when a page is found`` (data: IData) = task {
+    let! page = data.Page.FindByPermalink (Permalink "a-cool-page.html") rootId
+    Expect.isSome page "A page should have been returned"
+    let pg = page.Value
+    Expect.equal pg.Id coolPageId "The wrong page was retrieved"
+    Expect.isEmpty pg.Revisions "Revisions should not have been retrieved"
+    Expect.isEmpty pg.PriorPermalinks "Prior permalinks should not have been retrieved"
+}
+
+let ``FindByPermalink succeeds when a page is not found (incorrect weblog)`` (data: IData) = task {
+    let! page = data.Page.FindByPermalink (Permalink "a-cool-page.html") (WebLogId "wrong")
+    Expect.isNone page "The page should not have been retrieved"
+}
+
+let ``FindByPermalink succeeds when a page is not found (no such permalink)`` (data: IData) = task {
+    let! page = data.Page.FindByPermalink (Permalink "1970/no-www-then.html") rootId
+    Expect.isNone page "The page should not have been retrieved"
+}
+
+let ``FindCurrentPermalink succeeds when a page is found`` (data: IData) = task {
+    let! link = data.Page.FindCurrentPermalink [ Permalink "a-cool-pg.html"; Permalink "a-cool-pg.html/" ] rootId
+    Expect.isSome link "A permalink should have been returned"
+    Expect.equal link (Some (Permalink "a-cool-page.html")) "The wrong permalink was retrieved"
+}
+
+let ``FindCurrentPermalink succeeds when a page is not found`` (data: IData) = task {
+    let! link = data.Page.FindCurrentPermalink [ Permalink "blah/"; Permalink "blah" ] rootId
+    Expect.isNone link "A permalink should not have been returned"
+}
+
+let ``FindFullById succeeds when a page is found`` (data: IData) = task {
+    let! page = data.Page.FindFullById coolPageId rootId
+    Expect.isSome page "A page should have been returned"
+    let pg = page.Value
+    Expect.equal pg.Id coolPageId "The wrong page was retrieved"
+    Expect.equal pg.WebLogId rootId "The page's web log did not match the called parameter"
+    Expect.equal
+        pg.Revisions
+        [ { AsOf = coolPagePublished; Text = Markdown "# A Cool Page\n\nIt really is cool!" } ]
+        "Revisions are incorrect"
+    Expect.equal pg.PriorPermalinks [ Permalink "a-cool-pg.html" ] "Prior permalinks are incorrect"
+}
+
+let ``FindFullById succeeds when a page is not found`` (data: IData) = task {
+    let! page = data.Page.FindFullById (PageId "not-there") rootId
+    Expect.isNone page "A page should not have been retrieved"
+}
+
+let ``FindFullByWebLog succeeds when pages are found`` (data: IData) = task {
+    let! pages = data.Page.FindFullByWebLog rootId
+    Expect.hasLength pages 2 "There should have been 2 pages returned"
+    pages |> List.iter (fun pg ->
+        Expect.contains [ coolPageId; otherPageId ] pg.Id $"Page ID {pg.Id} unexpected"
+        if pg.Id = coolPageId then
+            Expect.isNonEmpty pg.Metadata "Metadata should have been retrieved"
+            Expect.isNonEmpty pg.PriorPermalinks "Prior permalinks should have been retrieved"
+        Expect.isNonEmpty pg.Revisions "Revisions should have been retrieved")
+}
+
+let ``FindFullByWebLog succeeds when pages are not found`` (data: IData) = task {
+    let! pages = data.Page.FindFullByWebLog (WebLogId "does-not-exist")
+    Expect.isEmpty pages "No pages should have been retrieved"
+}
+
+let ``FindListed succeeds when pages are found`` (data: IData) = task {
+    let! pages = data.Page.FindListed rootId
+    Expect.hasLength pages 1 "There should have been 1 page returned"
+    Expect.equal pages[0].Id otherPageId "An unexpected page was returned"
+    Expect.equal pages[0].Text "" "Text should not have been returned"
+    Expect.isEmpty pages[0].PriorPermalinks "Prior permalinks should not have been retrieved"
+    Expect.isEmpty pages[0].Revisions "Revisions should not have been retrieved"
+}
+
+let ``FindListed succeeds when pages are not found`` (data: IData) = task {
+    let! pages = data.Page.FindListed (WebLogId "none")
+    Expect.isEmpty pages "No pages should have been retrieved"
+}
+
+let ``FindPageOfPages succeeds when pages are found`` (data: IData) = task {
+    let! pages = data.Page.FindPageOfPages rootId 1
+    Expect.hasLength pages 2 "There should have been 2 page returned"
+    Expect.equal pages[0].Id coolPageId "Pages not sorted correctly"
+    pages |> List.iteri (fun idx pg ->
+        Expect.notEqual pg.Text "" $"Text for page {idx} should have been retrieved"
+        Expect.isEmpty pg.Metadata $"Metadata for page {idx} should not have been retrieved"
+        Expect.isEmpty pg.PriorPermalinks $"Prior permalinks for page {idx} should not have been retrieved"
+        Expect.isEmpty pg.Revisions $"Revisions for page {idx} should not have been retrieved")
+}
+
+let ``FindPageOfPages succeeds when pages are not found`` (data: IData) = task {
+    let! pages = data.Page.FindPageOfPages rootId 2
+    Expect.isEmpty pages "No pages should have been retrieved"
+}
+
+let ``Update succeeds when the page exists`` (data: IData) = task {
+    let! page = data.Page.FindFullById coolPageId rootId
+    Expect.isSome page "A page should have been returned"
+    do! data.Page.Update
+            { page.Value with
+                Title           = "This Is Neat"
+                Permalink       = Permalink "neat-page.html"
+                UpdatedOn       = page.Value.PublishedOn + Duration.FromHours 5
+                IsInPageList    = true
+                Text            = "<p>I have been updated"
+                Metadata        = [ List.head page.Value.Metadata ]
+                PriorPermalinks = [ Permalink "a-cool-page.html" ]
+                Revisions       =
+                    { AsOf = page.Value.PublishedOn + Duration.FromHours 5; Text = Html "<p>I have been updated" }
+                        :: page.Value.Revisions }
+    let! updated = data.Page.FindFullById coolPageId rootId
+    Expect.isSome updated "The updated page should have been returned"
+    let pg = updated.Value
+    Expect.equal pg.Title "This Is Neat" "Title is incorrect"
+    Expect.equal pg.Permalink (Permalink "neat-page.html") "Permalink is incorrect"
+    Expect.equal pg.PublishedOn coolPagePublished "Published On is incorrect"
+    Expect.equal pg.UpdatedOn (coolPagePublished + Duration.FromHours 5) "Updated On is incorrect"
+    Expect.isTrue pg.IsInPageList "Is in page list flag should have been set"
+    Expect.equal pg.Text "<p>I have been updated" "Text is incorrect"
+    Expect.equal pg.Metadata [ { Name = "Cool"; Value = "true" } ] "Metadata is incorrect"
+    Expect.equal pg.PriorPermalinks [ Permalink "a-cool-page.html" ] "Prior permalinks are incorrect"
+    Expect.equal
+        pg.Revisions
+        [ { AsOf = coolPagePublished + Duration.FromHours 5; Text = Html "<p>I have been updated" }
+          { AsOf = coolPagePublished; Text = Markdown "# A Cool Page\n\nIt really is cool!" } ]
+        "Revisions are incorrect"
+}
+
+let ``Update succeeds when the page does not exist`` (data: IData) = task {
+    let pageId = PageId "missing-page"
+    do! data.Page.Update { Page.Empty with Id = pageId; WebLogId = rootId }
+    let! page = data.Page.FindById pageId rootId
+    Expect.isNone page "A page should not have been retrieved"
+}
+
+let ``UpdatePriorPermalinks succeeds when the page exists`` (data: IData) = task {
+    let links = [ Permalink "link-1.html"; Permalink "link-1.aspx"; Permalink "link-3.php" ]
+    let! found = data.Page.UpdatePriorPermalinks otherPageId rootId links
+    Expect.isTrue found "The permalinks should have been updated"
+    let! page = data.Page.FindFullById otherPageId rootId
+    Expect.isSome page "The page should have been found"
+    Expect.equal page.Value.PriorPermalinks links "The prior permalinks were not correct"
+}
+
+let ``UpdatePriorPermalinks succeeds when the page does not exist`` (data: IData) = task {
+    let! found =
+        data.Page.UpdatePriorPermalinks (PageId "no-page") WebLogId.Empty
+            [ Permalink "link-1.html"; Permalink "link-1.aspx"; Permalink "link-3.php" ]
+    Expect.isFalse found "The permalinks should not have been updated"
+}
+
+let ``Delete succeeds when a page is deleted`` (data: IData) = task {
+    let! deleted = data.Page.Delete coolPageId rootId
+    Expect.isTrue deleted "The page should have been deleted"
+}
+
+let ``Delete succeeds when a page is not deleted`` (data: IData) = task {
+    let! deleted = data.Page.Delete coolPageId rootId // this was deleted above
+    Expect.isFalse deleted "A page should not have been deleted"
+}

src/MyWebLog.Tests/Data/PostDataTests.fs

@@ -0,0 +1,431 @@
+/// <summary>
+/// Integration tests for <see cref="IPostData" /> implementations
+/// </summary> 
+module PostDataTests
+
+open System
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+/// The ID of podcast episode 1
+let private episode1 = PostId "osxMfWGlAkyugUbJ1-xD1g"
+
+/// The published instant for episode 1
+let private episode1Published = Instant.FromDateTimeOffset(DateTimeOffset.Parse "2024-01-20T22:24:01Z")
+
+/// The ID of podcast episode 2
+let episode2 = PostId "l4_Eh4aFO06SqqJjOymNzA"
+
+/// The ID of "Something May Happen" post
+let private something = PostId "QweKbWQiOkqqrjEdgP9wwg"
+
+/// The published instant for "Something May Happen" post
+let private somethingPublished = Instant.FromDateTimeOffset(DateTimeOffset.Parse "2024-01-20T22:32:59Z")
+
+/// The ID of "An Incomplete Thought" post
+let private incomplete = PostId "VweKbWQiOkqqrjEdgP9wwg"
+
+/// The ID of "Test Post 1" post
+let private testPost1 = PostId "RCsCU2puYEmkpzotoi8p4g"
+
+/// The published instant for "Test Post 1" post
+let private testPost1Published = Instant.FromDateTimeOffset(DateTimeOffset.Parse "2024-01-20T22:17:29Z")
+
+/// The category IDs for "Spitball" (parent) and "Moonshot"
+let private testCatIds = [ CategoryId "jw6N69YtTEWVHAO33jHU-w"; CategoryId "ScVpyu1e7UiP7bDdge3ZEw" ]
+
+/// Ensure that a list of posts has text for each post
+let private ensureHasText (posts: Post list) =
+    for post in posts do Expect.isNotEmpty post.Text $"Text should not be blank (post ID {post.Id})"
+
+/// Ensure that a list of posts has no revisions or prior permalinks
+let private ensureEmpty posts =
+    for post in posts do
+        Expect.isEmpty post.Revisions $"There should have been no revisions (post ID {post.Id})"
+        Expect.isEmpty post.PriorPermalinks $"There should have been no prior permalinks (post ID {post.Id})"
+
+let ``Add succeeds`` (data: IData) = task {
+    let post =
+        { Id              = PostId "a-new-post"
+          WebLogId        = WebLogId "test"
+          AuthorId        = WebLogUserId "test-author"
+          Status          = Published 
+          Title           = "A New Test Post"
+          Permalink       = Permalink "2020/test-post.html"
+          PublishedOn     = Some (Noda.epoch + Duration.FromMinutes 1L)
+          UpdatedOn       = Noda.epoch + Duration.FromMinutes 3L
+          Template        = Some "fancy"
+          Text            = "<p>Test text here"
+          CategoryIds     = [ CategoryId "a"; CategoryId "b" ]
+          Tags            = [ "x"; "y"; "zed" ]
+          Episode         = Some { Episode.Empty with Media = "test-ep.mp3" }
+          Metadata        = [ { Name = "Meta"; Value = "Data" } ]
+          PriorPermalinks = [ Permalink "2020/test-post-a.html" ]
+          Revisions       = [ { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ] }
+    do! data.Post.Add post
+    let! stored = data.Post.FindFullById post.Id post.WebLogId
+    Expect.isSome stored "The added post should have been retrieved"
+    let it = stored.Value
+    Expect.equal it.Id post.Id "ID not saved properly"
+    Expect.equal it.WebLogId post.WebLogId "Web log ID not saved properly"
+    Expect.equal it.AuthorId post.AuthorId "Author ID not saved properly"
+    Expect.equal it.Status post.Status "Status not saved properly"
+    Expect.equal it.Title post.Title "Title not saved properly"
+    Expect.equal it.Permalink post.Permalink "Permalink not saved properly"
+    Expect.equal it.PublishedOn post.PublishedOn "Published On not saved properly"
+    Expect.equal it.UpdatedOn post.UpdatedOn "Updated On not saved properly"
+    Expect.equal it.Template post.Template "Template not saved properly"
+    Expect.equal it.Text post.Text "Text not saved properly"
+    Expect.equal it.CategoryIds post.CategoryIds "Category IDs not saved properly"
+    Expect.equal it.Tags post.Tags "Tags not saved properly"
+    Expect.equal it.Episode post.Episode "Episode not saved properly"
+    Expect.equal it.Metadata post.Metadata "Metadata items not saved properly"
+    Expect.equal it.PriorPermalinks post.PriorPermalinks "Prior permalinks not saved properly"
+    Expect.equal it.Revisions post.Revisions "Revisions not saved properly"
+}
+
+let ``CountByStatus succeeds`` (data: IData) = task {
+    let! count = data.Post.CountByStatus Published rootId
+    Expect.equal count 4 "There should be 4 published posts"
+}
+
+let ``FindById succeeds when a post is found`` (data: IData) = task {
+    let! post = data.Post.FindById episode1 rootId
+    Expect.isSome post "There should have been a post returned"
+    let it = post.Value
+    Expect.equal it.Id episode1 "An incorrect post was retrieved"
+    Expect.equal it.WebLogId rootId "The post belongs to an incorrect web log"
+    Expect.equal it.AuthorId (WebLogUserId "5EM2rimH9kONpmd2zQkiVA") "Author ID is incorrect"
+    Expect.equal it.Status Published "Status is incorrect"
+    Expect.equal it.Title "Episode 1" "Title is incorrect"
+    Expect.equal it.Permalink (Permalink "2024/episode-1.html") "Permalink is incorrect"
+    Expect.equal it.PublishedOn (Some episode1Published) "Published On is incorrect"
+    Expect.equal it.UpdatedOn episode1Published "Updated On is incorrect"
+    Expect.equal it.Text "<p>It's the launch of my new podcast - y'all come listen!" "Text is incorrect"
+    Expect.equal it.CategoryIds [ CategoryId "S5JflPsJ9EG7gA2LD4m92A" ] "Category IDs are incorrect"
+    Expect.equal it.Tags [ "general"; "podcast" ] "Tags are incorrect"
+    Expect.isSome it.Episode "There should be an episode associated with this post"
+    let ep = it.Episode.Value
+    Expect.equal ep.Media "episode-1.mp3" "Episode media is incorrect"
+    Expect.equal ep.Length 124302L "Episode length is incorrect"
+    Expect.equal
+        ep.Duration (Some (Duration.FromMinutes 12L + Duration.FromSeconds 22L)) "Episode duration is incorrect"
+    Expect.equal ep.ImageUrl (Some "images/ep1-cover.png") "Episode image URL is incorrect"
+    Expect.equal ep.Subtitle (Some "An introduction to this podcast") "Episode subtitle is incorrect"
+    Expect.equal ep.Explicit (Some Clean) "Episode explicit rating is incorrect"
+    Expect.equal ep.ChapterFile (Some "uploads/chapters.json") "Episode chapter file is incorrect"
+    Expect.equal ep.TranscriptUrl (Some "uploads/transcript.srt") "Episode transcript URL is incorrect"
+    Expect.equal ep.TranscriptType (Some "application/srt") "Episode transcript type is incorrect"
+    Expect.equal ep.TranscriptLang (Some "en") "Episode transcript language is incorrect"
+    Expect.equal ep.TranscriptCaptions (Some true) "Episode transcript caption flag is incorrect"
+    Expect.equal ep.SeasonNumber (Some 1) "Episode season number is incorrect"
+    Expect.equal ep.SeasonDescription (Some "The First Season") "Episode season description is incorrect"
+    Expect.equal ep.EpisodeNumber (Some 1.) "Episode number is incorrect"
+    Expect.equal ep.EpisodeDescription (Some "The first episode ever!") "Episode description is incorrect"
+    Expect.equal
+        it.Metadata
+        [ { Name = "Density"; Value = "Non-existent" }; { Name = "Intensity"; Value = "Low" } ]
+        "Metadata is incorrect"
+    ensureEmpty [ it ]
+}
+
+let ``FindById succeeds when a post is not found (incorrect weblog)`` (data: IData) = task {
+    let! post = data.Post.FindById episode1 (WebLogId "wrong")
+    Expect.isNone post "The post should not have been retrieved"
+}
+
+let ``FindById succeeds when a post is not found (bad post ID)`` (data: IData) = task {
+    let! post = data.Post.FindById (PostId "absent") rootId
+    Expect.isNone post "The post should not have been retrieved"
+}
+
+let ``FindByPermalink succeeds when a post is found`` (data: IData) = task {
+    let! post = data.Post.FindByPermalink (Permalink "2024/episode-1.html") rootId
+    Expect.isSome post "A post should have been returned"
+    let it = post.Value
+    Expect.equal it.Id episode1 "The wrong post was retrieved"
+    ensureEmpty [ it ]
+}
+
+let ``FindByPermalink succeeds when a post is not found (incorrect weblog)`` (data: IData) = task {
+    let! post = data.Post.FindByPermalink (Permalink "2024/episode-1.html") (WebLogId "incorrect")
+    Expect.isNone post "The post should not have been retrieved"
+}
+
+let ``FindByPermalink succeeds when a post is not found (no such permalink)`` (data: IData) = task {
+    let! post = data.Post.FindByPermalink (Permalink "404") rootId
+    Expect.isNone post "The post should not have been retrieved"
+}
+
+let ``FindCurrentPermalink succeeds when a post is found`` (data: IData) = task {
+    let! link = data.Post.FindCurrentPermalink [ Permalink "2024/ep-1.html"; Permalink "2024/ep-1.html/" ] rootId
+    Expect.isSome link "A permalink should have been returned"
+    Expect.equal link (Some (Permalink "2024/episode-1.html")) "The wrong permalink was retrieved"
+}
+
+let ``FindCurrentPermalink succeeds when a post is not found`` (data: IData) = task {
+    let! link = data.Post.FindCurrentPermalink [ Permalink "oops/"; Permalink "oops" ] rootId
+    Expect.isNone link "A permalink should not have been returned"
+}
+
+let ``FindFullById succeeds when a post is found`` (data: IData) = task {
+    let! post = data.Post.FindFullById episode1 rootId
+    Expect.isSome post "A post should have been returned"
+    let it = post.Value
+    Expect.equal it.Id episode1 "The wrong post was retrieved"
+    Expect.equal it.WebLogId rootId "The post's web log did not match the called parameter"
+    Expect.equal
+        it.Revisions
+        [ { AsOf = episode1Published; Text = Html "<p>It's the launch of my new podcast - y'all come listen!" } ]
+        "Revisions are incorrect"
+    Expect.equal it.PriorPermalinks [ Permalink "2024/ep-1.html" ] "Prior permalinks are incorrect"
+}
+
+let ``FindFullById succeeds when a post is not found`` (data: IData) = task {
+    let! post = data.Post.FindFullById (PostId "no-post") rootId
+    Expect.isNone post "A page should not have been retrieved"
+}
+
+let ``FindFullByWebLog succeeds when posts are found`` (data: IData) = task {
+    let! posts = data.Post.FindFullByWebLog rootId
+    Expect.hasLength posts 5 "There should have been 5 posts returned"
+    let allPosts = [ testPost1; episode1; episode2; something; incomplete ]
+    posts |> List.iter (fun it ->
+        Expect.contains allPosts it.Id $"Post ID {it.Id} unexpected"
+        if it.Id = episode1 then
+            Expect.isNonEmpty it.Metadata "Metadata should have been retrieved"
+            Expect.isNonEmpty it.PriorPermalinks "Prior permalinks should have been retrieved"
+        Expect.isNonEmpty it.Revisions "Revisions should have been retrieved")
+}
+
+let ``FindFullByWebLog succeeds when posts are not found`` (data: IData) = task {
+    let! posts = data.Post.FindFullByWebLog (WebLogId "nonexistent")
+    Expect.isEmpty posts "No posts should have been retrieved"
+}
+
+let ``FindPageOfCategorizedPosts succeeds when posts are found`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfCategorizedPosts rootId testCatIds 1 1
+    Expect.hasLength posts 2 "There should be 2 posts returned"
+    Expect.equal posts[0].Id something "The wrong post was returned for page 1"
+    ensureEmpty posts
+    let! posts = data.Post.FindPageOfCategorizedPosts rootId testCatIds 2 1
+    Expect.hasLength posts 1 "There should be 1 post returned"
+    Expect.equal posts[0].Id testPost1 "The wrong post was returned for page 2"
+    ensureEmpty posts
+}
+
+let ``FindPageOfCategorizedPosts succeeds when finding a too-high page number`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfCategorizedPosts rootId testCatIds 17 2
+    Expect.hasLength posts 0 "There should have been no posts returned (not enough posts)"
+}
+
+let ``FindPageOfCategorizedPosts succeeds when a category has no posts`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfCategorizedPosts rootId [ CategoryId "nope" ] 1 1
+    Expect.hasLength posts 0 "There should have been no posts returned (none match)"
+}
+
+let ``FindPageOfPosts succeeds when posts are found`` (data: IData) = task {
+    let ensureNoText (posts: Post list) =
+        for post in posts do Expect.equal post.Text "" $"There should be no text (post ID {post.Id})"
+    let! posts = data.Post.FindPageOfPosts rootId 1 2
+    Expect.hasLength posts 3 "There should have been 3 posts returned for page 1"
+    Expect.equal posts[0].Id incomplete "Page 1, post 1 is incorrect"
+    Expect.equal posts[1].Id something "Page 1, post 2 is incorrect"
+    Expect.equal posts[2].Id episode2 "Page 1, post 3 is incorrect"
+    ensureNoText posts
+    ensureEmpty posts
+    let! posts = data.Post.FindPageOfPosts rootId 2 2
+    Expect.hasLength posts 3 "There should have been 3 posts returned for page 2"
+    Expect.equal posts[0].Id episode2 "Page 2, post 1 is incorrect"
+    Expect.equal posts[1].Id episode1 "Page 2, post 2 is incorrect"
+    Expect.equal posts[2].Id testPost1 "Page 2, post 3 is incorrect"
+    ensureNoText posts
+    ensureEmpty posts
+    let! posts = data.Post.FindPageOfPosts rootId 3 2
+    Expect.hasLength posts 1 "There should have been 1 post returned for page 3"
+    Expect.equal posts[0].Id testPost1 "Page 3, post 1 is incorrect"
+    ensureNoText posts
+    ensureEmpty posts
+}
+
+let ``FindPageOfPosts succeeds when finding a too-high page number`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfPosts rootId 88 3
+    Expect.isEmpty posts "There should have been no posts returned (not enough posts)"
+}
+
+let ``FindPageOfPosts succeeds when there are no posts`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfPosts (WebLogId "no-posts") 1 25
+    Expect.isEmpty posts "There should have been no posts returned (no posts)"
+}
+
+let ``FindPageOfPublishedPosts succeeds when posts are found`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfPublishedPosts rootId 1 3
+    Expect.hasLength posts 4 "There should have been 4 posts returned for page 1"
+    Expect.equal posts[0].Id something "Page 1, post 1 is incorrect"
+    Expect.equal posts[1].Id episode2 "Page 1, post 2 is incorrect"
+    Expect.equal posts[2].Id episode1 "Page 1, post 3 is incorrect"
+    Expect.equal posts[3].Id testPost1 "Page 1, post 4 is incorrect"
+    ensureHasText posts
+    ensureEmpty posts
+    let! posts = data.Post.FindPageOfPublishedPosts rootId 2 2
+    Expect.hasLength posts 2 "There should have been 2 posts returned for page 2"
+    Expect.equal posts[0].Id episode1 "Page 2, post 1 is incorrect"
+    Expect.equal posts[1].Id testPost1 "Page 2, post 2 is incorrect"
+    ensureHasText posts
+    ensureEmpty posts
+}
+
+let ``FindPageOfPublishedPosts succeeds when finding a too-high page number`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfPublishedPosts rootId 7 22
+    Expect.isEmpty posts "There should have been no posts returned (not enough posts)"
+}
+
+let ``FindPageOfPublishedPosts succeeds when there are no posts`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfPublishedPosts (WebLogId "empty") 1 8
+    Expect.isEmpty posts "There should have been no posts returned (no posts)"
+}
+
+let ``FindPageOfTaggedPosts succeeds when posts are found`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfTaggedPosts rootId "f#" 1 1
+    Expect.hasLength posts 2 "There should have been 2 posts returned"
+    Expect.equal posts[0].Id something "Page 1, post 1 is incorrect"
+    Expect.equal posts[1].Id testPost1 "Page 1, post 2 is incorrect"
+    ensureHasText posts
+    ensureEmpty posts
+    let! posts = data.Post.FindPageOfTaggedPosts rootId "f#" 2 1
+    Expect.hasLength posts 1 "There should have been 1 posts returned"
+    Expect.equal posts[0].Id testPost1 "Page 2, post 1 is incorrect"
+    ensureHasText posts
+    ensureEmpty posts
+}
+
+let ``FindPageOfTaggedPosts succeeds when posts are found (excluding drafts)`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfTaggedPosts rootId "speculation" 1 10
+    Expect.hasLength posts 1 "There should have been 1 post returned"
+    Expect.equal posts[0].Id something "Post 1 is incorrect"
+    ensureHasText posts
+    ensureEmpty posts
+}
+
+let ``FindPageOfTaggedPosts succeeds when finding a too-high page number`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfTaggedPosts rootId "f#" 436 18
+    Expect.isEmpty posts "There should have been no posts returned (not enough posts)"
+}
+
+let ``FindPageOfTaggedPosts succeeds when there are no posts`` (data: IData) = task {
+    let! posts = data.Post.FindPageOfTaggedPosts rootId "non-existent-tag" 1 8
+    Expect.isEmpty posts "There should have been no posts returned (no posts)"
+}
+
+let ``FindSurroundingPosts succeeds when there is no next newer post`` (data: IData) = task {
+    let! older, newer = data.Post.FindSurroundingPosts rootId somethingPublished
+    Expect.isSome older "There should have been an older post"
+    Expect.equal older.Value.Id episode2 "The next older post is incorrect"
+    ensureHasText [ older.Value ]
+    ensureEmpty [ older.Value ]
+    Expect.isNone newer "There should not have been a newer post"
+}
+
+let ``FindSurroundingPosts succeeds when there is no next older post`` (data: IData) = task {
+    let! older, newer = data.Post.FindSurroundingPosts rootId testPost1Published
+    Expect.isNone older "There should not have been an older post"
+    Expect.isSome newer "There should have been a newer post"
+    Expect.equal newer.Value.Id episode1 "The next newer post is incorrect"
+    ensureHasText [ newer.Value ]
+    ensureEmpty [ newer.Value ]
+}
+
+let ``FindSurroundingPosts succeeds when older and newer exist`` (data: IData) = task {
+    let! older, newer = data.Post.FindSurroundingPosts rootId episode1Published
+    Expect.isSome older "There should have been an older post"
+    Expect.equal older.Value.Id testPost1 "The next older post is incorrect"
+    Expect.isSome newer "There should have been a newer post"
+    Expect.equal newer.Value.Id episode2 "The next newer post is incorrect"
+    ensureHasText [ older.Value; newer.Value ]
+    ensureEmpty [ older.Value; newer.Value ]
+}
+
+let ``Update succeeds when the post exists`` (data: IData) = task {
+    let! before = data.Post.FindFullById (PostId "a-new-post") (WebLogId "test")
+    Expect.isSome before "The post to be updated should have been found"
+    do! data.Post.Update
+            { before.Value with
+                AuthorId        = WebLogUserId "someone-else"
+                Status          = Draft
+                Title           = "An Updated Test Post"
+                Permalink       = Permalink "2021/updated-post.html"
+                PublishedOn     = None
+                UpdatedOn       = Noda.epoch + Duration.FromDays 4
+                Template        = Some "other"
+                Text            = "<p>Updated text here"
+                CategoryIds     = [ CategoryId "c"; CategoryId "d"; CategoryId "e" ]
+                Tags            = [ "alpha"; "beta"; "nu"; "zeta" ]
+                Episode         = None
+                Metadata        = [ { Name = "Howdy"; Value = "Pardner" } ]
+                PriorPermalinks = Permalink "2020/test-post.html" :: before.Value.PriorPermalinks
+                Revisions       =
+                    { AsOf = Noda.epoch + Duration.FromDays 4; Text = Html "<p>Updated text here" }
+                        :: before.Value.Revisions }
+    let! after = data.Post.FindFullById (PostId "a-new-post") (WebLogId "test")
+    Expect.isSome after "The updated post should have been found"
+    let post = after.Value
+    Expect.equal post.AuthorId (WebLogUserId "someone-else") "Updated author is incorrect"
+    Expect.equal post.Status Draft "Updated status is incorrect"
+    Expect.equal post.Title "An Updated Test Post" "Updated title is incorrect"
+    Expect.equal post.Permalink (Permalink "2021/updated-post.html") "Updated permalink is incorrect"
+    Expect.isNone post.PublishedOn "Updated post should not have had a published-on date/time"
+    Expect.equal post.UpdatedOn (Noda.epoch + Duration.FromDays 4) "Updated updated-on date/time is incorrect"
+    Expect.equal post.Template (Some "other") "Updated template is incorrect"
+    Expect.equal post.Text "<p>Updated text here" "Updated text is incorrect"
+    Expect.equal
+        post.CategoryIds [ CategoryId "c"; CategoryId "d"; CategoryId "e" ] "Updated category IDs are incorrect"
+    Expect.equal post.Tags [ "alpha"; "beta"; "nu"; "zeta" ] "Updated tags are incorrect"
+    Expect.isNone post.Episode "Update episode is incorrect"
+    Expect.equal post.Metadata [ { Name = "Howdy"; Value = "Pardner" } ] "Updated metadata is incorrect"
+    Expect.equal
+        post.PriorPermalinks
+        [ Permalink "2020/test-post.html"; Permalink "2020/test-post-a.html" ]
+        "Updated prior permalinks are incorrect"
+    Expect.equal
+        post.Revisions
+        [ { AsOf = Noda.epoch + Duration.FromDays 4; Text = Html "<p>Updated text here" }
+          { AsOf = Noda.epoch + Duration.FromMinutes 1L; Text = Html "<p>Test text here" } ]
+        "Updated revisions are incorrect"
+}
+
+let ``Update succeeds when the post does not exist`` (data: IData) = task {
+    let postId = PostId "lost-post"
+    do! data.Post.Update { Post.Empty with Id = postId; WebLogId = rootId }
+    let! post = data.Post.FindById postId rootId
+    Expect.isNone post "A post should not have been retrieved"
+}
+
+let ``UpdatePriorPermalinks succeeds when the post exists`` (data: IData) = task {
+    let links = [ Permalink "2024/ep-1.html"; Permalink "2023/ep-1.html" ]
+    let! found = data.Post.UpdatePriorPermalinks episode1 rootId links
+    Expect.isTrue found "The permalinks should have been updated"
+    let! post = data.Post.FindFullById episode1 rootId
+    Expect.isSome post "The post should have been found"
+    Expect.equal post.Value.PriorPermalinks links "The prior permalinks were not correct"
+}
+
+let ``UpdatePriorPermalinks succeeds when the post does not exist`` (data: IData) = task {
+    let! found =
+        data.Post.UpdatePriorPermalinks (PostId "silence") WebLogId.Empty [ Permalink "a.html"; Permalink "b.html" ]
+    Expect.isFalse found "The permalinks should not have been updated"
+}
+
+let ``Delete succeeds when a post is deleted`` (data: IData) = task {
+    let! deleted = data.Post.Delete episode2 rootId
+    Expect.isTrue deleted "The post should have been deleted"
+}
+
+let ``Delete succeeds when a post is not deleted`` (data: IData) = task {
+    let! deleted = data.Post.Delete episode2 rootId // this was deleted above
+    Expect.isFalse deleted "A post should not have been deleted"
+}

src/MyWebLog.Tests/Data/PostgresDataTests.fs

@@ -0,0 +1,722 @@
+module PostgresDataTests
+
+open BitBadger.Documents.Postgres
+open Expecto
+open Microsoft.Extensions.Logging.Abstractions
+open MyWebLog
+open MyWebLog.Converters
+open MyWebLog.Data
+open Newtonsoft.Json
+open Npgsql
+open ThrowawayDb.Postgres
+
+/// JSON serializer 
+let private ser = Json.configure (JsonSerializer.CreateDefault())
+
+/// The throwaway database (deleted when disposed)
+let mutable private db: ThrowawayDatabase option = None
+
+/// Create a PostgresData instance for testing
+let private mkData () =
+    PostgresData(NullLogger<PostgresData>(), ser) :> IData
+
+/// The host for the PostgreSQL test database (defaults to localhost)
+let private testHost =
+    RethinkDbDataTests.env "PG_HOST" "localhost"
+
+/// The database name for the PostgreSQL test database (defaults to postgres)
+let private testDb =
+    RethinkDbDataTests.env "PG_DB" "postgres"
+
+/// The user ID for the PostgreSQL test database (defaults to postgres)
+let private testUser =
+    RethinkDbDataTests.env "PG_USER" "postgres"
+
+/// The password for the PostgreSQL test database (defaults to postgres)
+let private testPw =
+    RethinkDbDataTests.env "PG_PW" "postgres"
+
+/// Create a fresh environment from the root backup
+let private freshEnvironment () = task {
+    if Option.isSome db then db.Value.Dispose()
+    db <- Some (ThrowawayDatabase.Create $"Host={testHost};Database={testDb};User ID={testUser};Password={testPw}")
+    let source = NpgsqlDataSourceBuilder db.Value.ConnectionString
+    let _ = source.UseNodaTime()
+    Configuration.useDataSource (source.Build())
+    let env = mkData ()
+    do! env.StartUp()
+    // This exercises Restore for all implementations; all tests are dependent on it working as expected
+    do! Maintenance.Backup.restoreBackup "root-weblog.json" None false false env
+}
+
+/// Set up the environment for the PostgreSQL tests
+let private environmentSetUp = testTask "creating database" {
+    do! freshEnvironment ()
+}
+
+/// Integration tests for the Category implementation in PostgreSQL
+let private categoryTests = testList "Category" [
+    testTask "Add succeeds" {
+        do! CategoryDataTests.``Add succeeds`` (mkData ())
+    }
+    testList "CountAll" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories exist`` (mkData ())
+        }
+        testTask "succeeds when categories do not exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories do not exist`` (mkData ())
+        }
+    ]
+    testList "CountTopLevel" [
+        testTask "succeeds when top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when top-level categories exist`` (mkData ())
+        }
+        testTask "succeeds when no top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when no top-level categories exist`` (mkData ())
+        }
+    ]
+    testTask "FindAllForView succeeds" {
+        do! CategoryDataTests.``FindAllForView succeeds`` (mkData ())
+    }
+    testList "FindById" [
+        testTask "succeeds when a category is found" {
+            do! CategoryDataTests.``FindById succeeds when a category is found`` (mkData ())
+        }
+        testTask "succeeds when a category is not found" {
+            do! CategoryDataTests.``FindById succeeds when a category is not found`` (mkData ())
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when categories exist`` (mkData ())
+        }
+        testTask "succeeds when no categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when no categories exist`` (mkData ())
+        }
+    ]
+    testTask "Update succeeds" {
+        do! CategoryDataTests.``Update succeeds`` (mkData ())
+    }
+    testList "Delete" [
+        testTask "succeeds when the category is deleted (no posts)" {
+            do! CategoryDataTests.``Delete succeeds when the category is deleted (no posts)`` (mkData ())
+        }
+        testTask "succeeds when the category does not exist" {
+            do! CategoryDataTests.``Delete succeeds when the category does not exist`` (mkData ())
+        }
+        testTask "succeeds when reassigning parent category to None" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to None`` (mkData ())
+        }
+        testTask "succeeds when reassigning parent category to Some" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to Some`` (mkData ())
+        }
+        testTask "succeeds and removes category from posts" {
+            do! CategoryDataTests.``Delete succeeds and removes category from posts`` (mkData ())
+        }
+    ]
+]
+
+/// Integration tests for the Page implementation in PostgreSQL
+let private pageTests = testList "Page" [
+    testTask "Add succeeds" {
+        do! PageDataTests.``Add succeeds`` (mkData ())
+    }
+    testTask "All succeeds" {
+        do! PageDataTests.``All succeeds`` (mkData ())
+    }
+    testTask "CountAll succeeds" {
+        do! PageDataTests.``CountAll succeeds`` (mkData ())
+    }
+    testTask "CountListed succeeds" {
+        do! PageDataTests.``CountListed succeeds`` (mkData ())
+    }
+    testList "FindById" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindById succeeds when a page is found`` (mkData ())
+        }
+        testTask "succeeds when a page is not found (incorrect weblog)" {
+            do! PageDataTests.``FindById succeeds when a page is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a page is not found (bad page ID)" {
+            do! PageDataTests.``FindById succeeds when a page is not found (bad page ID)`` (mkData ())
+        }
+    ]
+    testList "FindByPermalink" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is found`` (mkData ())
+        }
+        testTask "succeeds when a page is not found (incorrect weblog)" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a page is not found (no such permalink)" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is not found (no such permalink)`` (mkData ())
+        }
+    ]
+    testList "FindCurrentPermalink" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindCurrentPermalink succeeds when a page is found`` (mkData ())
+        }
+        testTask "succeeds when a page is not found" {
+            do! PageDataTests.``FindCurrentPermalink succeeds when a page is not found`` (mkData ())
+        }
+    ]
+    testList "FindFullById" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindFullById succeeds when a page is found`` (mkData ())
+        }
+        testTask "succeeds when a page is not found" {
+            do! PageDataTests.``FindFullById succeeds when a page is not found`` (mkData ())
+        }
+    ]
+    testList "FindFullByWebLog" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindFullByWebLog succeeds when pages are found`` (mkData ())
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindFullByWebLog succeeds when pages are not found`` (mkData ())
+        }
+    ]
+    testList "FindListed" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindListed succeeds when pages are found`` (mkData ())
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindListed succeeds when pages are not found`` (mkData ())
+        }
+    ]
+    testList "FindPageOfPages" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindPageOfPages succeeds when pages are found`` (mkData ())
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindPageOfPages succeeds when pages are not found`` (mkData ())
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the page exists" {
+            do! PageDataTests.``Update succeeds when the page exists`` (mkData ())
+        }
+        testTask "succeeds when the page does not exist" {
+            do! PageDataTests.``Update succeeds when the page does not exist`` (mkData ())
+        }
+    ]
+    testList "UpdatePriorPermalinks" [
+        testTask "succeeds when the page exists" {
+            do! PageDataTests.``UpdatePriorPermalinks succeeds when the page exists`` (mkData ())
+        }
+        testTask "succeeds when the page does not exist" {
+            do! PageDataTests.``UpdatePriorPermalinks succeeds when the page does not exist`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a page is deleted" {
+            do! PageDataTests.``Delete succeeds when a page is deleted`` (mkData ())
+            let! revisions =
+                Custom.scalar
+                    "SELECT COUNT(*) AS it FROM page_revision WHERE page_id = @id"
+                    [ idParam PageDataTests.coolPageId ]
+                    toCount
+            Expect.equal revisions 0 "All revisions for the page should have been deleted"
+        }
+        testTask "succeeds when a page is not deleted" {
+            do! PageDataTests.``Delete succeeds when a page is not deleted`` (mkData ())
+        }
+    ]
+]
+
+/// Integration tests for the Post implementation in PostgreSQL
+let private postTests = testList "Post" [
+    testTask "Add succeeds" {
+        // We'll need the root website categories restored for these tests
+        do! freshEnvironment ()
+        do! PostDataTests.``Add succeeds`` (mkData ())
+    }
+    testTask "CountByStatus succeeds" {
+        do! PostDataTests.``CountByStatus succeeds`` (mkData ())
+    }
+    testList "FindById" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindById succeeds when a post is found`` (mkData ())
+        }
+        testTask "succeeds when a post is not found (incorrect weblog)" {
+            do! PostDataTests.``FindById succeeds when a post is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a post is not found (bad post ID)" {
+            do! PostDataTests.``FindById succeeds when a post is not found (bad post ID)`` (mkData ())
+        }
+    ]
+    testList "FindByPermalink" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is found`` (mkData ())
+        }
+        testTask "succeeds when a post is not found (incorrect weblog)" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a post is not found (no such permalink)" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is not found (no such permalink)`` (mkData ())
+        }
+    ]
+    testList "FindCurrentPermalink" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindCurrentPermalink succeeds when a post is found`` (mkData ())
+        }
+        testTask "succeeds when a post is not found" {
+            do! PostDataTests.``FindCurrentPermalink succeeds when a post is not found`` (mkData ())
+        }
+    ]
+    testList "FindFullById" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindFullById succeeds when a post is found`` (mkData ())
+        }
+        testTask "succeeds when a post is not found" {
+            do! PostDataTests.``FindFullById succeeds when a post is not found`` (mkData ())
+        }
+    ]
+    testList "FindFullByWebLog" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindFullByWebLog succeeds when posts are found`` (mkData ())
+        }
+        testTask "succeeds when a posts are not found" {
+            do! PostDataTests.``FindFullByWebLog succeeds when posts are not found`` (mkData ())
+        }
+    ]
+    testList "FindPageOfCategorizedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when posts are found`` (mkData ())
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when finding a too-high page number`` (mkData ())
+        }
+        testTask "succeeds when a category has no posts" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when a category has no posts`` (mkData ())
+        }
+    ]
+    testList "FindPageOfPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfPosts succeeds when posts are found`` (mkData ())
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfPosts succeeds when finding a too-high page number`` (mkData ())
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfPosts succeeds when there are no posts`` (mkData ())
+        }
+    ]
+    testList "FindPageOfPublishedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when posts are found`` (mkData ())
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when finding a too-high page number`` (mkData ())
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when there are no posts`` (mkData ())
+        }
+    ]
+    testList "FindPageOfTaggedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when posts are found`` (mkData ())
+        }
+        testTask "succeeds when posts are found (excluding drafts)" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when posts are found (excluding drafts)`` (mkData ())
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when finding a too-high page number`` (mkData ())
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when there are no posts`` (mkData ())
+        }
+    ]
+    testList "FindSurroundingPosts" [
+        testTask "succeeds when there is no next newer post" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when there is no next newer post`` (mkData ())
+        }
+        testTask "succeeds when there is no next older post" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when there is no next older post`` (mkData ())
+        }
+        testTask "succeeds when older and newer exist" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when older and newer exist`` (mkData ())
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the post exists" {
+            do! PostDataTests.``Update succeeds when the post exists`` (mkData ())
+        }
+        testTask "succeeds when the post does not exist" {
+            do! PostDataTests.``Update succeeds when the post does not exist`` (mkData ())
+        }
+    ]
+    testList "UpdatePriorPermalinks" [
+        testTask "succeeds when the post exists" {
+            do! PostDataTests.``UpdatePriorPermalinks succeeds when the post exists`` (mkData ())
+        }
+        testTask "succeeds when the post does not exist" {
+            do! PostDataTests.``UpdatePriorPermalinks succeeds when the post does not exist`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a post is deleted" {
+            do! PostDataTests.``Delete succeeds when a post is deleted`` (mkData ())
+            let! revisions =
+                Custom.scalar
+                    "SELECT COUNT(*) AS it FROM post_revision WHERE post_id = @id"
+                    [ idParam PostDataTests.episode2 ]
+                    toCount
+            Expect.equal revisions 0 "All revisions for the post should have been deleted"
+        }
+        testTask "succeeds when a post is not deleted" {
+            do! PostDataTests.``Delete succeeds when a post is not deleted`` (mkData ())
+        }
+    ]
+]
+
+let private tagMapTests = testList "TagMap" [
+    testList "FindById" [
+        testTask "succeeds when a tag mapping is found" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is found`` (mkData ())
+        }
+        testTask "succeeds when a tag mapping is not found (incorrect weblog)" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a tag mapping is not found (bad tag map ID)" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is not found (bad tag map ID)`` (mkData ())
+        }
+    ]
+    testList "FindByUrlValue" [
+        testTask "succeeds when a tag mapping is found" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is found`` (mkData ())
+        }
+        testTask "succeeds when a tag mapping is not found (incorrect weblog)" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is not found (incorrect weblog)``
+                    (mkData ())
+        }
+        testTask "succeeds when a tag mapping is not found (no such value)" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is not found (no such value)`` (mkData ())
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when tag mappings are found" {
+            do! TagMapDataTests.``FindByWebLog succeeds when tag mappings are found`` (mkData ())
+        }
+        testTask "succeeds when no tag mappings are found" {
+            do! TagMapDataTests.``FindByWebLog succeeds when no tag mappings are found`` (mkData ())
+        }
+    ]
+    testList "FindMappingForTags" [
+        testTask "succeeds when mappings exist" {
+            do! TagMapDataTests.``FindMappingForTags succeeds when mappings exist`` (mkData ())
+        }
+        testTask "succeeds when no mappings exist" {
+            do! TagMapDataTests.``FindMappingForTags succeeds when no mappings exist`` (mkData ())
+        }
+    ]
+    testList "Save" [
+        testTask "succeeds when adding a tag mapping" {
+            do! TagMapDataTests.``Save succeeds when adding a tag mapping`` (mkData ())
+        }
+        testTask "succeeds when updating a tag mapping" {
+            do! TagMapDataTests.``Save succeeds when updating a tag mapping`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a tag mapping is deleted" {
+            do! TagMapDataTests.``Delete succeeds when a tag mapping is deleted`` (mkData ())
+        }
+        testTask "succeeds when a tag mapping is not deleted" {
+            do! TagMapDataTests.``Delete succeeds when a tag mapping is not deleted`` (mkData ())
+        }
+    ]
+]
+
+let private themeTests = testList "Theme" [
+    testTask "All succeeds" {
+        do! ThemeDataTests.``All succeeds`` (mkData ())
+    }
+    testList "Exists" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``Exists succeeds when the theme exists`` (mkData ())
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``Exists succeeds when the theme does not exist`` (mkData ())
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``FindById succeeds when the theme exists`` (mkData ())
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``FindById succeeds when the theme does not exist`` (mkData ())
+        }
+    ]
+    testList "FindByIdWithoutText" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``FindByIdWithoutText succeeds when the theme exists`` (mkData ())
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``FindByIdWithoutText succeeds when the theme does not exist`` (mkData ())
+        }
+    ]
+    testList "Save" [
+        testTask "succeeds when adding a theme" {
+            do! ThemeDataTests.``Save succeeds when adding a theme`` (mkData ())
+        }
+        testTask "succeeds when updating a theme" {
+            do! ThemeDataTests.``Save succeeds when updating a theme`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a theme is deleted" {
+            do! ThemeDataTests.``Delete succeeds when a theme is deleted`` (mkData ())
+        }
+        testTask "succeeds when a theme is not deleted" {
+            do! ThemeDataTests.``Delete succeeds when a theme is not deleted`` (mkData ())
+        }
+    ]
+]
+
+let private themeAssetTests = testList "ThemeAsset" [
+    testList "Save" [
+        testTask "succeeds when adding an asset" {
+            do! ThemeDataTests.Asset.``Save succeeds when adding an asset`` (mkData ())
+        }
+        testTask "succeeds when updating an asset" {
+            do! ThemeDataTests.Asset.``Save succeeds when updating an asset`` (mkData ())
+        }
+    ]
+    testTask "All succeeds" {
+        do! ThemeDataTests.Asset.``All succeeds`` (mkData ())
+    }
+    testList "FindById" [
+        testTask "succeeds when an asset is found" {
+            do! ThemeDataTests.Asset.``FindById succeeds when an asset is found`` (mkData ())
+        }
+        testTask "succeeds when an asset is not found" {
+            do! ThemeDataTests.Asset.``FindById succeeds when an asset is not found`` (mkData ())
+        }
+    ]
+    testList "FindByTheme" [
+        testTask "succeeds when assets exist" {
+            do! ThemeDataTests.Asset.``FindByTheme succeeds when assets exist`` (mkData ())
+        }
+        testTask "succeeds when assets do not exist" {
+            do! ThemeDataTests.Asset.``FindByTheme succeeds when assets do not exist`` (mkData ())
+        }
+    ]
+    testList "FindByThemeWithData" [
+        testTask "succeeds when assets exist" {
+            do! ThemeDataTests.Asset.``FindByThemeWithData succeeds when assets exist`` (mkData ())
+        }
+        testTask "succeeds when assets do not exist" {
+            do! ThemeDataTests.Asset.``FindByThemeWithData succeeds when assets do not exist`` (mkData ())
+        }
+    ]
+    testList "DeleteByTheme" [
+        testTask "succeeds when assets are deleted" {
+            do! ThemeDataTests.Asset.``DeleteByTheme succeeds when assets are deleted`` (mkData ())
+        }
+        testTask "succeeds when no assets are deleted" {
+            do! ThemeDataTests.Asset.``DeleteByTheme succeeds when no assets are deleted`` (mkData ())
+        }
+    ]
+]
+
+let private uploadTests = testList "Upload" [
+    testTask "Add succeeds" {
+        do! UploadDataTests.``Add succeeds`` (mkData ())
+    }
+    testList "FindByPath" [
+        testTask "succeeds when an upload is found" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is found`` (mkData ())
+        }
+        testTask "succeeds when an upload is not found (incorrect weblog)" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when an upload is not found (bad path)" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is not found (bad path)`` (mkData ())
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when uploads exist" {
+            do! UploadDataTests.``FindByWebLog succeeds when uploads exist`` (mkData ())
+        }
+        testTask "succeeds when no uploads exist" {
+            do! UploadDataTests.``FindByWebLog succeeds when no uploads exist`` (mkData ())
+        }
+    ]
+    testList "FindByWebLogWithData" [
+        testTask "succeeds when uploads exist" {
+            do! UploadDataTests.``FindByWebLogWithData succeeds when uploads exist`` (mkData ())
+        }
+        testTask "succeeds when no uploads exist" {
+            do! UploadDataTests.``FindByWebLogWithData succeeds when no uploads exist`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when an upload is deleted" {
+            do! UploadDataTests.``Delete succeeds when an upload is deleted`` (mkData ())
+        }
+        testTask "succeeds when an upload is not deleted" {
+            do! UploadDataTests.``Delete succeeds when an upload is not deleted`` (mkData ())
+        }
+    ]
+]
+
+let private webLogUserTests = testList "WebLogUser" [
+    testTask "Add succeeds" {
+        // This restore ensures all the posts and pages exist
+        do! freshEnvironment ()
+        do! WebLogUserDataTests.``Add succeeds`` (mkData ())
+    }
+    testList "FindByEmail" [
+        testTask "succeeds when a user is found" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is found`` (mkData ())
+        }
+        testTask "succeeds when a user is not found (incorrect weblog)" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a user is not found (bad email)" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is not found (bad email)`` (mkData ())
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when a user is found" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is found`` (mkData ())
+        }
+        testTask "succeeds when a user is not found (incorrect weblog)" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is not found (incorrect weblog)`` (mkData ())
+        }
+        testTask "succeeds when a user is not found (bad ID)" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is not found (bad ID)`` (mkData ())
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when users exist" {
+            do! WebLogUserDataTests.``FindByWebLog succeeds when users exist`` (mkData ())
+        }
+        testTask "succeeds when no users exist" {
+            do! WebLogUserDataTests.``FindByWebLog succeeds when no users exist`` (mkData ())
+        }
+    ]
+    testList "FindNames" [
+        testTask "succeeds when users exist" {
+            do! WebLogUserDataTests.``FindNames succeeds when users exist`` (mkData ())
+        }
+        testTask "succeeds when users do not exist" {
+            do! WebLogUserDataTests.``FindNames succeeds when users do not exist`` (mkData ())
+        }
+    ]
+    testList "SetLastSeen" [
+        testTask "succeeds when the user exists" {
+            do! WebLogUserDataTests.``SetLastSeen succeeds when the user exists`` (mkData ())
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``SetLastSeen succeeds when the user does not exist`` (mkData ())
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the user exists" {
+            do! WebLogUserDataTests.``Update succeeds when the user exists`` (mkData ())
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``Update succeeds when the user does not exist`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "fails when the user is the author of a page" {
+            do! WebLogUserDataTests.``Delete fails when the user is the author of a page`` (mkData ())
+        }
+        testTask "fails when the user is the author of a post" {
+            do! WebLogUserDataTests.``Delete fails when the user is the author of a post`` (mkData ())
+        }
+        testTask "succeeds when the user is not an author" {
+            do! WebLogUserDataTests.``Delete succeeds when the user is not an author`` (mkData ())
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``Delete succeeds when the user does not exist`` (mkData ())
+        }
+    ]
+]
+
+let private webLogTests = testList "WebLog" [
+    testTask "Add succeeds" {
+        do! WebLogDataTests.``Add succeeds`` (mkData ())
+    }
+    testTask "All succeeds" {
+        do! WebLogDataTests.``All succeeds`` (mkData ())
+    }
+    testList "FindByHost" [
+        testTask "succeeds when a web log is found" {
+            do! WebLogDataTests.``FindByHost succeeds when a web log is found`` (mkData ())
+        }
+        testTask "succeeds when a web log is not found" {
+            do! WebLogDataTests.``FindByHost succeeds when a web log is not found`` (mkData ())
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when a web log is found" {
+            do! WebLogDataTests.``FindById succeeds when a web log is found`` (mkData ())
+        }
+        testTask "succeeds when a web log is not found" {
+            do! WebLogDataTests.``FindById succeeds when a web log is not found`` (mkData ())
+        }
+    ]
+    testList "UpdateRedirectRules" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateRedirectRules succeeds when the web log exists`` (mkData ())
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateRedirectRules succeeds when the web log does not exist`` (mkData ())
+        }
+    ]
+    testList "UpdateRssOptions" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateRssOptions succeeds when the web log exists`` (mkData ())
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateRssOptions succeeds when the web log does not exist`` (mkData ())
+        }
+    ]
+    testList "UpdateSettings" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateSettings succeeds when the web log exists`` (mkData ())
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateSettings succeeds when the web log does not exist`` (mkData ())
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``Delete succeeds when the web log exists`` (mkData ())
+            let! revisions =
+                Custom.scalar
+                    "SELECT (SELECT COUNT(*) FROM page_revision) + (SELECT COUNT(*) FROM post_revision) AS it"
+                    []
+                    toCount
+            Expect.equal revisions 0 "All revisions should be deleted"
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``Delete succeeds when the web log does not exist`` (mkData ())
+        }
+    ]
+]
+
+/// Drop the throwaway PostgreSQL database
+let private environmentCleanUp = test "Clean Up" {
+    if db.IsSome then db.Value.Dispose()
+} 
+
+/// All PostgreSQL data tests
+let all =
+    testList "PostgresData"
+        [ environmentSetUp
+          categoryTests
+          pageTests
+          postTests
+          tagMapTests
+          themeTests
+          themeAssetTests
+          uploadTests
+          webLogUserTests
+          webLogTests
+          environmentCleanUp ]
+    |> testSequenced

src/MyWebLog.Tests/Data/RethinkDbDataTests.fs

@@ -0,0 +1,704 @@
+module RethinkDbDataTests
+
+open System
+open Expecto
+open Microsoft.Extensions.Logging.Abstractions
+open MyWebLog
+open MyWebLog.Converters
+open MyWebLog.Data
+open RethinkDb.Driver.FSharp
+open RethinkDb.Driver.Net
+
+/// Get an environment variable, using the given value as the default if it is not set
+let env name value =
+    match Environment.GetEnvironmentVariable $"MWL_TEST_{name}" with
+    | null -> value
+    | it when it.Trim() = "" -> value
+    | it -> it
+
+
+/// The data configuration for the test database
+let private dataCfg =
+    DataConfig.FromUri (env "RETHINK_URI" "rethinkdb://172.17.0.2/mwl_test")
+
+/// The active data instance to use for testing
+let mutable private data: IData option = None
+
+/// Dispose the existing data
+let private disposeData () = task {
+    if data.IsSome then
+        let conn = (data.Value :?> RethinkDbData).Conn
+        do! rethink { dbDrop dataCfg.Database; write; withRetryOnce; ignoreResult conn }
+        conn.Dispose()
+    data <- None
+}
+
+/// Create a new data implementation instance
+let private newData () =
+    let log  = NullLogger<RethinkDbData>()
+    let conn = dataCfg.CreateConnection log
+    RethinkDbData(conn, dataCfg, log)
+
+/// Create a fresh environment from the root backup
+let private freshEnvironment () = task {
+    do! disposeData ()
+    data <- Some (newData ())
+    do! data.Value.StartUp()
+    // This exercises Restore for all implementations; all tests are dependent on it working as expected
+    do! Maintenance.Backup.restoreBackup "root-weblog.json" None false false data.Value
+}
+
+/// Set up the environment for the RethinkDB tests
+let private environmentSetUp = testTask "creating database" {
+    let _ = Json.configure Converter.Serializer
+    do! freshEnvironment ()
+}
+
+/// Integration tests for the Category implementation in RethinkDB
+let private categoryTests = testList "Category" [
+    testTask "Add succeeds" {
+        do! CategoryDataTests.``Add succeeds`` data.Value
+    }
+    testList "CountAll" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories exist`` data.Value
+        }
+        testTask "succeeds when categories do not exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories do not exist`` data.Value
+        }
+    ]
+    testList "CountTopLevel" [
+        testTask "succeeds when top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when top-level categories exist`` data.Value
+        }
+        testTask "succeeds when no top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when no top-level categories exist`` data.Value
+        }
+    ]
+    testTask "FindAllForView succeeds" {
+        do! CategoryDataTests.``FindAllForView succeeds`` data.Value
+    }
+    testList "FindById" [
+        testTask "succeeds when a category is found" {
+            do! CategoryDataTests.``FindById succeeds when a category is found`` data.Value
+        }
+        testTask "succeeds when a category is not found" {
+            do! CategoryDataTests.``FindById succeeds when a category is not found`` data.Value
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when categories exist`` data.Value
+        }
+        testTask "succeeds when no categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when no categories exist`` data.Value
+        }
+    ]
+    testTask "Update succeeds" {
+        do! CategoryDataTests.``Update succeeds`` data.Value
+    }
+    testList "Delete" [
+        testTask "succeeds when the category is deleted (no posts)" {
+            do! CategoryDataTests.``Delete succeeds when the category is deleted (no posts)`` data.Value
+        }
+        testTask "succeeds when the category does not exist" {
+            do! CategoryDataTests.``Delete succeeds when the category does not exist`` data.Value
+        }
+        testTask "succeeds when reassigning parent category to None" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to None`` data.Value
+        }
+        testTask "succeeds when reassigning parent category to Some" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to Some`` data.Value
+        }
+        testTask "succeeds and removes category from posts" {
+            do! CategoryDataTests.``Delete succeeds and removes category from posts`` data.Value
+        }
+    ]
+]
+
+/// Integration tests for the Page implementation in RethinkDB
+let private pageTests = testList "Page" [
+    testTask "Add succeeds" {
+        do! PageDataTests.``Add succeeds`` data.Value
+    }
+    testTask "All succeeds" {
+        do! PageDataTests.``All succeeds`` data.Value
+    }
+    testTask "CountAll succeeds" {
+        do! PageDataTests.``CountAll succeeds`` data.Value
+    }
+    testTask "CountListed succeeds" {
+        do! PageDataTests.``CountListed succeeds`` data.Value
+    }
+    testList "FindById" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindById succeeds when a page is found`` data.Value
+        }
+        testTask "succeeds when a page is not found (incorrect weblog)" {
+            do! PageDataTests.``FindById succeeds when a page is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a page is not found (bad page ID)" {
+            do! PageDataTests.``FindById succeeds when a page is not found (bad page ID)`` data.Value
+        }
+    ]
+    testList "FindByPermalink" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is found`` data.Value
+        }
+        testTask "succeeds when a page is not found (incorrect weblog)" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a page is not found (no such permalink)" {
+            do! PageDataTests.``FindByPermalink succeeds when a page is not found (no such permalink)`` data.Value
+        }
+    ]
+    testList "FindCurrentPermalink" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindCurrentPermalink succeeds when a page is found`` data.Value
+        }
+        testTask "succeeds when a page is not found" {
+            do! PageDataTests.``FindCurrentPermalink succeeds when a page is not found`` data.Value
+        }
+    ]
+    testList "FindFullById" [
+        testTask "succeeds when a page is found" {
+            do! PageDataTests.``FindFullById succeeds when a page is found`` data.Value
+        }
+        testTask "succeeds when a page is not found" {
+            do! PageDataTests.``FindFullById succeeds when a page is not found`` data.Value
+        }
+    ]
+    testList "FindFullByWebLog" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindFullByWebLog succeeds when pages are found`` data.Value
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindFullByWebLog succeeds when pages are not found`` data.Value
+        }
+    ]
+    testList "FindListed" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindListed succeeds when pages are found`` data.Value
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindListed succeeds when pages are not found`` data.Value
+        }
+    ]
+    testList "FindPageOfPages" [
+        testTask "succeeds when pages are found" {
+            do! PageDataTests.``FindPageOfPages succeeds when pages are found`` data.Value
+        }
+        testTask "succeeds when a pages are not found" {
+            do! PageDataTests.``FindPageOfPages succeeds when pages are not found`` data.Value
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the page exists" {
+            do! PageDataTests.``Update succeeds when the page exists`` data.Value
+        }
+        testTask "succeeds when the page does not exist" {
+            do! PageDataTests.``Update succeeds when the page does not exist`` data.Value
+        }
+    ]
+    testList "UpdatePriorPermalinks" [
+        testTask "succeeds when the page exists" {
+            do! PageDataTests.``UpdatePriorPermalinks succeeds when the page exists`` data.Value
+        }
+        testTask "succeeds when the page does not exist" {
+            do! PageDataTests.``UpdatePriorPermalinks succeeds when the page does not exist`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a page is deleted" {
+            do! PageDataTests.``Delete succeeds when a page is deleted`` data.Value
+        }
+        testTask "succeeds when a page is not deleted" {
+            do! PageDataTests.``Delete succeeds when a page is not deleted`` data.Value
+        }
+    ]
+]
+
+/// Integration tests for the Post implementation in RethinkDB
+let private postTests = testList "Post" [
+    testTask "Add succeeds" {
+        // We'll need the root website categories restored for these tests
+        do! freshEnvironment ()
+        do! PostDataTests.``Add succeeds`` data.Value
+    }
+    testTask "CountByStatus succeeds" {
+        do! PostDataTests.``CountByStatus succeeds`` data.Value
+    }
+    testList "FindById" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindById succeeds when a post is found`` data.Value
+        }
+        testTask "succeeds when a post is not found (incorrect weblog)" {
+            do! PostDataTests.``FindById succeeds when a post is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a post is not found (bad post ID)" {
+            do! PostDataTests.``FindById succeeds when a post is not found (bad post ID)`` data.Value
+        }
+    ]
+    testList "FindByPermalink" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is found`` data.Value
+        }
+        testTask "succeeds when a post is not found (incorrect weblog)" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a post is not found (no such permalink)" {
+            do! PostDataTests.``FindByPermalink succeeds when a post is not found (no such permalink)`` data.Value
+        }
+    ]
+    testList "FindCurrentPermalink" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindCurrentPermalink succeeds when a post is found`` data.Value
+        }
+        testTask "succeeds when a post is not found" {
+            do! PostDataTests.``FindCurrentPermalink succeeds when a post is not found`` data.Value
+        }
+    ]
+    testList "FindFullById" [
+        testTask "succeeds when a post is found" {
+            do! PostDataTests.``FindFullById succeeds when a post is found`` data.Value
+        }
+        testTask "succeeds when a post is not found" {
+            do! PostDataTests.``FindFullById succeeds when a post is not found`` data.Value
+        }
+    ]
+    testList "FindFullByWebLog" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindFullByWebLog succeeds when posts are found`` data.Value
+        }
+        testTask "succeeds when a posts are not found" {
+            do! PostDataTests.``FindFullByWebLog succeeds when posts are not found`` data.Value
+        }
+    ]
+    testList "FindPageOfCategorizedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when posts are found`` data.Value
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when finding a too-high page number`` data.Value
+        }
+        testTask "succeeds when a category has no posts" {
+            do! PostDataTests.``FindPageOfCategorizedPosts succeeds when a category has no posts`` data.Value
+        }
+    ]
+    testList "FindPageOfPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfPosts succeeds when posts are found`` data.Value
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfPosts succeeds when finding a too-high page number`` data.Value
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfPosts succeeds when there are no posts`` data.Value
+        }
+    ]
+    testList "FindPageOfPublishedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when posts are found`` data.Value
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when finding a too-high page number`` data.Value
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfPublishedPosts succeeds when there are no posts`` data.Value
+        }
+    ]
+    testList "FindPageOfTaggedPosts" [
+        testTask "succeeds when posts are found" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when posts are found`` data.Value
+        }
+        testTask "succeeds when posts are found (excluding drafts)" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when posts are found (excluding drafts)`` data.Value
+        }
+        testTask "succeeds when finding a too-high page number" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when finding a too-high page number`` data.Value
+        }
+        testTask "succeeds when there are no posts" {
+            do! PostDataTests.``FindPageOfTaggedPosts succeeds when there are no posts`` data.Value
+        }
+    ]
+    testList "FindSurroundingPosts" [
+        testTask "succeeds when there is no next newer post" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when there is no next newer post`` data.Value
+        }
+        testTask "succeeds when there is no next older post" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when there is no next older post`` data.Value
+        }
+        testTask "succeeds when older and newer exist" {
+            do! PostDataTests.``FindSurroundingPosts succeeds when older and newer exist`` data.Value
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the post exists" {
+            do! PostDataTests.``Update succeeds when the post exists`` data.Value
+        }
+        testTask "succeeds when the post does not exist" {
+            do! PostDataTests.``Update succeeds when the post does not exist`` data.Value
+        }
+    ]
+    testList "UpdatePriorPermalinks" [
+        testTask "succeeds when the post exists" {
+            do! PostDataTests.``UpdatePriorPermalinks succeeds when the post exists`` data.Value
+        }
+        testTask "succeeds when the post does not exist" {
+            do! PostDataTests.``UpdatePriorPermalinks succeeds when the post does not exist`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a post is deleted" {
+            do! PostDataTests.``Delete succeeds when a post is deleted`` data.Value
+        }
+        testTask "succeeds when a post is not deleted" {
+            do! PostDataTests.``Delete succeeds when a post is not deleted`` data.Value
+        }
+    ]
+]
+
+let private tagMapTests = testList "TagMap" [
+    testList "FindById" [
+        testTask "succeeds when a tag mapping is found" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is found`` data.Value
+        }
+        testTask "succeeds when a tag mapping is not found (incorrect weblog)" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a tag mapping is not found (bad tag map ID)" {
+            do! TagMapDataTests.``FindById succeeds when a tag mapping is not found (bad tag map ID)`` data.Value
+        }
+    ]
+    testList "FindByUrlValue" [
+        testTask "succeeds when a tag mapping is found" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is found`` data.Value
+        }
+        testTask "succeeds when a tag mapping is not found (incorrect weblog)" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is not found (incorrect weblog)``
+                    data.Value
+        }
+        testTask "succeeds when a tag mapping is not found (no such value)" {
+            do! TagMapDataTests.``FindByUrlValue succeeds when a tag mapping is not found (no such value)`` data.Value
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when tag mappings are found" {
+            do! TagMapDataTests.``FindByWebLog succeeds when tag mappings are found`` data.Value
+        }
+        testTask "succeeds when no tag mappings are found" {
+            do! TagMapDataTests.``FindByWebLog succeeds when no tag mappings are found`` data.Value
+        }
+    ]
+    testList "FindMappingForTags" [
+        testTask "succeeds when mappings exist" {
+            do! TagMapDataTests.``FindMappingForTags succeeds when mappings exist`` data.Value
+        }
+        testTask "succeeds when no mappings exist" {
+            do! TagMapDataTests.``FindMappingForTags succeeds when no mappings exist`` data.Value
+        }
+    ]
+    testList "Save" [
+        testTask "succeeds when adding a tag mapping" {
+            do! TagMapDataTests.``Save succeeds when adding a tag mapping`` data.Value
+        }
+        testTask "succeeds when updating a tag mapping" {
+            do! TagMapDataTests.``Save succeeds when updating a tag mapping`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a tag mapping is deleted" {
+            do! TagMapDataTests.``Delete succeeds when a tag mapping is deleted`` data.Value
+        }
+        testTask "succeeds when a tag mapping is not deleted" {
+            do! TagMapDataTests.``Delete succeeds when a tag mapping is not deleted`` data.Value
+        }
+    ]
+]
+
+let private themeTests = testList "Theme" [
+    testTask "All succeeds" {
+        do! ThemeDataTests.``All succeeds`` data.Value
+    }
+    testList "Exists" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``Exists succeeds when the theme exists`` data.Value
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``Exists succeeds when the theme does not exist`` data.Value
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``FindById succeeds when the theme exists`` data.Value
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``FindById succeeds when the theme does not exist`` data.Value
+        }
+    ]
+    testList "FindByIdWithoutText" [
+        testTask "succeeds when the theme exists" {
+            do! ThemeDataTests.``FindByIdWithoutText succeeds when the theme exists`` data.Value
+        }
+        testTask "succeeds when the theme does not exist" {
+            do! ThemeDataTests.``FindByIdWithoutText succeeds when the theme does not exist`` data.Value
+        }
+    ]
+    testList "Save" [
+        testTask "succeeds when adding a theme" {
+            do! ThemeDataTests.``Save succeeds when adding a theme`` data.Value
+        }
+        testTask "succeeds when updating a theme" {
+            do! ThemeDataTests.``Save succeeds when updating a theme`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when a theme is deleted" {
+            do! ThemeDataTests.``Delete succeeds when a theme is deleted`` data.Value
+        }
+        testTask "succeeds when a theme is not deleted" {
+            do! ThemeDataTests.``Delete succeeds when a theme is not deleted`` data.Value
+        }
+    ]
+]
+
+let private themeAssetTests = testList "ThemeAsset" [
+    testList "Save" [
+        testTask "succeeds when adding an asset" {
+            do! ThemeDataTests.Asset.``Save succeeds when adding an asset`` data.Value
+        }
+        testTask "succeeds when updating an asset" {
+            do! ThemeDataTests.Asset.``Save succeeds when updating an asset`` data.Value
+        }
+    ]
+    testTask "All succeeds" {
+        do! ThemeDataTests.Asset.``All succeeds`` data.Value
+    }
+    testList "FindById" [
+        testTask "succeeds when an asset is found" {
+            do! ThemeDataTests.Asset.``FindById succeeds when an asset is found`` data.Value
+        }
+        testTask "succeeds when an asset is not found" {
+            do! ThemeDataTests.Asset.``FindById succeeds when an asset is not found`` data.Value
+        }
+    ]
+    testList "FindByTheme" [
+        testTask "succeeds when assets exist" {
+            do! ThemeDataTests.Asset.``FindByTheme succeeds when assets exist`` data.Value
+        }
+        testTask "succeeds when assets do not exist" {
+            do! ThemeDataTests.Asset.``FindByTheme succeeds when assets do not exist`` data.Value
+        }
+    ]
+    testList "FindByThemeWithData" [
+        testTask "succeeds when assets exist" {
+            do! ThemeDataTests.Asset.``FindByThemeWithData succeeds when assets exist`` data.Value
+        }
+        testTask "succeeds when assets do not exist" {
+            do! ThemeDataTests.Asset.``FindByThemeWithData succeeds when assets do not exist`` data.Value
+        }
+    ]
+    testList "DeleteByTheme" [
+        testTask "succeeds when assets are deleted" {
+            do! ThemeDataTests.Asset.``DeleteByTheme succeeds when assets are deleted`` data.Value
+        }
+        testTask "succeeds when no assets are deleted" {
+            do! ThemeDataTests.Asset.``DeleteByTheme succeeds when no assets are deleted`` data.Value
+        }
+    ]
+]
+
+let private uploadTests = testList "Upload" [
+    testTask "Add succeeds" {
+        do! UploadDataTests.``Add succeeds`` data.Value
+    }
+    testList "FindByPath" [
+        testTask "succeeds when an upload is found" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is found`` data.Value
+        }
+        testTask "succeeds when an upload is not found (incorrect weblog)" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when an upload is not found (bad path)" {
+            do! UploadDataTests.``FindByPath succeeds when an upload is not found (bad path)`` data.Value
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when uploads exist" {
+            do! UploadDataTests.``FindByWebLog succeeds when uploads exist`` data.Value
+        }
+        testTask "succeeds when no uploads exist" {
+            do! UploadDataTests.``FindByWebLog succeeds when no uploads exist`` data.Value
+        }
+    ]
+    testList "FindByWebLogWithData" [
+        testTask "succeeds when uploads exist" {
+            do! UploadDataTests.``FindByWebLogWithData succeeds when uploads exist`` data.Value
+        }
+        testTask "succeeds when no uploads exist" {
+            do! UploadDataTests.``FindByWebLogWithData succeeds when no uploads exist`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when an upload is deleted" {
+            do! UploadDataTests.``Delete succeeds when an upload is deleted`` data.Value
+        }
+        testTask "succeeds when an upload is not deleted" {
+            do! UploadDataTests.``Delete succeeds when an upload is not deleted`` data.Value
+        }
+    ]
+]
+
+let private webLogUserTests = testList "WebLogUser" [
+    testTask "Add succeeds" {
+        // This restore ensures all the posts and pages exist
+        do! freshEnvironment ()
+        do! WebLogUserDataTests.``Add succeeds`` data.Value
+    }
+    testList "FindByEmail" [
+        testTask "succeeds when a user is found" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is found`` data.Value
+        }
+        testTask "succeeds when a user is not found (incorrect weblog)" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a user is not found (bad email)" {
+            do! WebLogUserDataTests.``FindByEmail succeeds when a user is not found (bad email)`` data.Value
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when a user is found" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is found`` data.Value
+        }
+        testTask "succeeds when a user is not found (incorrect weblog)" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is not found (incorrect weblog)`` data.Value
+        }
+        testTask "succeeds when a user is not found (bad ID)" {
+            do! WebLogUserDataTests.``FindById succeeds when a user is not found (bad ID)`` data.Value
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when users exist" {
+            do! WebLogUserDataTests.``FindByWebLog succeeds when users exist`` data.Value
+        }
+        testTask "succeeds when no users exist" {
+            do! WebLogUserDataTests.``FindByWebLog succeeds when no users exist`` data.Value
+        }
+    ]
+    testList "FindNames" [
+        testTask "succeeds when users exist" {
+            do! WebLogUserDataTests.``FindNames succeeds when users exist`` data.Value
+        }
+        testTask "succeeds when users do not exist" {
+            do! WebLogUserDataTests.``FindNames succeeds when users do not exist`` data.Value
+        }
+    ]
+    testList "SetLastSeen" [
+        testTask "succeeds when the user exists" {
+            do! WebLogUserDataTests.``SetLastSeen succeeds when the user exists`` data.Value
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``SetLastSeen succeeds when the user does not exist`` data.Value
+        }
+    ]
+    testList "Update" [
+        testTask "succeeds when the user exists" {
+            do! WebLogUserDataTests.``Update succeeds when the user exists`` data.Value
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``Update succeeds when the user does not exist`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "fails when the user is the author of a page" {
+            do! WebLogUserDataTests.``Delete fails when the user is the author of a page`` data.Value
+        }
+        testTask "fails when the user is the author of a post" {
+            do! WebLogUserDataTests.``Delete fails when the user is the author of a post`` data.Value
+        }
+        testTask "succeeds when the user is not an author" {
+            do! WebLogUserDataTests.``Delete succeeds when the user is not an author`` data.Value
+        }
+        testTask "succeeds when the user does not exist" {
+            do! WebLogUserDataTests.``Delete succeeds when the user does not exist`` data.Value
+        }
+    ]
+]
+
+let private webLogTests = testList "WebLog" [
+    testTask "Add succeeds" {
+        do! WebLogDataTests.``Add succeeds`` data.Value
+    }
+    testTask "All succeeds" {
+        do! WebLogDataTests.``All succeeds`` data.Value
+    }
+    testList "FindByHost" [
+        testTask "succeeds when a web log is found" {
+            do! WebLogDataTests.``FindByHost succeeds when a web log is found`` data.Value
+        }
+        testTask "succeeds when a web log is not found" {
+            do! WebLogDataTests.``FindByHost succeeds when a web log is not found`` data.Value
+        }
+    ]
+    testList "FindById" [
+        testTask "succeeds when a web log is found" {
+            do! WebLogDataTests.``FindById succeeds when a web log is found`` data.Value
+        }
+        testTask "succeeds when a web log is not found" {
+            do! WebLogDataTests.``FindById succeeds when a web log is not found`` data.Value
+        }
+    ]
+    testList "UpdateRedirectRules" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateRedirectRules succeeds when the web log exists`` data.Value
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateRedirectRules succeeds when the web log does not exist`` data.Value
+        }
+    ]
+    testList "UpdateRssOptions" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateRssOptions succeeds when the web log exists`` data.Value
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateRssOptions succeeds when the web log does not exist`` data.Value
+        }
+    ]
+    testList "UpdateSettings" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``UpdateSettings succeeds when the web log exists`` data.Value
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``UpdateSettings succeeds when the web log does not exist`` data.Value
+        }
+    ]
+    testList "Delete" [
+        testTask "succeeds when the web log exists" {
+            do! WebLogDataTests.``Delete succeeds when the web log exists`` data.Value
+        }
+        testTask "succeeds when the web log does not exist" {
+            do! WebLogDataTests.``Delete succeeds when the web log does not exist`` data.Value
+        }
+    ]
+]
+
+/// Drop the throwaway RethinkDB database
+let private environmentCleanUp = testTask "Clean Up" {
+    do! disposeData ()
+}
+
+/// All RethinkDB data tests
+let all =
+    testList "RethinkDbData"
+        [ environmentSetUp
+          categoryTests
+          pageTests
+          postTests
+          tagMapTests
+          themeTests
+          themeAssetTests
+          uploadTests
+          webLogUserTests
+          webLogTests
+          environmentCleanUp ]
+    |> testSequenced

src/MyWebLog.Tests/Data/TagMapDataTests.fs

@@ -0,0 +1,112 @@
+/// <summary>
+/// Integration tests for <see cref="ITagMapData" /> implementations
+/// </summary> 
+module TagMapDataTests
+
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+/// The ID of the f# tag
+let private fSharpId = TagMapId "Icm027noqE-rPHKZA98vAw"
+
+/// The ID of the ghoti tag
+let private fishId = TagMapId "GdryXh-S0kGsNBs2RIacGA"
+
+let ``FindById succeeds when a tag mapping is found`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindById fSharpId rootId
+    Expect.isSome tagMap "There should have been a tag mapping returned"
+    let tag = tagMap.Value
+    Expect.equal tag.Id fSharpId "ID is incorrect"
+    Expect.equal tag.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal tag.Tag "f#" "Tag is incorrect"
+    Expect.equal tag.UrlValue "f-sharp" "URL value is incorrect"
+}
+
+let ``FindById succeeds when a tag mapping is not found (incorrect weblog)`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindById fSharpId (WebLogId "wrong")
+    Expect.isNone tagMap "There should not have been a tag mapping returned"
+}
+
+let ``FindById succeeds when a tag mapping is not found (bad tag map ID)`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindById (TagMapId "out") rootId
+    Expect.isNone tagMap "There should not have been a tag mapping returned"
+}
+
+let ``FindByUrlValue succeeds when a tag mapping is found`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindByUrlValue "f-sharp" rootId
+    Expect.isSome tagMap "There should have been a tag mapping returned"
+    Expect.equal tagMap.Value.Id fSharpId "ID is incorrect"
+}
+
+let ``FindByUrlValue succeeds when a tag mapping is not found (incorrect weblog)`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindByUrlValue "f-sharp" (WebLogId "incorrect")
+    Expect.isNone tagMap "There should not have been a tag mapping returned"
+}
+
+let ``FindByUrlValue succeeds when a tag mapping is not found (no such value)`` (data: IData) = task {
+    let! tagMap = data.TagMap.FindByUrlValue "c-sharp" rootId
+    Expect.isNone tagMap "There should not have been a tag mapping returned"
+}
+
+let ``FindByWebLog succeeds when tag mappings are found`` (data: IData) = task {
+    let! mappings = data.TagMap.FindByWebLog rootId
+    Expect.hasLength mappings 2 "There should have been 2 tag mappings returned"
+    for mapping in mappings do
+        Expect.contains [ fSharpId; fishId ] mapping.Id $"Unexpected mapping ID ({mapping.Id})"
+        Expect.equal mapping.WebLogId rootId "Web log ID is incorrect"
+        Expect.isNotEmpty mapping.Tag "Tag should not have been blank"
+        Expect.isNotEmpty mapping.UrlValue "URL value should not have been blank"
+}
+
+let ``FindByWebLog succeeds when no tag mappings are found`` (data: IData) = task {
+    let! mappings = data.TagMap.FindByWebLog (WebLogId "no-maps")
+    Expect.isEmpty mappings "There should have been no tag mappings returned"
+}
+
+let ``FindMappingForTags succeeds when mappings exist`` (data: IData) = task {
+    let! mappings = data.TagMap.FindMappingForTags [ "f#"; "testing"; "unit" ] rootId
+    Expect.hasLength mappings 1 "There should have been one mapping returned"
+    Expect.equal mappings[0].Id fSharpId "The wrong mapping was returned"
+}
+
+let ``FindMappingForTags succeeds when no mappings exist`` (data: IData) = task {
+    let! mappings = data.TagMap.FindMappingForTags [ "c#"; "turkey"; "ham" ] rootId
+    Expect.isEmpty mappings "There should have been no tag mappings returned"
+}
+
+let ``Save succeeds when adding a tag mapping`` (data: IData) = task {
+    let mapId = TagMapId "test"
+    do! data.TagMap.Save { Id = mapId; WebLogId = rootId; Tag = "c#"; UrlValue = "c-sharp" }
+    let! mapping = data.TagMap.FindById mapId rootId
+    Expect.isSome mapping "The mapping should have been retrieved"
+    let tag = mapping.Value
+    Expect.equal tag.Id mapId "ID is incorrect"
+    Expect.equal tag.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal tag.Tag "c#" "Tag is incorrect"
+    Expect.equal tag.UrlValue "c-sharp" "URL value is incorrect"
+}
+
+let ``Save succeeds when updating a tag mapping`` (data: IData) = task {
+    do! data.TagMap.Save { Id = fishId; WebLogId = rootId; Tag = "halibut"; UrlValue = "mackerel" }
+    let! mapping = data.TagMap.FindById fishId rootId
+    Expect.isSome mapping "The mapping should have been retrieved"
+    let tag = mapping.Value
+    Expect.equal tag.Id fishId "ID is incorrect"
+    Expect.equal tag.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal tag.Tag "halibut" "Tag is incorrect"
+    Expect.equal tag.UrlValue "mackerel" "URL value is incorrect"
+}
+
+let ``Delete succeeds when a tag mapping is deleted`` (data: IData) = task {
+    let! deleted = data.TagMap.Delete fSharpId rootId
+    Expect.isTrue deleted "The tag mapping should have been deleted"
+}
+
+let ``Delete succeeds when a tag mapping is not deleted`` (data: IData) = task {
+    let! deleted = data.TagMap.Delete fSharpId rootId // this was deleted above
+    Expect.isFalse deleted "A tag mapping should not have been deleted"
+}

src/MyWebLog.Tests/Data/ThemeDataTests.fs

@@ -0,0 +1,234 @@
+/// <summary>
+/// Integration tests for <see cref="IThemeData" /> implementations
+/// </summary> 
+module ThemeDataTests
+
+open System.IO
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// The ID of the default theme (restored from root-weblog.json)
+let private defaultId = ThemeId "default"
+
+/// The ID of the test theme loaded and manipulated by these tests
+let private testId = ThemeId "test-theme"
+
+/// The dark version of the myWebLog logo
+let private darkFile = File.ReadAllBytes "../admin-theme/wwwroot/logo-dark.png"
+
+/// The light version of the myWebLog logo
+let private lightFile = File.ReadAllBytes "../admin-theme/wwwroot/logo-light.png"
+
+/// Ensure that theme templates do not have any text
+let private ensureNoText theme =
+    for template in theme.Templates do
+        Expect.equal template.Text "" $"Text for template {template.Name} should have been blank"
+
+let ``All succeeds`` (data: IData) = task {
+    let! themes = data.Theme.All()
+    Expect.hasLength themes 1 "There should have been one theme returned"
+    Expect.equal themes[0].Id defaultId "ID was incorrect"
+    Expect.equal themes[0].Name "myWebLog Default Theme" "Name was incorrect"
+    Expect.equal themes[0].Version "2.1.0" "Version was incorrect"
+    ensureNoText themes[0]
+}
+
+let ``Exists succeeds when the theme exists`` (data: IData) = task {
+    let! exists = data.Theme.Exists defaultId
+    Expect.isTrue exists "The \"default\" theme should have existed"
+}
+
+let ``Exists succeeds when the theme does not exist`` (data: IData) = task {
+    let! exists = data.Theme.Exists (ThemeId "fancy")
+    Expect.isFalse exists "The \"fancy\" theme should not have existed"
+}
+
+let ``FindById succeeds when the theme exists`` (data: IData) = task {
+    let! theme = data.Theme.FindById defaultId
+    Expect.isSome theme "The theme should have been found"
+    let it = theme.Value
+    Expect.equal it.Id defaultId "ID was incorrect"
+    Expect.equal it.Name "myWebLog Default Theme" "Name was incorrect"
+    Expect.equal it.Version "2.1.0" "Version was incorrect"
+    for template in it.Templates do
+        Expect.isNotEmpty template.Text $"Text for template {template.Name} should not have been blank"
+}
+
+let ``FindById succeeds when the theme does not exist`` (data: IData) = task {
+    let! theme = data.Theme.FindById (ThemeId "missing")
+    Expect.isNone theme "There should not have been a theme found"
+}
+
+let ``FindByIdWithoutText succeeds when the theme exists`` (data: IData) = task {
+    let! theme = data.Theme.FindByIdWithoutText defaultId
+    Expect.isSome theme "The theme should have been found"
+    let it = theme.Value
+    Expect.equal it.Id defaultId "ID was incorrect"
+    ensureNoText it
+}
+
+let ``FindByIdWithoutText succeeds when the theme does not exist`` (data: IData) = task {
+    let! theme = data.Theme.FindByIdWithoutText (ThemeId "ornate")
+    Expect.isNone theme "There should not have been a theme found"
+}
+
+let ``Save succeeds when adding a theme`` (data: IData) = task {
+    do! data.Theme.Save
+            { Id        = testId
+              Name      = "Test Theme"
+              Version   = "evergreen"
+              Templates =
+                  [ { Name = "index"; Text = "<h1>{{ values_here }}</h1>" }
+                    { Name = "single-post"; Text = "<p>{{ the_post }}" } ] }
+    let! saved = data.Theme.FindById testId
+    Expect.isSome saved "There should have been a theme returned"
+    let it = saved.Value
+    Expect.equal it.Id testId "ID was incorrect"
+    Expect.equal it.Name "Test Theme" "Name was incorrect"
+    Expect.equal it.Version "evergreen" "Version was incorrect"
+    Expect.hasLength it.Templates 2 "There should have been 2 templates"
+    Expect.equal it.Templates[0].Name "index" "Template 0 name incorrect"
+    Expect.equal it.Templates[0].Text "<h1>{{ values_here }}</h1>" "Template 0 text incorrect"
+    Expect.equal it.Templates[1].Name "single-post" "Template 1 name incorrect"
+    Expect.equal it.Templates[1].Text "<p>{{ the_post }}" "Template 1 text incorrect"
+}
+
+let ``Save succeeds when updating a theme`` (data: IData) = task {
+    do! data.Theme.Save
+            { Id        = testId
+              Name      = "Updated Theme"
+              Version   = "still evergreen"
+              Templates =
+                  [ { Name = "index"; Text = "<h1>{{ values_there }}</h1>" }
+                    { Name = "layout"; Text = "<!DOCTYPE html><etc />" }
+                    { Name = "single-post"; Text = "<p>{{ the_post }}" } ] }
+    let! updated = data.Theme.FindById testId
+    Expect.isSome updated "The updated theme should have been returned"
+    let it = updated.Value
+    Expect.equal it.Id testId "ID was incorrect"
+    Expect.equal it.Name "Updated Theme" "Name was incorrect"
+    Expect.equal it.Version "still evergreen" "Version was incorrect"
+    Expect.hasLength it.Templates 3 "There should have been 3 templates"
+    Expect.equal it.Templates[0].Name "index" "Template 0 name incorrect"
+    Expect.equal it.Templates[0].Text "<h1>{{ values_there }}</h1>" "Template 0 text incorrect"
+    Expect.equal it.Templates[1].Name "layout" "Template 1 name incorrect"
+    Expect.equal it.Templates[1].Text "<!DOCTYPE html><etc />" "Template 1 text incorrect"
+    Expect.equal it.Templates[2].Name "single-post" "Template 2 name incorrect"
+    Expect.equal it.Templates[2].Text "<p>{{ the_post }}" "Template 2 text incorrect"
+}
+
+let ``Delete succeeds when a theme is deleted`` (data: IData) = task {
+    // Delete should also delete assets associated with the theme
+    do! data.ThemeAsset.Save { Id = ThemeAssetId (testId, "logo-dark.png");  UpdatedOn = Noda.epoch; Data = darkFile  }
+    do! data.ThemeAsset.Save { Id = ThemeAssetId (testId, "logo-light.png"); UpdatedOn = Noda.epoch; Data = lightFile }
+    let! deleted = data.Theme.Delete testId
+    Expect.isTrue deleted "The theme should have been deleted"
+    let! assets = data.ThemeAsset.FindByTheme testId
+    Expect.isEmpty assets "The theme's assets should have been deleted"
+}
+
+let ``Delete succeeds when a theme is not deleted`` (data: IData) = task {
+    let! deleted = data.Theme.Delete (ThemeId "test-theme") // already deleted above
+    Expect.isFalse deleted "The theme should not have been deleted"
+}
+
+/// <summary>
+/// Integration tests for <see cref="IThemeAssetData" /> implementations
+/// </summary> 
+module Asset =
+    
+    /// The theme ID for which assets will be tested
+    let private assetThemeId = ThemeId "asset-test"
+    
+    /// The asset ID for the dark logo
+    let private darkId = ThemeAssetId (assetThemeId, "logo-dark.png")
+    
+    /// The asset ID for the light logo
+    let private lightId = ThemeAssetId (assetThemeId, "logo-light.png")
+    
+    let ``Save succeeds when adding an asset`` (data: IData) = task {
+        do! data.Theme.Save { Theme.Empty with Id = assetThemeId }
+        do! data.ThemeAsset.Save { Id = lightId; UpdatedOn = Noda.epoch + Duration.FromDays 18; Data = lightFile }
+        let! asset = data.ThemeAsset.FindById lightId
+        Expect.isSome asset "The asset should have been found"
+        let it = asset.Value
+        Expect.equal it.Id lightId "ID was incorrect"
+        Expect.equal it.UpdatedOn (Noda.epoch + Duration.FromDays 18) "Updated on was incorrect"
+        Expect.equal it.Data lightFile "Data was incorrect"
+    }
+    
+    let ``Save succeeds when updating an asset`` (data: IData) = task {
+        do! data.ThemeAsset.Save { Id = lightId; UpdatedOn = Noda.epoch + Duration.FromDays 20; Data = darkFile }
+        let! asset = data.ThemeAsset.FindById lightId
+        Expect.isSome asset "The asset should have been found"
+        let it = asset.Value
+        Expect.equal it.Id lightId "ID was incorrect"
+        Expect.equal it.UpdatedOn (Noda.epoch + Duration.FromDays 20) "Updated on was incorrect"
+        Expect.equal it.Data darkFile "Data was incorrect"
+    }
+    
+    let ``All succeeds`` (data: IData) = task {
+        let! all = data.ThemeAsset.All()
+        Expect.hasLength all 2 "There should have been 2 assets retrieved"
+        for asset in all do
+            Expect.contains
+                [ ThemeAssetId (defaultId, "style.css"); lightId ] asset.Id $"Unexpected asset found ({asset.Id})"
+            Expect.isEmpty asset.Data $"Asset {asset.Id} should not have had data"
+    }
+    
+    let ``FindById succeeds when an asset is found`` (data: IData) = task {
+        let! asset = data.ThemeAsset.FindById lightId
+        Expect.isSome asset "The asset should have been found"
+        let it = asset.Value
+        Expect.equal it.Id lightId "ID was incorrect"
+        Expect.equal it.UpdatedOn (Noda.epoch + Duration.FromDays 20) "Updated on was incorrect"
+        Expect.equal it.Data darkFile "Data was incorrect"
+    }
+    
+    let ``FindById succeeds when an asset is not found`` (data: IData) = task {
+        let! asset = data.ThemeAsset.FindById (ThemeAssetId (assetThemeId, "404.jpg"))
+        Expect.isNone asset "There should not have been an asset returned"
+    }
+    
+    let ``FindByTheme succeeds when assets exist`` (data: IData) = task {
+        do! data.ThemeAsset.Save { Id = darkId;  UpdatedOn = Noda.epoch; Data = darkFile  }
+        do! data.ThemeAsset.Save { Id = lightId; UpdatedOn = Noda.epoch; Data = lightFile }
+        let! assets = data.ThemeAsset.FindByTheme assetThemeId
+        Expect.hasLength assets 2 "There should have been 2 assets returned"
+        for asset in assets do
+            Expect.contains [ darkId; lightId ] asset.Id $"Unexpected asset found ({asset.Id})"
+            Expect.equal asset.UpdatedOn Noda.epoch $"Updated on was incorrect ({asset.Id})"
+            Expect.isEmpty asset.Data $"Data should not have been retrieved ({asset.Id})"
+    }
+    
+    let ``FindByTheme succeeds when assets do not exist`` (data: IData) = task {
+        let! assets = data.ThemeAsset.FindByTheme (ThemeId "no-assets-here")
+        Expect.isEmpty assets "There should have been no assets returned"
+    }
+    
+    let ``FindByThemeWithData succeeds when assets exist`` (data: IData) = task {
+        let! assets = data.ThemeAsset.FindByThemeWithData assetThemeId
+        Expect.hasLength assets 2 "There should have been 2 assets returned"
+        let darkLogo = assets |> List.find (fun it -> it.Id = darkId)
+        Expect.equal darkLogo.Data darkFile "The dark asset's data is incorrect"
+        let lightLogo = assets |> List.find (fun it -> it.Id = lightId)
+        Expect.equal lightLogo.Data lightFile "The light asset's data is incorrect"
+    }
+    
+    let ``FindByThemeWithData succeeds when assets do not exist`` (data: IData) = task {
+        let! assets = data.ThemeAsset.FindByThemeWithData (ThemeId "still-no-assets")
+        Expect.isEmpty assets "There should have been no assets returned"
+    }
+    
+    let ``DeleteByTheme succeeds when assets are deleted`` (data: IData) = task {
+        do! data.ThemeAsset.DeleteByTheme assetThemeId
+        let! assets = data.ThemeAsset.FindByTheme assetThemeId
+        Expect.isEmpty assets "There should be no assets remaining"
+    }
+    
+    let ``DeleteByTheme succeeds when no assets are deleted`` (data: IData) = task {
+        do! data.ThemeAsset.DeleteByTheme assetThemeId // already deleted above
+        Expect.isTrue true "The above did not raise an exception; that's the test"
+    }

src/MyWebLog.Tests/Data/UploadDataTests.fs

@@ -0,0 +1,95 @@
+/// <summary>
+/// Integration tests for <see cref="IUploadData" /> implementations
+/// </summary> 
+module UploadDataTests
+
+open System
+open System.IO
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+/// The ID of the favicon upload
+let private faviconId = UploadId "XweKbWQiOkqqrjEdgP9wwg"
+
+let ``Add succeeds`` (data: IData) = task {
+    let file = File.ReadAllBytes "../admin-theme/wwwroot/logo-dark.png"
+    do! data.Upload.Add
+            { Id        = UploadId "new-upload"
+              WebLogId  = rootId
+              UpdatedOn = Noda.epoch + Duration.FromDays 30
+              Path      = Permalink "1970/01/logo-dark.png"
+              Data      = file }
+    let! added = data.Upload.FindByPath "1970/01/logo-dark.png" rootId
+    Expect.isSome added "There should have been an upload returned"
+    let upload = added.Value
+    Expect.equal upload.Id (UploadId "new-upload") "ID is incorrect"
+    Expect.equal upload.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal upload.UpdatedOn (Noda.epoch + Duration.FromDays 30) "Updated on is incorrect"
+    Expect.equal upload.Path (Permalink "1970/01/logo-dark.png") "Path is incorrect"
+    Expect.equal upload.Data file "Data is incorrect"
+}
+
+let ``FindByPath succeeds when an upload is found`` (data: IData) = task {
+    let! upload = data.Upload.FindByPath "2022/06/favicon.ico" rootId
+    Expect.isSome upload "There should have been an upload returned"
+    let it = upload.Value
+    Expect.equal it.Id faviconId "ID is incorrect"
+    Expect.equal it.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal
+        it.UpdatedOn (Instant.FromDateTimeOffset(DateTimeOffset.Parse "2022-06-23T21:15:40Z")) "Updated on is incorrect"
+    Expect.equal it.Path (Permalink "2022/06/favicon.ico") "Path is incorrect"
+    Expect.isNonEmpty it.Data "Data should have been retrieved"
+}
+
+let ``FindByPath succeeds when an upload is not found (incorrect weblog)`` (data: IData) = task {
+    let! upload = data.Upload.FindByPath "2022/06/favicon.ico" (WebLogId "wrong")
+    Expect.isNone upload "There should not have been an upload returned"
+}
+
+let ``FindByPath succeeds when an upload is not found (bad path)`` (data: IData) = task {
+    let! upload = data.Upload.FindByPath "2022/07/favicon.ico" rootId
+    Expect.isNone upload "There should not have been an upload returned"
+}
+
+let ``FindByWebLog succeeds when uploads exist`` (data: IData) = task {
+    let! uploads = data.Upload.FindByWebLog rootId
+    Expect.hasLength uploads 2 "There should have been 2 uploads returned"
+    for upload in uploads do
+        Expect.contains [ faviconId; UploadId "new-upload" ] upload.Id $"Unexpected upload returned ({upload.Id})"
+        Expect.isEmpty upload.Data $"Upload should not have had its data ({upload.Id})"
+}
+
+let ``FindByWebLog succeeds when no uploads exist`` (data: IData) = task {
+    let! uploads = data.Upload.FindByWebLog (WebLogId "nothing")
+    Expect.isEmpty uploads "There should have been no uploads returned"
+}
+
+let ``FindByWebLogWithData succeeds when uploads exist`` (data: IData) = task {
+    let! uploads = data.Upload.FindByWebLogWithData rootId
+    Expect.hasLength uploads 2 "There should have been 2 uploads returned"
+    for upload in uploads do
+        Expect.contains [ faviconId; UploadId "new-upload" ] upload.Id $"Unexpected upload returned ({upload.Id})"
+        Expect.isNonEmpty upload.Data $"Upload should have had its data ({upload.Id})"
+}
+
+let ``FindByWebLogWithData succeeds when no uploads exist`` (data: IData) = task {
+    let! uploads = data.Upload.FindByWebLogWithData (WebLogId "data-nope")
+    Expect.isEmpty uploads "There should have been no uploads returned"
+}
+
+let ``Delete succeeds when an upload is deleted`` (data: IData) = task {
+    match! data.Upload.Delete faviconId rootId with
+    | Ok path -> Expect.equal path "2022/06/favicon.ico" "The path of the deleted upload was incorrect"
+    | Error it -> Expect.isTrue false $"Upload deletion should have succeeded (message {it})"
+}
+
+let ``Delete succeeds when an upload is not deleted`` (data: IData) = task {
+    match! data.Upload.Delete faviconId rootId with
+    | Ok it -> Expect.isTrue false $"Upload deletion should not have succeeded (path {it})"
+    | Error msg -> Expect.equal msg $"Upload ID {faviconId} not found" "Error message was incorrect"
+}

src/MyWebLog.Tests/Data/UtilsTests.fs

@@ -0,0 +1,96 @@
+module UtilsTests
+
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// Unit tests for the orderByHierarchy function
+let orderByHierarchyTests = test "orderByHierarchy succeeds" {
+    let rawCats =
+        [ { Category.Empty with Id = CategoryId "a"; Name = "Audio"; Slug = "audio"; ParentId = Some (CategoryId "p") }
+          { Category.Empty with
+              Id          = CategoryId "b"
+              Name        = "Breaking"
+              Description = Some "Breaking News" 
+              Slug        = "breaking"
+              ParentId    = Some (CategoryId "n") }
+          { Category.Empty with Id = CategoryId "l"; Name = "Local"; Slug = "local"; ParentId = Some (CategoryId "b") }
+          { Category.Empty with Id = CategoryId "n"; Name = "News"; Slug = "news" }
+          { Category.Empty with Id = CategoryId "p"; Name = "Podcast"; Slug = "podcast" }
+          { Category.Empty with Id = CategoryId "v"; Name = "Video"; Slug = "vid"; ParentId = Some (CategoryId "p") } ]
+    let cats = Utils.orderByHierarchy rawCats None None [] |> List.ofSeq
+    Expect.equal cats.Length 6 "There should have been 6 categories"
+    Expect.equal cats[0].Id "n" "The first top-level category should have been News"
+    Expect.equal cats[0].Slug "news" "Slug for News not filled properly"
+    Expect.isEmpty cats[0].ParentNames "Parent names for News not filled properly"
+    Expect.equal cats[1].Id "b" "Breaking should have been just below News"
+    Expect.equal cats[1].Slug "news/breaking" "Slug for Breaking not filled properly"
+    Expect.equal cats[1].Name "Breaking" "Name not filled properly"
+    Expect.equal cats[1].Description (Some "Breaking News") "Description not filled properly"
+    Expect.equal cats[1].ParentNames [| "News" |] "Parent names for Breaking not filled properly"
+    Expect.equal cats[2].Id "l" "Local should have been just below Breaking"
+    Expect.equal cats[2].Slug "news/breaking/local" "Slug for Local not filled properly"
+    Expect.equal cats[2].ParentNames [| "News"; "Breaking" |] "Parent names for Local not filled properly"
+    Expect.equal cats[3].Id "p" "Podcast should have been the next top-level category"
+    Expect.equal cats[3].Slug "podcast" "Slug for Podcast not filled properly"
+    Expect.isEmpty cats[3].ParentNames "Parent names for Podcast not filled properly"
+    Expect.equal cats[4].Id "a" "Audio should have been just below Podcast"
+    Expect.equal cats[4].Slug "podcast/audio" "Slug for Audio not filled properly"
+    Expect.equal cats[4].ParentNames [| "Podcast" |] "Parent names for Audio not filled properly"
+    Expect.equal cats[5].Id "v" "Video should have been below Audio"
+    Expect.equal cats[5].Slug "podcast/vid" "Slug for Video not filled properly"
+    Expect.equal cats[5].ParentNames [| "Podcast" |] "Parent names for Video not filled properly"
+    Expect.hasCountOf cats 6u (fun it -> it.PostCount = 0) "All post counts should have been 0"
+}
+
+/// Unit tests for the diffLists function
+let diffListsTests = testList "diffLists" [
+    test "succeeds with identical lists" {
+        let removed, added = Utils.diffLists [ 1; 2; 3 ] [ 1; 2; 3 ] id
+        Expect.isEmpty removed "There should have been no removed items returned"
+        Expect.isEmpty added "There should have been no added items returned"
+    }
+    test "succeeds with differing lists" {
+        let removed, added = Utils.diffLists [ 1; 2; 3 ] [ 3; 4; 5 ] string
+        Expect.equal removed [ 1; 2 ] "Removed items incorrect"
+        Expect.equal added [ 4; 5 ] "Added items incorrect"
+    }
+]
+
+/// Unit tests for the diffRevisions function
+let diffRevisionsTests = testList "diffRevisions" [
+    test "succeeds with identical lists" {
+        let oldItems =
+            [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<p>test" }
+              { AsOf = Noda.epoch; Text = Html "<p>test test" } ]
+        let newItems =
+            [ { AsOf = Noda.epoch; Text = Html "<p>test test" }
+              { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<p>test" } ]
+        let removed, added = Utils.diffRevisions oldItems newItems
+        Expect.isEmpty removed "There should have been no removed items returned"
+        Expect.isEmpty added "There should have been no added items returned"
+    }
+    test "succeeds with differing lists" {
+        let oldItems =
+            [ { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<p>test" }
+              { AsOf = Noda.epoch + Duration.FromDays 2; Text = Html "<p>tests" }
+              { AsOf = Noda.epoch; Text = Html "<p>test test" } ]
+        let newItems =
+            [ { AsOf = Noda.epoch + Duration.FromDays 4; Text = Html "<p>tests" }
+              { AsOf = Noda.epoch + Duration.FromDays 3; Text = Html "<p>test" }
+              { AsOf = Noda.epoch; Text = Html "<p>test test" } ]
+        let removed, added = Utils.diffRevisions oldItems newItems
+        Expect.equal removed.Length 1 "There should be 1 removed item"
+        Expect.equal removed[0].AsOf (Noda.epoch + Duration.FromDays 2) "Expected removed item incorrect"
+        Expect.equal added.Length 1 "There should be 1 added item"
+        Expect.equal added[0].AsOf (Noda.epoch + Duration.FromDays 4) "Expected added item incorrect"
+    }
+]
+
+/// All tests for the Utils file
+let all = testList "Utils" [
+    orderByHierarchyTests
+    diffListsTests
+    diffRevisionsTests
+]

src/MyWebLog.Tests/Data/WebLogDataTests.fs

@@ -0,0 +1,198 @@
+/// <summary>
+/// Integration tests for <see cref="IWebLogData" /> implementations
+/// </summary> 
+module WebLogDataTests
+
+open System
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+let ``Add succeeds`` (data: IData) = task {
+    do! data.WebLog.Add
+            { Id            = WebLogId "new-weblog"
+              Name          = "Test Web Log"
+              Slug          = "test-web-log"
+              Subtitle      = None
+              DefaultPage   = ""
+              PostsPerPage  = 7
+              ThemeId       = ThemeId "default"
+              UrlBase       = "https://example.com/new"
+              TimeZone      = "America/Los_Angeles"
+              Rss           =
+                  { IsFeedEnabled     = true
+                    FeedName          = "my-feed.xml"
+                    ItemsInFeed       = None 
+                    IsCategoryEnabled = false
+                    IsTagEnabled      = false
+                    Copyright         = Some "go for it"
+                    CustomFeeds       = [] }
+              AutoHtmx      = true
+              Uploads       = Disk
+              RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ] }
+    let! webLog = data.WebLog.FindById (WebLogId "new-weblog")
+    Expect.isSome webLog "The web log should have been returned"
+    let it = webLog.Value
+    Expect.equal it.Id (WebLogId "new-weblog") "ID is incorrect"
+    Expect.equal it.Name "Test Web Log" "Name is incorrect"
+    Expect.equal it.Slug "test-web-log" "Slug is incorrect"
+    Expect.isNone it.Subtitle "Subtitle is incorrect"
+    Expect.equal it.DefaultPage "" "Default page is incorrect"
+    Expect.equal it.PostsPerPage 7 "Posts per page is incorrect"
+    Expect.equal it.ThemeId (ThemeId "default") "Theme ID is incorrect"
+    Expect.equal it.UrlBase "https://example.com/new" "URL base is incorrect"
+    Expect.equal it.TimeZone "America/Los_Angeles" "Time zone is incorrect"
+    Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
+    Expect.equal it.Uploads Disk "Upload destination is incorrect"
+    Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect"
+    let rss = it.Rss
+    Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect"
+    Expect.equal rss.FeedName "my-feed.xml" "Feed name is incorrect"
+    Expect.isNone rss.ItemsInFeed "Items in feed is incorrect"
+    Expect.isFalse rss.IsCategoryEnabled "Is category enabled flag is incorrect"
+    Expect.isFalse rss.IsTagEnabled "Is tag enabled flag is incorrect"
+    Expect.equal rss.Copyright (Some "go for it") "Copyright is incorrect"
+    Expect.isEmpty rss.CustomFeeds "Custom feeds are incorrect"
+}
+
+let ``All succeeds`` (data: IData) = task {
+    let! webLogs = data.WebLog.All()
+    Expect.hasLength webLogs 2 "There should have been 2 web logs returned"
+    for webLog in webLogs do
+        Expect.contains [ rootId; WebLogId "new-weblog" ] webLog.Id $"Unexpected web log returned ({webLog.Id})"
+}
+
+let ``FindByHost succeeds when a web log is found`` (data: IData) = task {
+    let! webLog = data.WebLog.FindByHost "http://localhost:8081"
+    Expect.isSome webLog "A web log should have been returned"
+    Expect.equal webLog.Value.Id rootId "The wrong web log was returned"
+}
+
+let ``FindByHost succeeds when a web log is not found`` (data: IData) = task {
+    let! webLog = data.WebLog.FindByHost "https://test.units"
+    Expect.isNone webLog "There should not have been a web log returned"
+}
+
+let ``FindById succeeds when a web log is found`` (data: IData) = task {
+    let! webLog = data.WebLog.FindById rootId
+    Expect.isSome webLog "There should have been a web log returned"
+    let it = webLog.Value
+    Expect.equal it.Id rootId "ID is incorrect"
+    Expect.equal it.Name "Root WebLog" "Name is incorrect"
+    Expect.equal it.Slug "root-weblog" "Slug is incorrect"
+    Expect.equal it.Subtitle (Some "This is the main one") "Subtitle is incorrect"
+    Expect.equal it.DefaultPage "posts" "Default page is incorrect"
+    Expect.equal it.PostsPerPage 9 "Posts per page is incorrect"
+    Expect.equal it.ThemeId (ThemeId "default") "Theme ID is incorrect"
+    Expect.equal it.UrlBase "http://localhost:8081" "URL base is incorrect"
+    Expect.equal it.TimeZone "America/Denver" "Time zone is incorrect"
+    Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
+    Expect.equal it.Uploads Database "Upload destination is incorrect"
+    Expect.isEmpty it.RedirectRules "Redirect rules are incorrect"
+    let rss = it.Rss
+    Expect.isTrue rss.IsFeedEnabled "Is feed enabled flag is incorrect"
+    Expect.equal rss.FeedName "feed" "Feed name is incorrect"
+    Expect.equal rss.ItemsInFeed (Some 7) "Items in feed is incorrect"
+    Expect.isTrue rss.IsCategoryEnabled "Is category enabled flag is incorrect"
+    Expect.isTrue rss.IsTagEnabled "Is tag enabled flag is incorrect"
+    Expect.equal rss.Copyright (Some "CC40-NC-BY") "Copyright is incorrect"
+    Expect.hasLength rss.CustomFeeds 1 "There should be 1 custom feed"
+    Expect.equal rss.CustomFeeds[0].Id (CustomFeedId "isPQ6drbDEydxohQzaiYtQ") "Custom feed ID incorrect"
+    Expect.equal rss.CustomFeeds[0].Source (Tag "podcast") "Custom feed source is incorrect"
+    Expect.equal rss.CustomFeeds[0].Path (Permalink "podcast-feed") "Custom feed path is incorrect"
+    Expect.isSome rss.CustomFeeds[0].Podcast "There should be podcast settings for this custom feed"
+    let pod = rss.CustomFeeds[0].Podcast.Value
+    Expect.equal pod.Title "Root Podcast" "Podcast title is incorrect"
+    Expect.equal pod.ItemsInFeed 23 "Podcast items in feed is incorrect"
+    Expect.equal pod.Summary "All things that happen in the domain root" "Podcast summary is incorrect"
+    Expect.equal pod.DisplayedAuthor "Podcaster Extraordinaire" "Podcast author is incorrect"
+    Expect.equal pod.Email "podcaster@example.com" "Podcast e-mail is incorrect"
+    Expect.equal pod.ImageUrl (Permalink "images/cover-art.png") "Podcast image URL is incorrect"
+    Expect.equal pod.AppleCategory "Fiction" "Podcast Apple category is incorrect"
+    Expect.equal pod.AppleSubcategory (Some "Drama") "Podcast Apple subcategory is incorrect"
+    Expect.equal pod.Explicit No "Podcast explicit rating is incorrect"
+    Expect.equal pod.DefaultMediaType (Some "audio/mpeg") "Podcast default media type is incorrect"
+    Expect.equal pod.MediaBaseUrl (Some "https://media.example.com/root/") "Podcast media base URL is incorrect"
+    Expect.equal pod.PodcastGuid (Some (Guid.Parse "10fd7f79-c719-4e1d-9da7-10405dd4fd96")) "Podcast GUID is incorrect"
+    Expect.equal pod.FundingUrl (Some "https://example.com/support-us") "Podcast funding URL is incorrect"
+    Expect.equal pod.FundingText (Some "Support Our Work") "Podcast funding text is incorrect"
+    Expect.equal pod.Medium (Some Newsletter) "Podcast medium is incorrect"
+}
+
+let ``FindById succeeds when a web log is not found`` (data: IData) = task {
+    let! webLog = data.WebLog.FindById (WebLogId "no-web-log")
+    Expect.isNone webLog "There should not have been a web log returned"
+}
+
+let ``UpdateRedirectRules succeeds when the web log exists`` (data: IData) = task {
+    let! webLog = data.WebLog.FindById (WebLogId "new-weblog")
+    Expect.isSome webLog "The test web log should have been returned"
+    do! data.WebLog.UpdateRedirectRules
+            { webLog.Value with
+                RedirectRules = { From = "/now"; To = "/later"; IsRegex = false } :: webLog.Value.RedirectRules }
+    let! updated = data.WebLog.FindById (WebLogId "new-weblog")
+    Expect.isSome updated "The updated web log should have been returned"
+    Expect.equal
+        updated.Value.RedirectRules
+        [ { From = "/now"; To = "/later"; IsRegex = false }; { From = "/here"; To = "/there"; IsRegex = false } ]
+        "Redirect rules not updated correctly"
+}
+
+let ``UpdateRedirectRules succeeds when the web log does not exist`` (data: IData) = task {
+    do! data.WebLog.UpdateRedirectRules { WebLog.Empty with Id = WebLogId "no-rules" }
+    Expect.isTrue true "This not raising an exception is the test"
+}
+
+let ``UpdateRssOptions succeeds when the web log exists`` (data: IData) = task {
+    let! webLog = data.WebLog.FindById rootId
+    Expect.isSome webLog "The root web log should have been returned"
+    do! data.WebLog.UpdateRssOptions { webLog.Value with Rss = { webLog.Value.Rss with CustomFeeds = [] } }
+    let! updated = data.WebLog.FindById rootId
+    Expect.isSome updated "The updated web log should have been returned"
+    Expect.isEmpty updated.Value.Rss.CustomFeeds "RSS options not updated correctly"
+}
+
+let ``UpdateRssOptions succeeds when the web log does not exist`` (data: IData) = task {
+    do! data.WebLog.UpdateRssOptions { WebLog.Empty with Id = WebLogId "rss-less" }
+    Expect.isTrue true "This not raising an exception is the test"
+}
+
+let ``UpdateSettings succeeds when the web log exists`` (data: IData) = task {
+    let! webLog = data.WebLog.FindById rootId
+    Expect.isSome webLog "The root web log should have been returned"
+    do! data.WebLog.UpdateSettings { webLog.Value with AutoHtmx = false; Subtitle = None }
+    let! updated = data.WebLog.FindById rootId
+    Expect.isSome updated "The updated web log should have been returned"
+    Expect.isFalse updated.Value.AutoHtmx "Auto htmx flag not updated correctly"
+    Expect.isNone updated.Value.Subtitle "Subtitle not updated correctly"
+}
+
+let ``UpdateSettings succeeds when the web log does not exist`` (data: IData) = task {
+    do! data.WebLog.UpdateRedirectRules { WebLog.Empty with Id = WebLogId "no-settings" }
+    let! webLog = data.WebLog.FindById (WebLogId "no-settings")
+    Expect.isNone webLog "Updating settings should not have created a web log"
+}
+
+let ``Delete succeeds when the web log exists`` (data: IData) = task {
+    do! data.WebLog.Delete rootId
+    let! cats = data.Category.FindByWebLog rootId
+    Expect.isEmpty cats "There should be no categories remaining"
+    let! pages = data.Page.FindFullByWebLog rootId
+    Expect.isEmpty pages "There should be no pages remaining"
+    let! posts = data.Post.FindFullByWebLog rootId
+    Expect.isEmpty posts "There should be no posts remaining"
+    let! tagMappings = data.TagMap.FindByWebLog rootId
+    Expect.isEmpty tagMappings "There should be no tag mappings remaining"
+    let! uploads = data.Upload.FindByWebLog rootId
+    Expect.isEmpty uploads "There should be no uploads remaining"
+    let! users = data.WebLogUser.FindByWebLog rootId
+    Expect.isEmpty users "There should be no users remaining"
+}
+
+let ``Delete succeeds when the web log does not exist`` (data: IData) = task {
+    do! data.WebLog.Delete rootId // already deleted above
+    Expect.isTrue true "This not raising an exception is the test"
+}

src/MyWebLog.Tests/Data/WebLogUserDataTests.fs

@@ -0,0 +1,184 @@
+/// <summary>
+/// Integration tests for <see cref="IWebLogUserData" /> implementations
+/// </summary> 
+module WebLogUserDataTests
+
+open Expecto
+open MyWebLog
+open MyWebLog.Data
+open NodaTime
+
+/// The ID of the root web log
+let private rootId = CategoryDataTests.rootId
+
+/// The ID of the admin user
+let private adminId = WebLogUserId "5EM2rimH9kONpmd2zQkiVA"
+
+/// The ID of the editor user
+let private editorId = WebLogUserId "GPbJaSOwTkKt14ZKYyveKA"
+
+/// The ID of the author user
+let private authorId = WebLogUserId "iIRNLSeY0EanxRPyqGuwVg"
+
+/// The ID of the user added during the run of these tests
+let private newId = WebLogUserId "new-user"
+
+let ``Add succeeds`` (data: IData) = task {
+    do! data.WebLogUser.Add
+            { Id            = newId
+              WebLogId      = rootId
+              Email         = "new@example.com"
+              FirstName     = "New"
+              LastName      = "User"
+              PreferredName = "n00b"
+              PasswordHash  = "hashed-password"
+              Url           = Some "https://example.com/~new"
+              AccessLevel   = Author
+              CreatedOn     = Noda.epoch + Duration.FromDays 365
+              LastSeenOn    = None }
+    let! user = data.WebLogUser.FindById newId rootId
+    Expect.isSome user "There should have been a user returned"
+    let it = user.Value
+    Expect.equal it.Id newId "ID is incorrect"
+    Expect.equal it.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal it.Email "new@example.com" "E-mail address is incorrect"
+    Expect.equal it.FirstName "New" "First name is incorrect"
+    Expect.equal it.LastName "User" "Last name is incorrect"
+    Expect.equal it.PreferredName "n00b" "Preferred name is incorrect"
+    Expect.equal it.PasswordHash "hashed-password" "Password hash is incorrect"
+    Expect.equal it.Url (Some "https://example.com/~new") "URL is incorrect"
+    Expect.equal it.AccessLevel Author "Access level is incorrect"
+    Expect.equal it.CreatedOn (Noda.epoch + Duration.FromDays 365) "Created on is incorrect"
+    Expect.isNone it.LastSeenOn "Last seen on should not have had a value"
+}
+
+let ``FindByEmail succeeds when a user is found`` (data: IData) = task {
+    let! user = data.WebLogUser.FindByEmail "root@example.com" rootId
+    Expect.isSome user "There should have been a user returned"
+    Expect.equal user.Value.Id adminId "The wrong user was returned"
+}
+
+let ``FindByEmail succeeds when a user is not found (incorrect weblog)`` (data: IData) = task {
+    let! user = data.WebLogUser.FindByEmail "root@example.com" (WebLogId "other")
+    Expect.isNone user "There should not have been a user returned"
+}
+
+let ``FindByEmail succeeds when a user is not found (bad email)`` (data: IData) = task {
+    let! user = data.WebLogUser.FindByEmail "wwwdata@example.com" rootId
+    Expect.isNone user "There should not have been a user returned"
+}
+
+let ``FindById succeeds when a user is found`` (data: IData) = task {
+    let! user = data.WebLogUser.FindById adminId rootId
+    Expect.isSome user "There should have been a user returned"
+    Expect.equal user.Value.Id adminId "The wrong user was returned"
+    // The remainder of field population is tested in the "Add succeeds" test above
+}
+
+let ``FindById succeeds when a user is not found (incorrect weblog)`` (data: IData) = task {
+    let! user = data.WebLogUser.FindById adminId (WebLogId "not-admin")
+    Expect.isNone user "There should not have been a user returned"
+}
+
+let ``FindById succeeds when a user is not found (bad ID)`` (data: IData) = task {
+    let! user = data.WebLogUser.FindById (WebLogUserId "tom") rootId
+    Expect.isNone user "There should not have been a user returned"
+}
+
+let ``FindByWebLog succeeds when users exist`` (data: IData) = task {
+    let! users = data.WebLogUser.FindByWebLog rootId
+    Expect.hasLength users 4 "There should have been 4 users returned"
+    for user in users do
+        Expect.contains [ adminId; editorId; authorId; newId ] user.Id $"Unexpected user returned ({user.Id})"
+}
+
+let ``FindByWebLog succeeds when no users exist`` (data: IData) = task {
+    let! users = data.WebLogUser.FindByWebLog (WebLogId "no-users")
+    Expect.isEmpty users "There should have been no users returned"
+}
+
+let ``FindNames succeeds when users exist`` (data: IData) = task {
+    let! names = data.WebLogUser.FindNames rootId [ editorId; authorId ]
+    let expected =
+        [ { Name = string editorId; Value = "Edits It-Or" }; { Name = string authorId; Value = "Mister Dude" } ]
+    Expect.hasLength names 2 "There should have been 2 names returned"
+    for name in names do Expect.contains expected name $"Unexpected name returned ({name.Name}|{name.Value})"
+}
+
+let ``FindNames succeeds when users do not exist`` (data: IData) = task {
+    let! names = data.WebLogUser.FindNames rootId [ WebLogUserId "nope"; WebLogUserId "no" ]
+    Expect.isEmpty names "There should have been no names returned"
+}
+
+let ``SetLastSeen succeeds when the user exists`` (data: IData) = task {
+    let now = Noda.now ()
+    do! data.WebLogUser.SetLastSeen newId rootId
+    let! user = data.WebLogUser.FindById newId rootId
+    Expect.isSome user "The user should have been returned"
+    let it = user.Value
+    Expect.isSome it.LastSeenOn "Last seen on should have been set"
+    Expect.isGreaterThanOrEqual it.LastSeenOn.Value now "The last seen on date/time was not set correctly"
+}
+
+let ``SetLastSeen succeeds when the user does not exist`` (data: IData) = task {
+    do! data.WebLogUser.SetLastSeen (WebLogUserId "matt") rootId
+    Expect.isTrue true "This not raising an exception is the test"
+}
+
+let ``Update succeeds when the user exists`` (data: IData) = task {
+    let! currentUser = data.WebLogUser.FindById newId rootId
+    Expect.isSome currentUser "The current user should have been found"
+    do! data.WebLogUser.Update
+            { currentUser.Value with
+                Email         = "newish@example.com"
+                FirstName     = "New-ish"
+                LastName      = "User-ish"
+                PreferredName = "n00b-ish"
+                PasswordHash  = "hashed-ish-password"
+                Url           = None
+                AccessLevel   = Editor }
+    let! updated = data.WebLogUser.FindById newId rootId
+    Expect.isSome updated "The updated user should have been returned"
+    let it = updated.Value
+    Expect.equal it.Id newId "ID is incorrect"
+    Expect.equal it.WebLogId rootId "Web log ID is incorrect"
+    Expect.equal it.Email "newish@example.com" "E-mail address is incorrect"
+    Expect.equal it.FirstName "New-ish" "First name is incorrect"
+    Expect.equal it.LastName "User-ish" "Last name is incorrect"
+    Expect.equal it.PreferredName "n00b-ish" "Preferred name is incorrect"
+    Expect.equal it.PasswordHash "hashed-ish-password" "Password hash is incorrect"
+    Expect.isNone it.Url "URL is incorrect"
+    Expect.equal it.AccessLevel Editor "Access level is incorrect"
+    Expect.equal it.CreatedOn (Noda.epoch + Duration.FromDays 365) "Created on is incorrect"
+    Expect.isSome it.LastSeenOn "Last seen on should have had a value"
+}
+
+let ``Update succeeds when the user does not exist`` (data: IData) = task {
+    do! data.WebLogUser.Update { WebLogUser.Empty with Id = WebLogUserId "nothing"; WebLogId = rootId }
+    let! updated = data.WebLogUser.FindById (WebLogUserId "nothing") rootId
+    Expect.isNone updated "The update of a missing user should not have created the user"
+}
+
+let ``Delete fails when the user is the author of a page`` (data: IData) = task {
+    match! data.WebLogUser.Delete adminId rootId with
+    | Ok _ -> Expect.isTrue false "Deletion should have failed because the user is a page author"
+    | Error msg -> Expect.equal msg "User has pages or posts; cannot delete" "Error message is incorrect"
+}
+
+let ``Delete fails when the user is the author of a post`` (data: IData) = task {
+    match! data.WebLogUser.Delete authorId rootId with
+    | Ok _ -> Expect.isTrue false "Deletion should have failed because the user is a post author"
+    | Error msg -> Expect.equal msg "User has pages or posts; cannot delete" "Error message is incorrect"
+}
+
+let ``Delete succeeds when the user is not an author`` (data: IData) = task {
+    match! data.WebLogUser.Delete newId rootId with
+    | Ok _ -> Expect.isTrue true "This is the expected outcome"
+    | Error msg -> Expect.isTrue false $"Deletion unexpectedly failed (message {msg})"
+}
+
+let ``Delete succeeds when the user does not exist`` (data: IData) = task {
+    match! data.WebLogUser.Delete newId rootId with // already deleted above
+    | Ok _ -> Expect.isTrue false "Deletion should have failed because the user does not exist"
+    | Error msg -> Expect.equal msg "User does not exist" "Error message is incorrect"
+}

src/MyWebLog.Tests/Domain/DataTypesTests.fs

@@ -0,0 +1,87 @@
+module DataTypesTests
+
+open Expecto
+open MyWebLog
+
+/// Unit tests for the WebLog type
+let webLogTests = testList "WebLog" [
+    testList "ExtraPath" [
+        test "succeeds for blank URL base" {
+            Expect.equal WebLog.Empty.ExtraPath "" "Extra path should have been blank for blank URL base"
+        }
+        test "succeeds for domain root URL" {
+            Expect.equal
+                { WebLog.Empty with UrlBase = "https://example.com" }.ExtraPath
+                ""
+                "Extra path should have been blank for domain root"
+        }
+        test "succeeds for single subdirectory" {
+            Expect.equal
+                { WebLog.Empty with UrlBase = "https://a.com/sub" }.ExtraPath
+                "/sub"
+                "Extra path incorrect for a single subdirectory"
+        }
+        test "succeeds for deeper nesting" {
+            Expect.equal
+                { WebLog.Empty with UrlBase = "https://b.com/users/test/units" }.ExtraPath
+                "/users/test/units"
+                "Extra path incorrect for deeper nesting"
+        }
+    ]
+    test "AbsoluteUrl succeeds" {
+        Expect.equal
+            ({ WebLog.Empty with UrlBase = "https://my.site" }.AbsoluteUrl(Permalink "blog/page.html"))
+            "https://my.site/blog/page.html"
+            "Absolute URL is incorrect"
+    }
+    testList "RelativeUrl" [
+        test "succeeds for domain root URL" {
+            Expect.equal
+                ({ WebLog.Empty with UrlBase = "https://test.me" }.RelativeUrl(Permalink "about.htm"))
+                "/about.htm"
+                "Relative URL is incorrect for domain root site"
+        }
+        test "succeeds for domain non-root URL" {
+            Expect.equal
+                ({ WebLog.Empty with UrlBase = "https://site.page/a/b/c" }.RelativeUrl(Permalink "x/y/z"))
+                "/a/b/c/x/y/z"
+                "Relative URL is incorrect for domain non-root site"
+        }
+    ]
+    testList "LocalTime" [
+        test "succeeds when no time zone is set" {
+            Expect.equal
+                (WebLog.Empty.LocalTime(Noda.epoch))
+                (Noda.epoch.ToDateTimeUtc())
+                "Reference should be UTC when no time zone is specified"
+        }
+        test "succeeds when time zone is set" {
+            Expect.equal
+                ({ WebLog.Empty with TimeZone = "Etc/GMT-1" }.LocalTime(Noda.epoch))
+                (Noda.epoch.ToDateTimeUtc().AddHours 1)
+                "The time should have been adjusted by one hour"
+        }
+    ]
+]
+
+/// Unit tests for the WebLogUser type
+let webLogUserTests = testList "WebLogUser" [
+    testList "DisplayName" [
+        test "succeeds when a preferred name is present" {
+            Expect.equal
+                { WebLogUser.Empty with
+                    FirstName = "Thomas"; PreferredName = "Tom"; LastName = "Tester" }.DisplayName
+                "Tom Tester"
+                "Display name incorrect when preferred name is present"
+        }
+        test "succeeds when a preferred name is absent" {
+            Expect.equal
+                { WebLogUser.Empty with FirstName = "Test"; LastName = "Units" }.DisplayName
+                "Test Units"
+                "Display name incorrect when preferred name is absent"
+        }
+    ]
+]
+
+/// All tests for the Domain.DataTypes file
+let all = testList "DataTypes" [ webLogTests; webLogUserTests ]

src/MyWebLog.Tests/Domain/SupportTypesTests.fs

@@ -0,0 +1,415 @@
+module SupportTypesTests
+
+open System
+open Expecto
+open MyWebLog
+open NodaTime
+
+/// Tests for the NodaTime-wrapping module
+let nodaTests = testList "Noda" [
+    test "epoch succeeds" {
+        Expect.equal
+            (Noda.epoch.ToDateTimeUtc())
+            (DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc))
+            "The Unix epoch value is not correct"
+    }
+    test "toSecondsPrecision succeeds" {
+        let testDate = Instant.FromDateTimeUtc(DateTime(1970, 1, 1, 0, 0, 0, 444, DateTimeKind.Utc))
+        // testDate.
+        Expect.equal
+            ((Noda.toSecondsPrecision testDate).ToDateTimeUtc())
+            (Noda.epoch.ToDateTimeUtc())
+            "Instant value was not rounded to seconds precision"
+    }
+    test "fromDateTime succeeds" {
+        let testDate = DateTime(1970, 1, 1, 0, 0, 0, 444, DateTimeKind.Utc)
+        Expect.equal (Noda.fromDateTime testDate) Noda.epoch "fromDateTime did not truncate to seconds"
+    }
+]
+
+/// Tests for the AccessLevel type
+let accessLevelTests = testList "AccessLevel" [
+    testList "Parse" [
+        test "succeeds for \"Author\"" {
+            Expect.equal Author (AccessLevel.Parse "Author") "Author not parsed correctly"
+        }
+        test "succeeds for \"Editor\"" {
+            Expect.equal Editor (AccessLevel.Parse "Editor") "Editor not parsed correctly"
+        }
+        test "succeeds for \"WebLogAdmin\"" {
+            Expect.equal WebLogAdmin (AccessLevel.Parse "WebLogAdmin") "WebLogAdmin not parsed correctly"
+        }
+        test "succeeds for \"Administrator\"" {
+            Expect.equal Administrator (AccessLevel.Parse "Administrator") "Administrator not parsed correctly"
+        }
+        test "fails when given an unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (AccessLevel.Parse "Hacker")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "Author succeeds" {
+            Expect.equal (string Author) "Author" "Author string incorrect"
+        }
+        test "Editor succeeds" {
+            Expect.equal (string Editor) "Editor" "Editor string incorrect"
+        }
+        test "WebLogAdmin succeeds" {
+            Expect.equal (string WebLogAdmin) "WebLogAdmin" "WebLogAdmin string incorrect"
+        }
+        test "Administrator succeeds" {
+            Expect.equal (string Administrator) "Administrator" "Administrator string incorrect"
+        }
+    ]
+    testList "HasAccess" [
+        test "Author has Author access" {
+            Expect.isTrue (Author.HasAccess Author) "Author should have Author access"
+        }
+        test "Author does not have Editor access" {
+            Expect.isFalse (Author.HasAccess Editor) "Author should not have Editor access"
+        }
+        test "Author does not have WebLogAdmin access" {
+            Expect.isFalse (Author.HasAccess WebLogAdmin) "Author should not have WebLogAdmin access"
+        }
+        test "Author does not have Administrator access" {
+            Expect.isFalse (Author.HasAccess Administrator) "Author should not have Administrator access"
+        }
+        test "Editor has Author access" {
+            Expect.isTrue (Editor.HasAccess Author) "Editor should have Author access"
+        }
+        test "Editor has Editor access" {
+            Expect.isTrue (Editor.HasAccess Editor) "Editor should have Editor access"
+        }
+        test "Editor does not have WebLogAdmin access" {
+            Expect.isFalse (Editor.HasAccess WebLogAdmin) "Editor should not have WebLogAdmin access"
+        }
+        test "Editor does not have Administrator access" {
+            Expect.isFalse (Editor.HasAccess Administrator) "Editor should not have Administrator access"
+        }
+        test "WebLogAdmin has Author access" {
+            Expect.isTrue (WebLogAdmin.HasAccess Author) "WebLogAdmin should have Author access"
+        }
+        test "WebLogAdmin has Editor access" {
+            Expect.isTrue (WebLogAdmin.HasAccess Editor) "WebLogAdmin should have Editor access"
+        }
+        test "WebLogAdmin has WebLogAdmin access" {
+            Expect.isTrue (WebLogAdmin.HasAccess WebLogAdmin) "WebLogAdmin should have WebLogAdmin access"
+        }
+        test "WebLogAdmin does not have Administrator access" {
+            Expect.isFalse (WebLogAdmin.HasAccess Administrator) "WebLogAdmin should not have Administrator access"
+        }
+        test "Administrator has Author access" {
+            Expect.isTrue (Administrator.HasAccess Author) "Administrator should have Author access"
+        }
+        test "Administrator has Editor access" {
+            Expect.isTrue (Administrator.HasAccess Editor) "Administrator should have Editor access"
+        }
+        test "Administrator has WebLogAdmin access" {
+            Expect.isTrue (Administrator.HasAccess WebLogAdmin) "Administrator should have WebLogAdmin access"
+        }
+        test "Administrator has Administrator access" {
+            Expect.isTrue (Administrator.HasAccess Administrator) "Administrator should have Administrator access"
+        }
+    ]
+]
+
+/// Tests for the CommentStatus type
+let commentStatusTests = testList "CommentStatus" [
+    testList "Parse" [
+        test "succeeds for \"Approved\"" {
+            Expect.equal Approved (CommentStatus.Parse "Approved") "Approved not parsed correctly"
+        }
+        test "succeeds for \"Pending\"" {
+            Expect.equal Pending (CommentStatus.Parse "Pending") "Pending not parsed correctly"
+        }
+        test "succeeds for \"Spam\"" {
+            Expect.equal Spam (CommentStatus.Parse "Spam") "Spam not parsed correctly"
+        }
+        test "fails for unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (CommentStatus.Parse "Live")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "Approved succeeds" {
+            Expect.equal (string Approved) "Approved" "Approved string incorrect"
+        }
+        test "Pending succeeds" {
+            Expect.equal (string Pending) "Pending" "Pending string incorrect"
+        }
+        test "Spam succeeds" {
+            Expect.equal (string Spam) "Spam" "Spam string incorrect"
+        }
+    ]
+]
+
+/// Tests for the ExplicitRating type
+let explicitRatingTests = testList "ExplicitRating" [
+    testList "Parse" [
+        test "succeeds for \"yes\"" {
+            Expect.equal Yes (ExplicitRating.Parse "yes") "\"yes\" not parsed correctly"
+        }
+        test "succeeds for \"no\"" {
+            Expect.equal No (ExplicitRating.Parse "no") "\"no\" not parsed correctly"
+        }
+        test "succeeds for \"clean\"" {
+            Expect.equal Clean (ExplicitRating.Parse "clean") "\"clean\" not parsed correctly"
+        }
+        test "fails for unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (ExplicitRating.Parse "maybe")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "Yes succeeds" {
+            Expect.equal (string Yes) "yes" "Yes string incorrect"
+        }
+        test "No succeeds" {
+            Expect.equal (string No) "no" "No string incorrect"
+        }
+        test "Clean succeeds" {
+            Expect.equal (string Clean) "clean" "Clean string incorrect"
+        }
+    ]
+]
+
+/// Tests for the Episode type
+let episodeTests = testList "Episode" [
+    testList "FormatDuration" [
+        test "succeeds when no duration is specified" {
+            Expect.isNone (Episode.Empty.FormatDuration()) "A missing duration should have returned None"
+        }
+        test "succeeds when duration is specified" {
+            Expect.equal
+                ({ Episode.Empty with
+                    Duration = Some (Duration.FromMinutes 3L + Duration.FromSeconds 13L) }.FormatDuration())
+                (Some "0:03:13")
+                "Duration not formatted correctly"
+        }
+        test "succeeds when duration is > 10 hours" {
+            Expect.equal
+                ({ Episode.Empty with Duration = Some (Duration.FromHours 11) }.FormatDuration())
+                (Some "11:00:00")
+                "Duration not formatted correctly"
+        }
+    ]
+]
+
+/// Unit tests for the MarkupText type
+let markupTextTests = testList "MarkupText" [
+    testList "Parse" [
+        test "succeeds with HTML content" {
+            let txt = MarkupText.Parse "HTML: <p>howdy</p>"
+            match txt with
+            | Html it when it = "<p>howdy</p>" -> ()
+            | _ -> Expect.isTrue false $"Unexpected parse result for HTML: %A{txt}"
+        }
+        test "succeeds with Markdown content" {
+            let txt = MarkupText.Parse "Markdown: # A Title"
+            match txt with
+            | Markdown it when it = "# A Title" -> ()
+            | _ -> Expect.isTrue false $"Unexpected parse result for Markdown: %A{txt}"
+        }
+        test "fails with unexpected content" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (MarkupText.Parse "LaTEX: nope")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "SourceType" [
+        test "succeeds for HTML" {
+            Expect.equal (MarkupText.Parse "HTML: something").SourceType "HTML" "HTML source type incorrect"
+        }
+        test "succeeds for Markdown" {
+            Expect.equal (MarkupText.Parse "Markdown: blah").SourceType "Markdown" "Markdown source type incorrect"
+        }
+    ]
+    testList "Text" [
+        test "succeeds for HTML" {
+            Expect.equal (MarkupText.Parse "HTML: test").Text "test" "HTML text incorrect"
+        }
+        test "succeeds for Markdown" {
+            Expect.equal (MarkupText.Parse "Markdown: test!").Text "test!" "Markdown text incorrect"
+        }
+    ]
+    testList "ToString" [
+        test "succeeds for HTML" {
+            Expect.equal
+                (string (MarkupText.Parse "HTML: <h1>HTML</h1>")) "HTML: <h1>HTML</h1>" "HTML string value incorrect"
+        }
+        test "succeeds for Markdown" {
+            Expect.equal
+                (string (MarkupText.Parse "Markdown: # Some Content"))
+                "Markdown: # Some Content"
+                "Markdown string value incorrect"
+        }
+    ]
+    testList "AsHtml" [
+        test "succeeds for HTML" {
+            Expect.equal
+                ((MarkupText.Parse "HTML: <h1>The Heading</h1>").AsHtml()) "<h1>The Heading</h1>" "HTML value incorrect"
+        }
+        test "succeeds for Markdown" {
+            Expect.equal
+                ((MarkupText.Parse "Markdown: *emphasis*").AsHtml())
+                "<p><em>emphasis</em></p>\n"
+                "Markdown HTML value incorrect"
+        }
+    ]
+]
+
+/// Unit tests for the PodcastMedium type
+let podcastMediumTests = testList "PodcastMedium" [
+    testList "Parse" [
+        test "succeeds for \"podcast\"" {
+            Expect.equal (PodcastMedium.Parse "podcast") Podcast "\"podcast\" not parsed correctly"
+        }
+        test "succeeds for \"music\"" {
+            Expect.equal (PodcastMedium.Parse "music") Music "\"music\" not parsed correctly"
+        }
+        test "succeeds for \"video\"" {
+            Expect.equal (PodcastMedium.Parse "video") Video "\"video\" not parsed correctly"
+        }
+        test "succeeds for \"film\"" {
+            Expect.equal (PodcastMedium.Parse "film") Film "\"film\" not parsed correctly"
+        }
+        test "succeeds for \"audiobook\"" {
+            Expect.equal (PodcastMedium.Parse "audiobook") Audiobook "\"audiobook\" not parsed correctly"
+        }
+        test "succeeds for \"newsletter\"" {
+            Expect.equal (PodcastMedium.Parse "newsletter") Newsletter "\"newsletter\" not parsed correctly"
+        }
+        test "succeeds for \"blog\"" {
+            Expect.equal (PodcastMedium.Parse "blog") Blog "\"blog\" not parsed correctly"
+        }
+        test "fails for invalid type" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (PodcastMedium.Parse "laser")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "succeeds for Podcast" {
+            Expect.equal (string Podcast) "podcast" "Podcast string incorrect"
+        }
+        test "succeeds for Music" {
+            Expect.equal (string Music) "music" "Music string incorrect"
+        }
+        test "succeeds for Video" {
+            Expect.equal (string Video) "video" "Video string incorrect"
+        }
+        test "succeeds for Film" {
+            Expect.equal (string Film) "film" "Film string incorrect"
+        }
+        test "succeeds for Audiobook" {
+            Expect.equal (string Audiobook) "audiobook" "Audiobook string incorrect"
+        }
+        test "succeeds for Newsletter" {
+            Expect.equal (string Newsletter) "newsletter" "Newsletter string incorrect"
+        }
+        test "succeeds for Blog" {
+            Expect.equal (string Blog) "blog" "Blog string incorrect"
+        }
+    ]
+]
+
+/// Unit tests for the PostStatus type
+let postStatusTests = testList "PostStatus" [
+    testList "Parse" [
+        test "succeeds for \"Draft\"" {
+            Expect.equal (PostStatus.Parse "Draft") Draft "\"Draft\" not parsed correctly"
+        }
+        test "succeeds for \"Published\"" {
+            Expect.equal (PostStatus.Parse "Published") Published "\"Published\" not parsed correctly"
+        }
+        test "fails for unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (PostStatus.Parse "Rescinded")) "Invalid value should have raised an exception"
+        }
+    ]
+]
+
+/// Unit tests for the CustomFeedSource type
+let customFeedSourceTests = testList "CustomFeedSource" [
+    testList "Parse" [
+        test "succeeds for category feeds" {
+            Expect.equal
+                (CustomFeedSource.Parse "category:abc123")
+                (Category (CategoryId "abc123"))
+                "Category feed not parsed correctly"
+        }
+        test "succeeds for tag feeds" {
+            Expect.equal (CustomFeedSource.Parse "tag:turtles") (Tag "turtles") "Tag feed not parsed correctly"
+        }
+        test "fails for unknown type" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (CustomFeedSource.Parse "nasa:sat1")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "succeeds for category feed" {
+            Expect.equal
+                (string (CustomFeedSource.Parse "category:fish")) "category:fish" "Category feed string incorrect"
+        }
+        test "succeeds for tag feed" {
+            Expect.equal (string (CustomFeedSource.Parse "tag:rocks")) "tag:rocks" "Tag feed string incorrect"
+        }
+    ]
+]
+
+/// Unit tests for the ThemeAssetId type
+let themeAssetIdTests = testList "ThemeAssetId" [
+    testList "Parse" [
+        test "succeeds with expected values" {
+            Expect.equal
+                (ThemeAssetId.Parse "test-theme/the-asset")
+                (ThemeAssetId ((ThemeId "test-theme"), "the-asset"))
+                "Theme asset ID not parsed correctly"
+        }
+        test "fails if no slash is present" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (ThemeAssetId.Parse "my-theme-asset")) "Invalid value should have raised an exception"
+        }
+    ]
+    test "ToString succeeds" {
+        Expect.equal
+            (string (ThemeAssetId ((ThemeId "howdy"), "pardner"))) "howdy/pardner" "Theme asset ID string incorrect"
+    }
+]
+
+/// Unit tests for the UploadDestination type
+let uploadDestinationTests = testList "UploadDestination" [
+    testList "Parse" [
+        test "succeeds for \"Database\"" {
+            Expect.equal (UploadDestination.Parse "Database") Database "\"Database\" not parsed correctly"
+        }
+        test "succeeds for \"Disk\"" {
+            Expect.equal (UploadDestination.Parse "Disk") Disk "\"Disk\" not parsed correctly"
+        }
+        test "fails for unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (UploadDestination.Parse "Azure")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "succeeds for Database" {
+            Expect.equal (string Database) "Database" "Database string incorrect"
+        }
+        test "succeeds for Disk" {
+            Expect.equal (string Disk) "Disk" "Disk string incorrect"
+        }
+    ]
+]
+
+/// All tests for the Domain.SupportTypes file
+let all = testList "SupportTypes" [
+    nodaTests
+    accessLevelTests
+    commentStatusTests
+    explicitRatingTests
+    episodeTests
+    markupTextTests
+    podcastMediumTests
+    postStatusTests
+    customFeedSourceTests
+    themeAssetIdTests
+    uploadDestinationTests
+]

src/MyWebLog.Tests/MyWebLog.Tests.fsproj

@@ -0,0 +1,38 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Domain\SupportTypesTests.fs" />
+    <Compile Include="Domain\DataTypesTests.fs" />
+    <Compile Include="Domain\ViewModelsTests.fs" />
+    <Compile Include="Data\ConvertersTests.fs" />
+    <Compile Include="Data\UtilsTests.fs" />
+    <Compile Include="Data\CategoryDataTests.fs" />
+    <Compile Include="Data\PageDataTests.fs" />
+    <Compile Include="Data\PostDataTests.fs" />
+    <Compile Include="Data\TagMapDataTests.fs" />
+    <Compile Include="Data\ThemeDataTests.fs" />
+    <Compile Include="Data\UploadDataTests.fs" />
+    <Compile Include="Data\WebLogUserDataTests.fs" />
+    <Compile Include="Data\WebLogDataTests.fs" />
+    <Compile Include="Data\RethinkDbDataTests.fs" />
+    <Compile Include="Data\SQLiteDataTests.fs" />
+    <Compile Include="Data\PostgresDataTests.fs" />
+    <Compile Include="Program.fs" />
+    <None Include="root-weblog.json" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Expecto" Version="10.2.1" />
+    <PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
+    <PackageReference Update="FSharp.Core" Version="8.0.200" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="..\MyWebLog\MyWebLog.fsproj" />
+  </ItemGroup>
+
+</Project>

src/MyWebLog.Tests/Program.fs

@@ -0,0 +1,31 @@
+open Expecto
+
+/// Whether to only run RethinkDB data tests
+let rethinkOnly = (RethinkDbDataTests.env "RETHINK_ONLY" "0") = "1"
+
+/// Whether to only run SQLite data tests
+let sqliteOnly = (RethinkDbDataTests.env "SQLITE_ONLY" "0") = "1"
+
+/// Whether to only run PostgreSQL data tests
+let postgresOnly = (RethinkDbDataTests.env "PG_ONLY" "0") = "1"
+
+/// Whether any of the data tests are being isolated
+let dbOnly = rethinkOnly || sqliteOnly || postgresOnly
+
+/// Whether to only run the unit tests (skip database/integration tests)
+let unitOnly = (RethinkDbDataTests.env "UNIT_ONLY" "0") = "1"
+
+let allTests = testList "MyWebLog" [
+    if not dbOnly then testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ]
+    if not unitOnly then
+        testList "Data" [
+            if not dbOnly then ConvertersTests.all
+            if not dbOnly then UtilsTests.all
+            if not dbOnly || (dbOnly && rethinkOnly)  then RethinkDbDataTests.all
+            if not dbOnly || (dbOnly && sqliteOnly)   then SQLiteDataTests.all
+            if not dbOnly || (dbOnly && postgresOnly) then PostgresDataTests.all
+        ]
+]
+
+[<EntryPoint>]
+let main args = runTestsWithCLIArgs [] args allTests

src/MyWebLog.sln

@@ -9,6 +9,8 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyWebLog.Data", "MyWebLog.D
 EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog", "MyWebLog\MyWebLog.fsproj", "{5655B63D-429F-4CCD-A14C-FBD74D987ECB}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyWebLog.Tests", "MyWebLog.Tests\MyWebLog.Tests.fsproj", "{D927D39F-26EC-4A54-989A-9D474F232398}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -27,6 +29,10 @@ Global
 		{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{5655B63D-429F-4CCD-A14C-FBD74D987ECB}.Release|Any CPU.Build.0 = Release|Any CPU
+		{D927D39F-26EC-4A54-989A-9D474F232398}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{D927D39F-26EC-4A54-989A-9D474F232398}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{D927D39F-26EC-4A54-989A-9D474F232398}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{D927D39F-26EC-4A54-989A-9D474F232398}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE

src/MyWebLog/Caches.fs

@@ -42,7 +42,7 @@ module Extensions =
         member this.UserAccessLevel =
             this.User.Claims
             |> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
-            |> Option.map (fun claim -> AccessLevel.parse claim.Value)
+            |> Option.map (fun claim -> AccessLevel.Parse claim.Value)
 
         /// The user ID for the current request
         member this.UserId =
@@ -53,8 +53,7 @@ module Extensions =
         
         /// Does the current user have the requested level of access?
         member this.HasAccessLevel level =
-            defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
+            defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
-
 
 
 open System.Collections.Concurrent
@@ -66,26 +65,60 @@ open System.Collections.Concurrent
 /// settings update page</remarks>
 module WebLogCache =
     
+    open System.Text.RegularExpressions
+
+    /// A redirect rule that caches compiled regular expression rules
+    type CachedRedirectRule =
+    /// A straight text match rule
+    | Text of string * string
+    /// A regular expression match rule
+    | RegEx of Regex * string
+
     /// The cache of web log details
     let mutable private _cache : WebLog list = []
 
+    /// Redirect rules with compiled regular expressions
+    let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list> ()
+
     /// Try to get the web log for the current request (longest matching URL base wins)
     let tryGet (path : string) =
         _cache
         |> List.filter (fun wl -> path.StartsWith wl.UrlBase)
-        |> List.sortByDescending (fun wl -> wl.UrlBase.Length)
+        |> List.sortByDescending _.UrlBase.Length
         |> List.tryHead
 
     /// Cache the web log for a particular host
     let set webLog =
         _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
+        _redirectCache[webLog.Id] <-
+            webLog.RedirectRules
+            |> List.map (fun it ->
+                let relUrl = Permalink >> webLog.RelativeUrl
+                let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
+                if it.IsRegex then
+                    let pattern = if it.From.StartsWith "^" then $"^{relUrl it.From[1..]}" else it.From
+                    RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
+                else
+                    Text(relUrl it.From, urlTo))
+    
+    /// Get all cached web logs
+    let all () =
+        _cache
     
     /// Fill the web log cache from the database
     let fill (data: IData) = backgroundTask {
         let! webLogs = data.WebLog.All()
-        _cache <- webLogs
+        webLogs |> List.iter set
     }
     
+    /// Get the cached redirect rules for the given web log
+    let redirectRules webLogId =
+        _redirectCache[webLogId]
+    
+    /// Is the given theme in use by any web logs?
+    let isThemeInUse themeId =
+        _cache |> List.exists (fun wl -> wl.ThemeId = themeId)
+
 
 /// A cache of page information needed to display the page list in templates
 module PageListCache =
@@ -93,22 +126,30 @@ module PageListCache =
     open MyWebLog.ViewModels
     
     /// Cache of displayed pages
-    let private _cache = ConcurrentDictionary<string, DisplayPage[]> ()
+    let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array> ()
+    
+    let private fillPages (webLog: WebLog) pages =
+        _cache[webLog.Id] <-
+            pages
+            |> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" })
+            |> Array.ofList
     
     /// Are there pages cached for this web log?
-    let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase
+    let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
     
     /// Get the pages for the web log for this request
-    let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase]
+    let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
     
     /// Update the pages for the current web log
     let update (ctx: HttpContext) = backgroundTask {
-        let  webLog = ctx.WebLog
+        let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
-        let! pages  = ctx.Data.Page.FindListed webLog.Id
+        fillPages ctx.WebLog pages
-        _cache[webLog.UrlBase] <-
+    }
-            pages
+    
-            |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
+    /// Refresh the pages for the given web log
-            |> Array.ofList
+    let refresh (webLog: WebLog) (data: IData) = backgroundTask {
+        let! pages = data.Page.FindListed webLog.Id
+        fillPages webLog pages
     }
 
 
@@ -118,18 +159,24 @@ module CategoryCache =
     open MyWebLog.ViewModels
     
     /// The cache itself
-    let private _cache = ConcurrentDictionary<string, DisplayCategory[]> ()
+    let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array> ()
     
     /// Are there categories cached for this web log?
-    let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.UrlBase
+    let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
     
     /// Get the categories for the web log for this request
-    let get (ctx : HttpContext) = _cache[ctx.WebLog.UrlBase]
+    let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
     
     /// Update the cache with fresh data
     let update (ctx: HttpContext) = backgroundTask {
         let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
-        _cache[ctx.WebLog.UrlBase] <- cats
+        _cache[ctx.WebLog.Id] <- cats
+    }
+    
+    /// Refresh the category cache for the given web log
+    let refresh webLogId (data: IData) = backgroundTask {
+        let! cats = data.Category.FindAllForView webLogId
+        _cache[webLogId] <- cats
     }
 
 
@@ -147,30 +194,55 @@ module TemplateCache =
     let private hasInclude = Regex("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
     
     /// Get a template for the given theme and template name
-    let get (themeId : string) (templateName : string) (data : IData) = backgroundTask {
+    let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
         let templatePath = $"{themeId}/{templateName}"
         match _cache.ContainsKey templatePath with
-        | true -> ()
+        | true -> return Ok _cache[templatePath]
         | false ->
-            match! data.Theme.FindById (ThemeId themeId) with
+            match! data.Theme.FindById themeId with
             | Some theme ->
-                let mutable text = (theme.Templates |> List.find (fun t -> t.Name = templateName)).Text
+                match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
+                | Some template ->
+                    let mutable text = template.Text
+                    let mutable childNotFound = ""
                     while hasInclude.IsMatch text do
                         let child = hasInclude.Match text
-                    let childText  = (theme.Templates |> List.find (fun t -> t.Name = child.Groups[1].Value)).Text
+                        let childText =
+                            match theme.Templates |> List.tryFind (fun t -> t.Name = child.Groups[1].Value) with
+                            | Some childTemplate -> childTemplate.Text
+                            | None ->
+                                childNotFound <-
+                                    if childNotFound = "" then child.Groups[1].Value
+                                    else $"{childNotFound}; {child.Groups[1].Value}"
+                                ""
                         text <- text.Replace(child.Value, childText)
+                    if childNotFound <> "" then
+                        let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
+                        return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
+                    else
                         _cache[templatePath] <- Template.Parse(text, SyntaxCompatibility.DotLiquid22)
-            | None -> ()
+                        return Ok _cache[templatePath]
-        return _cache[templatePath]
+                | None ->
+                    return Error $"Theme ID {themeId} does not have a template named {templateName}"
+            | None -> return Error $"Theme ID {themeId} does not exist"
     }
     
+    /// Get all theme/template names currently cached
+    let allNames () =
+        _cache.Keys |> Seq.sort |> Seq.toList
+    
     /// Invalidate all template cache entries for the given theme ID
-    let invalidateTheme (themeId : string) =
+    let invalidateTheme (themeId: ThemeId) =
+        let keyPrefix = string themeId
         _cache.Keys
-        |> Seq.filter (fun key -> key.StartsWith themeId)
+        |> Seq.filter _.StartsWith(keyPrefix)
         |> List.ofSeq
         |> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
     
+    /// Remove all entries from the template cache
+    let empty () =
+        _cache.Clear()
+
 
 /// A cache of asset names by themes
 module ThemeAssetCache =

src/MyWebLog/DotLiquidBespoke.fs

@@ -7,6 +7,7 @@ open System.Web
 open DotLiquid
 open Giraffe.ViewEngine
 open MyWebLog.ViewModels
+open MyWebLog.Views
 
 /// Extensions on the DotLiquid Context object
 type Context with
@@ -21,7 +22,7 @@ let assetExists fileName (webLog : WebLog) =
     ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
 
 /// Obtain the link from known types
-let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> string) =
+let permalink (item: obj) (linkFunc: Permalink -> string) =
     match item with
     | :? String       as link  -> Some link
     | :? DisplayPage  as page  -> Some page.Permalink
@@ -29,14 +30,14 @@ let permalink (ctx : Context) (item : obj) (linkFunc : WebLog -> Permalink -> st
     | :? DropProxy    as proxy -> Option.ofObj proxy["Permalink"] |> Option.map string
     | _ -> None
     |> function
-    | Some link -> linkFunc ctx.WebLog (Permalink link)
+    | Some link -> linkFunc (Permalink link)
     | None      -> $"alert('unknown item type {item.GetType().Name}')"
 
 
 /// A filter to generate an absolute link
 type AbsoluteLinkFilter() =
     static member AbsoluteLink(ctx: Context, item: obj) =
-        permalink ctx item WebLog.absoluteUrl
+        permalink item ctx.WebLog.AbsoluteUrl
 
 
 /// A filter to generate a link with posts categorized under the given category
@@ -47,7 +48,7 @@ type CategoryLinkFilter () =
         | :? DropProxy       as proxy -> Option.ofObj proxy["Slug"] |> Option.map string
         | _ -> None
         |> function
-        | Some slug -> WebLog.relativeUrl ctx.WebLog (Permalink $"category/{slug}/")
+        | Some slug -> ctx.WebLog.RelativeUrl(Permalink $"category/{slug}/")
         | None      -> $"alert('unknown category object type {catObj.GetType().Name}')"
 
 
@@ -60,7 +61,7 @@ type EditPageLinkFilter () =
         | :? String      as theId -> Some theId
         | _ -> None
         |> function
-        | Some pageId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/page/{pageId}/edit")
+        | Some pageId -> ctx.WebLog.RelativeUrl(Permalink $"admin/page/{pageId}/edit")
         | None        -> $"alert('unknown page object type {pageObj.GetType().Name}')"
 
 
@@ -73,23 +74,23 @@ type EditPostLinkFilter () =
         | :? String       as theId -> Some theId
         | _ -> None
         |> function
-        | Some postId -> WebLog.relativeUrl ctx.WebLog (Permalink $"admin/post/{postId}/edit")
+        | Some postId -> ctx.WebLog.RelativeUrl(Permalink $"admin/post/{postId}/edit")
         | None        -> $"alert('unknown post object type {postObj.GetType().Name}')"
  
     
 /// A filter to generate nav links, highlighting the active link (exact match)
 type NavLinkFilter() =
     static member NavLink(ctx: Context, url: string, text: string) =
-        let _, path = WebLog.hostAndPath ctx.WebLog
+        let extraPath = ctx.WebLog.ExtraPath
-        let path = if path = "" then path else $"{path.Substring 1}/"
+        let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
         seq {
-            "<li class=\"nav-item\"><a class=\"nav-link"
+            "<li class=nav-item><a class=\"nav-link"
             if (string ctx.Environments[0].["current_page"]).StartsWith $"{path}{url}" then " active"
             "\" href=\""
-            WebLog.relativeUrl ctx.WebLog (Permalink url)
+            ctx.WebLog.RelativeUrl(Permalink url)
             "\">"
             text
-            "</a></li>"
+            "</a>"
         }
         |> String.concat ""
 
@@ -97,7 +98,7 @@ type NavLinkFilter () =
 /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
 type ThemeAssetFilter() =
     static member ThemeAsset(ctx: Context, asset: string) =
-        WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
+        ctx.WebLog.RelativeUrl(Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
 
 
 /// Create various items in the page header based on the state of the page being generated
@@ -111,23 +112,23 @@ type PageHeadTag () =
         let getBool name =
             defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
         
-        result.WriteLine $"""<meta name="generator" content="{context.Environments[0].["generator"]}">"""
+        result.WriteLine $"""<meta name=generator content="{context.Environments[0].["generator"]}">"""
         
         // Theme assets
         if assetExists "style.css" webLog then
-            result.WriteLine $"""{s}<link rel="stylesheet" href="{ThemeAssetFilter.ThemeAsset (context, "style.css")}">"""
+            result.WriteLine $"""{s}<link rel=stylesheet href="{ThemeAssetFilter.ThemeAsset(context, "style.css")}">"""
         if assetExists "favicon.ico" webLog then
-            result.WriteLine $"""{s}<link rel="icon" href="{ThemeAssetFilter.ThemeAsset (context, "favicon.ico")}">"""
+            result.WriteLine $"""{s}<link rel=icon href="{ThemeAssetFilter.ThemeAsset(context, "favicon.ico")}">"""
         
         // RSS feeds and canonical URLs
         let feedLink title url =
             let escTitle = HttpUtility.HtmlAttributeEncode title
-            let relUrl   = WebLog.relativeUrl webLog (Permalink url)
+            let relUrl   = webLog.RelativeUrl(Permalink url)
-            $"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
+            $"""{s}<link rel=alternate type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
         
         if webLog.Rss.IsFeedEnabled && getBool "is_home" then
             result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName)
-            result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
+            result.WriteLine $"""{s}<link rel=canonical href="{webLog.AbsoluteUrl Permalink.Empty}">"""
         
         if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
             let slug = context.Environments[0].["slug"] :?> string
@@ -139,13 +140,13 @@ type PageHeadTag () =
             
         if getBool "is_post" then
             let post = context.Environments[0].["model"] :?> PostDisplay
-            let url  = WebLog.absoluteUrl webLog (Permalink post.Posts[0].Permalink)
+            let url  = webLog.AbsoluteUrl (Permalink post.Posts[0].Permalink)
-            result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
+            result.WriteLine $"""{s}<link rel=canonical href="{url}">"""
         
         if getBool "is_page" then
             let page = context.Environments[0].["page"] :?> DisplayPage
-            let url  = WebLog.absoluteUrl webLog (Permalink page.Permalink)
+            let url  = webLog.AbsoluteUrl (Permalink page.Permalink)
-            result.WriteLine $"""{s}<link rel="canonical" href="{url}">"""
+            result.WriteLine $"""{s}<link rel=canonical href="{url}">"""
 
 
 /// Create various items in the page header based on the state of the page being generated
@@ -167,7 +168,7 @@ type PageFootTag () =
 /// A filter to generate a relative link
 type RelativeLinkFilter() =
     static member RelativeLink(ctx: Context, item: obj) =
-        permalink ctx item WebLog.relativeUrl
+        permalink item ctx.WebLog.RelativeUrl
 
 
 /// A filter to generate a link with posts tagged with the given tag
@@ -178,7 +179,7 @@ type TagLinkFilter () =
         |> function
         | Some tagMap -> tagMap.UrlValue
         | None        -> tag.Replace(" ", "+")
-        |> function tagUrl -> WebLog.relativeUrl ctx.WebLog (Permalink $"tag/{tagUrl}/")
+        |> function tagUrl -> ctx.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
 
 
 /// Create links for a user to log on or off, and a dashboard link if they are logged off
@@ -186,21 +187,21 @@ type UserLinksTag () =
     inherit Tag()
     
     override this.Render(context: Context, result: TextWriter) =
-        let link it = WebLog.relativeUrl context.WebLog (Permalink it)
+        let link it = context.WebLog.RelativeUrl(Permalink it)
         seq {
             """<ul class="navbar-nav flex-grow-1 justify-content-end">"""
             match Convert.ToBoolean context.Environments[0].["is_logged_on"] with
             | true ->
-                $"""<li class="nav-item"><a class="nav-link" href="{link "admin/dashboard"}">Dashboard</a></li>"""
+                $"""<li class=nav-item><a class=nav-link href="{link "admin/dashboard"}">Dashboard</a>"""
-                $"""<li class="nav-item"><a class="nav-link" href="{link "user/log-off"}">Log Off</a></li>"""
+                $"""<li class=nav-item><a class=nav-link href="{link "user/log-off"}">Log Off</a>"""
             | false ->
-                $"""<li class="nav-item"><a class="nav-link" href="{link "user/log-on"}">Log On</a></li>"""
+                $"""<li class=nav-item><a class=nav-link href="{link "user/log-on"}">Log On</a>"""
             "</ul>"
         }
         |> Seq.iter result.WriteLine
 
 /// A filter to retrieve the value of a meta item from a list
-//    (shorter than `{% assign item = list | where: "name", [name] | first %}{{ item.value }}`)
+//    (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
 type ValueFilter() =
     static member Value(_: Context, items: MetaItem list, name: string) =
         match items |> List.tryFind (fun it -> it.Name = name) with
@@ -224,15 +225,11 @@ let register () =
     Template.RegisterTag<UserLinksTag> "user_links"
     
     [ // Domain types
-      typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>;    typeof<MetaItem>; typeof<Page>
+      typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
-      typeof<RssOptions>; typeof<TagMap>;  typeof<UploadDestination>; typeof<WebLog>
+      typeof<TagMap>;     typeof<WebLog>
       // View models
-      typeof<DashboardModel>;        typeof<DisplayCategory>;      typeof<DisplayCustomFeed>; typeof<DisplayPage>
+      typeof<AppViewContext>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditPageModel>; typeof<PostDisplay>
-      typeof<DisplayRevision>;       typeof<DisplayUpload>;        typeof<DisplayUser>;       typeof<EditCategoryModel>
+      typeof<PostListItem>;   typeof<UserMessage>
-      typeof<EditCustomFeedModel>;   typeof<EditMyInfoModel>;      typeof<EditPageModel>;     typeof<EditPostModel>
-      typeof<EditRssModel>;          typeof<EditTagMapModel>;      typeof<EditUserModel>;     typeof<LogOnModel>
-      typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>;       typeof<PostListItem>
-      typeof<SettingsModel>;         typeof<UserMessage>
       // Framework types
       typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>;    typeof<KeyValuePair>
       typeof<MetaItem list>;       typeof<string list>;     typeof<string option>; typeof<TagMap list>

src/MyWebLog/Handlers/Admin.fs

@@ -3,59 +3,109 @@ module MyWebLog.Handlers.Admin
 
 open System.Threading.Tasks
 open Giraffe
+open Giraffe.Htmx
 open MyWebLog
 open MyWebLog.ViewModels
+open NodaTime
 
-// GET /admin
+/// ~~~ DASHBOARDS ~~~
-let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
+module Dashboard =
+    
+    // GET /admin/dashboard
+    let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
         let getCount (f: WebLogId -> Task<int>) = f ctx.WebLog.Id
         let  data    = ctx.Data
-    let posts   = getCount (data.Post.CountByStatus Published)
+        let! posts   = getCount (data.Post.CountByStatus Published)
-    let drafts  = getCount (data.Post.CountByStatus Draft)
+        let! drafts  = getCount (data.Post.CountByStatus Draft)
-    let pages   = getCount data.Page.CountAll
+        let! pages   = getCount data.Page.CountAll
-    let listed  = getCount data.Page.CountListed
+        let! listed  = getCount data.Page.CountListed
-    let cats    = getCount data.Category.CountAll
+        let! cats    = getCount data.Category.CountAll
-    let topCats = getCount data.Category.CountTopLevel
+        let! topCats = getCount data.Category.CountTopLevel
-    let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
+        let model =
-    return!
+            { Posts              = posts
-        hashForPage "Dashboard"
+              Drafts             = drafts
-        |> addToHash ViewContext.Model {
+              Pages              = pages
-                Posts              = posts.Result
+              ListedPages        = listed
-                Drafts             = drafts.Result
+              Categories         = cats
-                Pages              = pages.Result
+              TopLevelCategories = topCats }
-                ListedPages        = listed.Result
+        return! adminPage "Dashboard" false next ctx (Views.WebLog.dashboard model)
-                Categories         = cats.Result
-                TopLevelCategories = topCats.Result
-            }
-        |> adminView "dashboard" next ctx
     }
 
-// -- CATEGORIES --
+    // GET /admin/administration
+    let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+        let! themes = ctx.Data.Theme.All()
+        return! adminPage "myWebLog Administration" true next ctx (Views.Admin.dashboard themes)
+    }
+
+/// Redirect the user to the admin dashboard
+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
+        if webLogId = "all" then
+            do! WebLogCache.fill data
+            for webLog in WebLogCache.all () do
+                do! PageListCache.refresh webLog    data
+                do! CategoryCache.refresh webLog.Id data
+            do! addMessage ctx
+                    { UserMessage.Success with Message = "Successfully refresh web log cache for all web logs" }
+        else
+            match! data.WebLog.FindById(WebLogId webLogId) with
+            | Some webLog ->
+                WebLogCache.set webLog
+                do! PageListCache.refresh webLog    data
+                do! CategoryCache.refresh webLog.Id data
+                do! addMessage ctx
+                        { UserMessage.Success with Message = $"Successfully refreshed web log cache for {webLog.Name}" }
+            | None ->
+                do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
+        return! toAdminDashboard next ctx
+    }
+
+    // POST /admin/cache/theme/{id}/refresh
+    let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+        let data = ctx.Data
+        if themeId = "all" then
+            TemplateCache.empty ()
+            do! ThemeAssetCache.fill data
+            do! addMessage ctx
+                    { UserMessage.Success with
+                        Message = "Successfully cleared template cache and refreshed theme asset cache" }
+        else
+            match! data.Theme.FindById(ThemeId themeId) with
+            | Some theme ->
+                TemplateCache.invalidateTheme    theme.Id
+                do! ThemeAssetCache.refreshTheme theme.Id data
+                do! addMessage ctx
+                        { UserMessage.Success with
+                            Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" }
+            | None ->
+                do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
+        return! toAdminDashboard next ctx
+    }
+
+
+/// ~~~ CATEGORIES ~~~
+module Category =
+    
+    open MyWebLog.Data
 
     // GET /admin/categories
-let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let all : HttpHandler = fun next ctx ->
-    let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
+        let response = fun next ctx ->
-    let! hash =
+            adminPage "Categories" true next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
-        hashForPage "Categories"
+        (withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
-        |> withAntiCsrf ctx
-        |> addViewContext ctx
-    return!
-           addToHash "category_list" (catListTemplate.Render hash) hash
-        |> adminView "category-list" next ctx
-}
-
-// GET /admin/categories/bare
-let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
-    hashForPage "Categories"
-    |> withAntiCsrf ctx
-    |> adminBareView "category-list-body" next ctx
-
 
     // GET /admin/category/{id}/edit
-let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let edit catId : HttpHandler = fun next ctx -> task {
         let! result = task {
             match catId with
-        | "new" -> return Some ("Add a New Category", { Category.empty with Id = CategoryId "new" })
+            | "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" })
             | _ ->
                 match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with
                 | Some cat -> return Some ("Edit Category", cat)
@@ -64,19 +114,17 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
         match result with
         | Some (title, cat) ->
             return!
-            hashForPage title
+                Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
-            |> withAntiCsrf ctx
+                |> adminBarePage title true next ctx
-            |> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
-            |> adminBareView "category-edit" next ctx
         | None -> return! Error.notFound next ctx
     }
 
     // POST /admin/category/save
-let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let save : HttpHandler = fun next ctx -> task {
         let  data     = ctx.Data
         let! model    = ctx.BindFormAsync<EditCategoryModel>()
         let  category =
-        if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
+            if model.IsNew then someTask { Category.Empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
             else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
         match! category with
         | Some cat ->
@@ -85,95 +133,163 @@ let saveCategory : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
                     Name        = model.Name
                     Slug        = model.Slug
                     Description = if model.Description = "" then None else Some model.Description
-                ParentId    = if model.ParentId    = "" then None else Some (CategoryId model.ParentId)
+                    ParentId    = if model.ParentId    = "" then None else Some (CategoryId model.ParentId) }
-            }
             do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat
             do! CategoryCache.update ctx
-        do! addMessage ctx { UserMessage.success with Message = "Category saved successfully" }
+            do! addMessage ctx { UserMessage.Success with Message = "Category saved successfully" }
-        return! listCategoriesBare next ctx
+            return! all next ctx
         | None -> return! Error.notFound next ctx
     }
 
-// POST /admin/category/{id}/delete
+    // DELETE /admin/category/{id}
-let deleteCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    match! ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id with
+        let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
-    | true ->
+        match result with
+        | CategoryDeleted
+        | ReassignedChildCategories ->
             do! CategoryCache.update ctx
-        do! addMessage ctx { UserMessage.success with Message = "Category deleted successfully" }
+            let detail =
-    | false -> do! addMessage ctx { UserMessage.error with Message = "Category not found; cannot delete" }
+                match result with
-    return! listCategoriesBare next ctx
+                | ReassignedChildCategories ->
+                    Some "<em>(Its child categories were reassigned to its parent category)</em>"
+                | _ -> None
+            do! addMessage ctx { UserMessage.Success with Message = "Category deleted successfully"; Detail = detail }
+        | CategoryNotFound ->
+            do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
+        return! all next ctx
     }
 
+
+/// ~~~ REDIRECT RULES ~~~
+module RedirectRules =
+
     open Microsoft.AspNetCore.Http
 
-// -- TAG MAPPINGS --
+    // GET /admin/settings/redirect-rules
+    let all : HttpHandler = fun next ctx ->
+        adminPage "Redirect Rules" true next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
 
-/// Get the hash necessary to render the tag mapping list
+    // GET /admin/settings/redirect-rules/[index]
-let private tagMappingHash (ctx : HttpContext) = task {
+    let edit idx : HttpHandler = fun next ctx ->
-    let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
+        let titleAndView =
-    return!
+            if idx = -1 then
-        hashForPage "Tag Mappings"
+                Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
-        |> withAntiCsrf ctx
+            else        
-        |> addToHash "mappings"    mappings
+                let rules = ctx.WebLog.RedirectRules
-        |> addToHash "mapping_ids" (mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
+                if rules.Length < idx || idx < 0 then
-        |> addViewContext ctx
+                    None
+                else
+                    Some
+                        ("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
+        match titleAndView with
+        | Some (title, view) -> adminBarePage $"{title} Redirect Rule" true 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
+        ctx.Items["webLog"] <- webLog
+        WebLogCache.set webLog
     }
 
+    // POST /admin/settings/redirect-rules/[index]
+    let save idx : HttpHandler = fun next ctx -> task {
+        let! model = ctx.BindFormAsync<EditRedirectRuleModel>()
+        let  rule  = model.ToRule()
+        let  rules =
+            ctx.WebLog.RedirectRules
+            |> match idx with
+               | -1 when model.InsertAtTop -> List.insertAt 0 rule
+               | -1 -> List.insertAt ctx.WebLog.RedirectRules.Length rule
+               | _ -> List.removeAt idx >> List.insertAt idx rule
+        do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
+        do! addMessage ctx { UserMessage.Success with Message = "Redirect rule saved successfully" }
+        return! all next ctx
+    }
+
+    // POST /admin/settings/redirect-rules/[index]/up
+    let moveUp idx : HttpHandler = fun next ctx -> task {
+        if idx < 1 || idx >= ctx.WebLog.RedirectRules.Length then
+            return! Error.notFound next ctx
+        else
+            let toMove   = List.item idx ctx.WebLog.RedirectRules
+            let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx - 1) toMove
+            do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
+            return! all next ctx
+    }
+
+    // POST /admin/settings/redirect-rules/[index]/down
+    let moveDown idx : HttpHandler = fun next ctx -> task {
+        if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length - 1 then
+            return! Error.notFound next ctx
+        else
+            let toMove   = List.item idx ctx.WebLog.RedirectRules
+            let newRules = ctx.WebLog.RedirectRules |> List.removeAt idx |> List.insertAt (idx + 1) toMove
+            do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = newRules }
+            return! all next ctx
+    }
+
+    // DELETE /admin/settings/redirect-rules/[index]
+    let delete idx : HttpHandler = fun next ctx -> task {
+        if idx < 0 || idx >= ctx.WebLog.RedirectRules.Length then
+            return! Error.notFound next ctx
+        else
+            let rules = ctx.WebLog.RedirectRules |> List.removeAt idx
+            do! updateRedirectRules ctx { ctx.WebLog with RedirectRules = rules }
+            do! addMessage ctx { UserMessage.Success with Message = "Redirect rule deleted successfully" }
+            return! all next ctx
+    }
+
+
+/// ~~~ TAG MAPPINGS ~~~
+module TagMapping =
+    
     // GET /admin/settings/tag-mappings
-let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let all : HttpHandler = fun next ctx -> task {
-    let! hash         = tagMappingHash ctx
+        let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
-    let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
+        return! adminBarePage "Tag Mapping List" true next ctx (Views.WebLog.tagMapList mappings)
-    return!
-           addToHash "tag_mapping_list" (listTemplate.Render hash) hash
-        |> adminView "tag-mapping-list" next ctx
-}
-
-// GET /admin/settings/tag-mappings/bare
-let tagMappingsBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let! hash = tagMappingHash ctx
-    return! adminBareView "tag-mapping-list-body" next ctx hash
     }
 
     // GET /admin/settings/tag-mapping/{id}/edit
-let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let edit tagMapId : HttpHandler = fun next ctx -> task {
         let isNew  = tagMapId = "new"
         let tagMap =
-        if isNew then someTask { TagMap.empty with Id = TagMapId "new" }
+            if isNew then someTask { TagMap.Empty with Id = TagMapId "new" }
             else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
         match! tagMap with
         | Some tm ->
             return!
-            hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") 
+                Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
-            |> withAntiCsrf ctx
+                |> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx
-            |> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
-            |> adminBareView "tag-mapping-edit" next ctx
         | None -> return! Error.notFound next ctx
     }
 
     // POST /admin/settings/tag-mapping/save
-let saveMapping : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let save : HttpHandler = fun next ctx -> task {
         let  data   = ctx.Data
         let! model  = ctx.BindFormAsync<EditTagMapModel>()
         let  tagMap =
-        if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
+            if model.IsNew then someTask { TagMap.Empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
             else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
         match! tagMap with
         | Some tm ->
             do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
-        do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
+            do! addMessage ctx { UserMessage.Success with Message = "Tag mapping saved successfully" }
-        return! tagMappingsBare next ctx
+            return! all next ctx
         | None -> return! Error.notFound next ctx
     }
 
-// POST /admin/settings/tag-mapping/{id}/delete
+    // DELETE /admin/settings/tag-mapping/{id}
-let deleteMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let delete tagMapId : HttpHandler = fun next ctx -> task {
         match! ctx.Data.TagMap.Delete (TagMapId tagMapId) ctx.WebLog.Id with
-    | true  -> do! addMessage ctx { UserMessage.success with Message = "Tag mapping deleted successfully" }
+        | true  -> do! addMessage ctx { UserMessage.Success with Message = "Tag mapping deleted successfully" }
-    | false -> do! addMessage ctx { UserMessage.error with Message = "Tag mapping not found; nothing deleted" }
+        | false -> do! addMessage ctx { UserMessage.Error with Message = "Tag mapping not found; nothing deleted" }
-    return! tagMappingsBare next ctx
+        return! all next ctx
     }
 
-// -- THEMES --
+
+/// ~~~ THEMES ~~~
+module Theme =
     
     open System
     open System.IO
@@ -181,11 +297,17 @@ open System.IO.Compression
     open System.Text.RegularExpressions
     open MyWebLog.Data
 
-// GET /admin/theme/update
+    // GET /admin/theme/list
-let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
+    let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { 
-    hashForPage "Upload Theme"
+        let! themes = ctx.Data.Theme.All ()
-    |> withAntiCsrf ctx
+        return!
-    |> adminView "upload-theme" next ctx
+            Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
+            |> adminBarePage "Themes" true next ctx
+    }
+
+    // GET /admin/theme/new
+    let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
+        adminBarePage "Upload a Theme File" true next ctx Views.Admin.themeUpload
 
     /// Update the name and version for a theme based on the version.txt file, if present
     let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
@@ -195,18 +317,10 @@ let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = background
             use  versionFile = new StreamReader(versionItem.Open())
             let! versionText = versionFile.ReadToEndAsync()
             let  parts       = versionText.Trim().Replace("\r", "").Split "\n"
-        let  displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
+            let  displayName = if parts[0] > "" then parts[0] else string theme.Id
             let  version     = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
             return { theme with Name = displayName; Version = version }
-    | None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
+        | None -> return { theme with Name = string theme.Id; Version = now () }
-}
-
-/// Delete all theme assets, and remove templates from theme
-let private checkForCleanLoad (theme : Theme) cleanLoad (data : IData) = backgroundTask {
-    if cleanLoad then
-        do! data.ThemeAsset.DeleteByTheme theme.Id
-        return { theme with Templates = [] }
-    else return theme
     }
 
     /// Update the theme with all templates from the ZIP archive
@@ -229,103 +343,135 @@ let private updateTemplates (theme : Theme) (zip : ZipArchive) = backgroundTask
 
     /// Update theme assets from the ZIP archive
     let private updateAssets themeId (zip: ZipArchive) (data: IData) = backgroundTask {
-    for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do
+        for asset in zip.Entries |> Seq.filter _.FullName.StartsWith("wwwroot") do
             let assetName = asset.FullName.Replace("wwwroot/", "")
             if assetName <> "" && not (assetName.EndsWith "/") then
                 use stream = new MemoryStream()
                 do! asset.Open().CopyToAsync stream
                 do! data.ThemeAsset.Save
                         {   Id        = ThemeAssetId(themeId, assetName)
-                        UpdatedOn = asset.LastWriteTime.DateTime
+                            UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime)
+                                            .InZoneLeniently(DateTimeZone.Utc).ToInstant()
                             Data      = stream.ToArray()
                         }
     }
 
-/// Get the theme name from the file name given
+    /// Derive the theme ID from the file name given
-let getThemeName (fileName : string) =
+    let deriveIdFromFileName (fileName: string) =
         let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace(" ", "-")
-    if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then Ok themeName else Error $"Theme name {fileName} is invalid"
+        if themeName.EndsWith "-theme" then
+            if Regex.IsMatch(themeName, """^[a-z0-9\-]+$""") then
+                Ok(ThemeId(themeName[..themeName.Length - 7]))
+            else Error $"Theme ID {fileName} is invalid"
+        else Error "Theme .zip file name must end in \"-theme.zip\""
 
     /// Load a theme from the given stream, which should contain a ZIP archive
-let loadThemeFromZip themeName file clean (data : IData) = backgroundTask {
+    let loadFromZip themeId file (data: IData) = backgroundTask {
-    use  zip     = new ZipArchive (file, ZipArchiveMode.Read)
+        let! isNew, theme = backgroundTask {
-    let  themeId = ThemeId themeName
-    let! theme   = backgroundTask {
             match! data.Theme.FindById themeId with
-        | Some t -> return t
+            | Some t -> return false, t
-        | None   -> return { Theme.empty with Id = themeId }
+            | None   -> return true, { Theme.Empty with Id = themeId }
         }
+        use  zip   = new ZipArchive(file, ZipArchiveMode.Read)
         let! theme = updateNameAndVersion theme zip
-    let! theme = checkForCleanLoad    theme   clean data
+        if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id
-    let! theme = updateTemplates      theme   zip
+        let! theme = updateTemplates { theme with Templates = [] } zip
         do! data.Theme.Save theme
         do! updateAssets themeId zip data
+        
+        return theme
     }
 
-// POST /admin/theme/update
+    // POST /admin/theme/new
-let updateTheme : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+    let save : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
         if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
             let themeFile = Seq.head ctx.Request.Form.Files
-        match getThemeName themeFile.FileName with
+            match deriveIdFromFileName themeFile.FileName with
-        | Ok themeName when themeName <> "admin" ->
+            | Ok themeId when themeId <> ThemeId "admin" ->
                 let  data   = ctx.Data
+                let! exists = data.Theme.Exists themeId
+                let  isNew  = not exists
+                let! model  = ctx.BindFormAsync<UploadThemeModel>()
+                if isNew || model.DoOverwrite then 
+                    // Load the theme to the database
                     use stream = new MemoryStream()
                     do! themeFile.CopyToAsync stream
-            do! loadThemeFromZip themeName stream true data
+                    let! _ = loadFromZip themeId stream data
-            do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
+                    do! ThemeAssetCache.refreshTheme themeId data
-            TemplateCache.invalidateTheme themeName
+                    TemplateCache.invalidateTheme themeId
-            do! addMessage ctx { UserMessage.success with Message = "Theme updated successfully" }
+                    // Save the .zip file
-            return! redirectToGet "admin/dashboard" next ctx
+                    use file = new FileStream($"./themes/{themeId}-theme.zip", FileMode.Create)
+                    do! themeFile.CopyToAsync file
+                    do! addMessage ctx
+                            { UserMessage.Success with
+                                Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" }
+                    return! toAdminDashboard next ctx
+                else
+                    do! addMessage ctx
+                            { UserMessage.Error with
+                                Message = "Theme exists and overwriting was not requested; nothing saved" }
+                    return! toAdminDashboard next ctx
             | Ok _ ->
-            do! addMessage ctx { UserMessage.error with Message = "You may not replace the admin theme" }
+                do! addMessage ctx { UserMessage.Error with Message = "You may not replace the admin theme" }
-            return! redirectToGet "admin/theme/update" next ctx
+                return! toAdminDashboard next ctx
             | Error message ->
-            do! addMessage ctx { UserMessage.error with Message = message }
+                do! addMessage ctx { UserMessage.Error with Message = message }
-            return! redirectToGet "admin/theme/update" next ctx
+                return! toAdminDashboard next ctx
         else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
     }
 
-// -- WEB LOG SETTINGS --
+    // POST /admin/theme/{id}/delete
+    let delete themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
+        let data = ctx.Data
+        match themeId with
+        | "admin" | "default" ->
+            do! addMessage ctx { UserMessage.Error with Message = $"You may not delete the {themeId} theme" }
+            return! all next ctx
+        | it when WebLogCache.isThemeInUse (ThemeId it) ->
+            do! addMessage ctx
+                    { UserMessage.Error with
+                        Message = $"You may not delete the {themeId} theme, as it is currently in use" }
+            return! all next ctx
+        | _ ->
+            match! data.Theme.Delete (ThemeId themeId) with
+            | true ->
+                let zippedTheme = $"./themes/{themeId}-theme.zip"
+                if File.Exists zippedTheme then File.Delete zippedTheme
+                do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" }
+                return! all next ctx
+            | false -> return! Error.notFound next ctx
+    }
 
-open System.Collections.Generic
+
+/// ~~~ WEB LOG SETTINGS ~~~
+module WebLog =
+    
+    open System.IO
 
     // GET /admin/settings
-let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let settings : HttpHandler = fun next ctx -> task {
         let  data     = ctx.Data
         let! allPages = data.Page.All ctx.WebLog.Id
+        let  pages    =
+            allPages
+            |> List.sortBy _.Title.ToLower()
+            |> List.append [ { Page.Empty with Id = PageId "posts"; Title = "- First Page of Posts -" } ]
         let! themes   = data.Theme.All()
+        let  uploads  = [ Database; Disk ]
         return!
-        hashForPage "Web Log Settings"
+            Views.WebLog.webLogSettings
-        |> withAntiCsrf ctx
+                (SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
-        |> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
+            |> adminPage "Web Log Settings" true next ctx
-        |> addToHash "pages" (
-            seq {
-                KeyValuePair.Create ("posts", "- First Page of Posts -")
-                yield! allPages
-                       |> List.sortBy (fun p -> p.Title.ToLower ())
-                       |> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
-            }
-            |> Array.ofSeq)
-        |> addToHash "themes" (
-            themes
-            |> Seq.ofList
-            |> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
-            |> Array.ofSeq)
-        |> addToHash "upload_values" [|
-            KeyValuePair.Create (UploadDestination.toString Database, "Database")
-            KeyValuePair.Create (UploadDestination.toString Disk,     "Disk")
-        |]
-        |> adminView "settings" next ctx
     }
 
     // POST /admin/settings
-let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let saveSettings : HttpHandler = fun next ctx -> task {
         let  data  = ctx.Data
         let! model = ctx.BindFormAsync<SettingsModel>()
         match! data.WebLog.FindById ctx.WebLog.Id with
         | Some webLog ->
             let oldSlug = webLog.Slug
-        let webLog  = model.update webLog
+            let webLog  = model.Update webLog
             do! data.WebLog.UpdateSettings webLog
 
             // Update cache
@@ -337,7 +483,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
                 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" }
+            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/Feed.fs

@@ -2,7 +2,6 @@
 module MyWebLog.Handlers.Feed
 
 open System
-open System.Collections.Generic
 open System.IO
 open System.Net
 open System.ServiceModel.Syndication
@@ -37,19 +36,18 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
     | false ->
         // Category and tag feeds are handled by defined routes; check for custom feed
         match webLog.Rss.CustomFeeds
-              |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with
+              |> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with
         | Some feed ->
             debug (fun () -> "Found custom feed")
-            Some (Custom (feed, feedPath),
+            Some(Custom(feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
-                  feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
         | None ->
-            debug (fun () -> $"No matching feed found")
+            debug (fun () -> "No matching feed found")
             None
 
 /// Determine the function to retrieve posts for the given feed
 let private getFeedPosts ctx feedType =
-    let childIds catId =
+    let childIds (catId: CategoryId) =
-        let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId)
+        let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = string catId)
         getCategoryIds cat.Slug ctx
     let data = ctx.Data
     match feedType with
@@ -87,16 +85,16 @@ module private Namespace =
     let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
 
 /// Create a feed item from the given post    
-let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
+let private toFeedItem (webLog: WebLog) (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
         (post: Post) =
     let plainText =
         let endingP = post.Text.IndexOf "</p>"
         stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
     let item = SyndicationItem(
-        Id              = WebLog.absoluteUrl webLog post.Permalink,
+        Id              = webLog.AbsoluteUrl post.Permalink,
         Title           = TextSyndicationContent.CreateHtmlContent post.Title,
-        PublishDate     = DateTimeOffset post.PublishedOn.Value,
+        PublishDate     = post.PublishedOn.Value.ToDateTimeOffset(),
-        LastUpdatedTime = DateTimeOffset post.UpdatedOn,
+        LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
         Content         = TextSyndicationContent.CreatePlaintextContent plainText)
     item.AddPermalink (Uri item.Id)
     
@@ -112,38 +110,38 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
         it
     item.ElementExtensions.Add encoded
         
-    item.Authors.Add (SyndicationPerson (
+    item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
-        Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
     [ post.CategoryIds
       |> List.map (fun catId ->
-          let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
+          let cat = cats |> Array.find (fun c -> c.Id = string catId)
-          SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
+          SyndicationCategory(cat.Name, webLog.AbsoluteUrl(Permalink $"category/{cat.Slug}/"), cat.Name))
       post.Tags
       |> List.map (fun tag ->
           let urlTag =
               match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
               | Some tm -> tm.UrlValue
               | None -> tag.Replace (" ", "+")
-          SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
+          SyndicationCategory(tag, webLog.AbsoluteUrl(Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
     ]
     |> List.concat
     |> List.iter item.Categories.Add
     item
 
 /// Convert non-absolute URLs to an absolute URL for this web log
-let toAbsolute webLog (link : string) =
+let toAbsolute (webLog: WebLog) (link: string) =
-    if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
+    if link.StartsWith "http" then link else webLog.AbsoluteUrl(Permalink link)
 
 /// Add episode information to a podcast feed item
-let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
+let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Episode) (post: Post)
+        (item: SyndicationItem) =
     let epMediaUrl =
         match episode.Media with
         | link when link.StartsWith "http" -> link
         | link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
-        | link -> WebLog.absoluteUrl webLog (Permalink link)
+        | link -> webLog.AbsoluteUrl(Permalink link)
     let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
-    let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
+    let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
-    let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
+    let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
     
     let xmlDoc    = XmlDocument()
     let enclosure =
@@ -163,20 +161,26 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
     item.ElementExtensions.Add("author",   Namespace.iTunes, podcast.DisplayedAuthor)
     item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit)
     episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it))
-    episode.Duration
+    episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
-    |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
     
-    match episode.ChapterFile with
+    let chapterUrl, chapterMimeType =
-    | Some chapters ->
+        match episode.Chapters, episode.ChapterFile with
-        let url = toAbsolute webLog chapters
+        | Some _, _ ->
+            Some $"{webLog.AbsoluteUrl post.Permalink}?chapters", Some JSON_CHAPTERS
+        | None, Some chapters ->
             let typ =
                 match episode.ChapterType with
                 | Some mime -> Some mime
-            | None when chapters.EndsWith ".json" -> Some "application/json+chapters"
+                | None when chapters.EndsWith ".json" -> Some JSON_CHAPTERS
                 | None -> None
+            Some (toAbsolute webLog chapters), typ
+        | None, None -> None, None
+    
+    match chapterUrl with
+    | Some url ->
         let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
         elt.SetAttribute("url", url)
-        typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
+        chapterMimeType |> Option.iter (fun it -> elt.SetAttribute("type", it))
         item.ElementExtensions.Add elt
     | None -> ()
     
@@ -187,8 +191,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
         elt.SetAttribute("url", url)
         elt.SetAttribute("type", Option.get episode.TranscriptType)
         episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it))
-        if defaultArg episode.TranscriptCaptions false then
+        if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions")
-            elt.SetAttribute ("rel", "captions")
         item.ElementExtensions.Add elt
     | None -> ()
     
@@ -221,8 +224,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
             
             post.Metadata
             |> List.filter (fun it -> it.Name = "chapter")
-            |> List.map (fun it ->
+            |> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..])
-                TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
             |> List.sortBy fst
             |> List.iter (fun chap ->
                 let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
@@ -239,7 +241,7 @@ let private addNamespace (feed : SyndicationFeed) alias nsUrl =
     feed.AttributeExtensions.Add(XmlQualifiedName(alias, "http://www.w3.org/2000/xmlns/"), nsUrl)
 
 /// Add items to the top of the feed required for podcasts
-let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
+let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) =
     let addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
         let child =
             if ns = "" then doc.CreateElement name else doc.CreateElement(prefix, name, ns)
@@ -248,11 +250,11 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
         elt
     
     let podcast  = Option.get feed.Podcast
-    let feedUrl  = WebLog.absoluteUrl webLog feed.Path
+    let feedUrl  = webLog.AbsoluteUrl feed.Path
     let imageUrl =
         match podcast.ImageUrl with
         | Permalink link when link.StartsWith "http" -> link
-        | Permalink _ -> WebLog.absoluteUrl webLog podcast.ImageUrl
+        | Permalink _ -> webLog.AbsoluteUrl podcast.ImageUrl
     
     let xmlDoc = XmlDocument()
     
@@ -302,7 +304,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     rssFeed.ElementExtensions.Add rawVoice
     rssFeed.ElementExtensions.Add("summary",  Namespace.iTunes, podcast.Summary)
     rssFeed.ElementExtensions.Add("author",   Namespace.iTunes, podcast.DisplayedAuthor)
-    rssFeed.ElementExtensions.Add ("explicit",  Namespace.iTunes,   ExplicitRating.toString podcast.Explicit)
+    rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
     podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add("subtitle", Namespace.iTunes, sub))
     podcast.FundingUrl
     |> Option.iter (fun url ->
@@ -313,8 +315,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     podcast.PodcastGuid
     |> Option.iter (fun guid ->
         rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
-    podcast.Medium
+    podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, string med))
-    |> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
 
 /// Get the feed's self reference and non-feed link
 let private selfAndLink webLog feedType ctx =
@@ -373,7 +374,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
         match podcast, post.Episode with
         | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
         | Some _, _ ->
-            warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
+            warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
             item
         | _ -> item
         
@@ -381,15 +382,15 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
     addNamespace feed "content" Namespace.content
     setTitleAndDescription feedType webLog cats feed
     
-    feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset
+    feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset()
     feed.Generator       <- ctx.Generator
     feed.Items           <- posts |> Seq.ofList |> Seq.map toItem
     feed.Language        <- "en"
-    feed.Id              <- WebLog.absoluteUrl webLog link
+    feed.Id              <- webLog.AbsoluteUrl link
     webLog.Rss.Copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
     
-    feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
+    feed.Links.Add(SyndicationLink(Uri(webLog.AbsoluteUrl self), "self", "", "application/rss+xml", 0L))
-    feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
+    feed.ElementExtensions.Add("link", "", webLog.AbsoluteUrl link)
     
     podcast |> Option.iter (addPodcast webLog feed)
     
@@ -414,17 +415,6 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
 
 // ~~ FEED ADMINISTRATION ~~
 
-// GET /admin/settings/rss
-let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
-    hashForPage "RSS Settings"
-    |> withAntiCsrf ctx
-    |> addToHash ViewContext.Model (EditRssModel.fromRssOptions ctx.WebLog.Rss)
-    |> addToHash "custom_feeds" (
-        ctx.WebLog.Rss.CustomFeeds
-        |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
-        |> Array.ofList)
-    |> adminView "rss-settings" next ctx
-
 // POST /admin/settings/rss
 let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let  data  = ctx.Data
@@ -434,8 +424,8 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
         let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss }
         do! data.WebLog.UpdateRssOptions webLog
         WebLogCache.set webLog
-        do! addMessage ctx { UserMessage.success with Message = "RSS settings updated successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "RSS settings updated successfully" }
-        return! redirectToGet "admin/settings/rss" next ctx
+        return! redirectToGet "admin/settings#rss-settings" next ctx
     | None -> return! Error.notFound next ctx
 }
 
@@ -443,24 +433,27 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
 let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
     let customFeed =
         match feedId with
-        | "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
+        | "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
         | _     -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
     match customFeed with
     | Some f ->
-        hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
+        let ratings = [
-        |> withAntiCsrf ctx
+            { Name = string Yes;   Value = "Yes" }
-        |> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
+            { Name = string No;    Value = "No" }
-        |> addToHash "medium_values" [|
+            { Name = string Clean; Value = "Clean" }
-            KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
+        ]
-            KeyValuePair.Create (PodcastMedium.toString Podcast,    "Podcast")
+        let mediums = [
-            KeyValuePair.Create (PodcastMedium.toString Music,      "Music")
+            { Name = "";                Value = "&ndash; Unspecified &ndash;" }
-            KeyValuePair.Create (PodcastMedium.toString Video,      "Video")
+            { Name = string Podcast;    Value = "Podcast" }
-            KeyValuePair.Create (PodcastMedium.toString Film,       "Film")
+            { Name = string Music;      Value = "Music" }
-            KeyValuePair.Create (PodcastMedium.toString Audiobook,  "Audiobook")
+            { Name = string Video;      Value = "Video" }
-            KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
+            { Name = string Film;       Value = "Film" }
-            KeyValuePair.Create (PodcastMedium.toString Blog,       "Blog")
+            { Name = string Audiobook;  Value = "Audiobook" }
-        |]
+            { Name = string Newsletter; Value = "Newsletter" }
-        |> adminView "custom-feed-edit" next ctx
+            { Name = string Blog;       Value = "Blog" }
+        ]
+        Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
+        |> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" true next ctx
     | None -> Error.notFound next ctx
 
 // POST /admin/settings/rss/save
@@ -471,42 +464,39 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
         let! model = ctx.BindFormAsync<EditCustomFeedModel>()
         let theFeed =
             match model.Id with
-            | "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
+            | "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
-            | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
+            | _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
         match theFeed with
         | Some feed ->
             let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
-            let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
+            let webLog = { webLog with Rss.CustomFeeds = feeds }
             do! data.WebLog.UpdateRssOptions webLog
             WebLogCache.set webLog
-            do! addMessage ctx {
+            do! addMessage ctx
-                UserMessage.success with
+                    { UserMessage.Success with
-                  Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
+                        Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" }
-            }
+            return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
-            return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx
         | None -> return! Error.notFound next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/settings/rss/{id}/delete
+// DELETE /admin/settings/rss/{id}
 let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let data = ctx.Data
     match! data.WebLog.FindById ctx.WebLog.Id with
     | Some webLog ->
         let customId = CustomFeedId feedId
         if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then
-            let webLog = {
+            let webLog =
-              webLog with
+                { webLog with
-                Rss = {
+                    Rss =
-                  webLog.Rss with
+                        { webLog.Rss with
-                    CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId)
+                            CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } }
-                }
-            }
             do! data.WebLog.UpdateRssOptions webLog
             WebLogCache.set webLog
-            do! addMessage ctx { UserMessage.success with Message = "Custom feed deleted successfully" }
+            do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" }
         else
-            do! addMessage ctx { UserMessage.warning with Message = "Custom feed not found; no action taken" }
+            do! addMessage ctx { UserMessage.Warning with Message = "Custom feed not found; no action taken" }
-        return! redirectToGet "admin/settings/rss" next ctx
+        return! redirectToGet "admin/settings#rss-settings" next ctx
     | None -> return! Error.notFound next ctx
 }

src/MyWebLog/Handlers/Helpers.fs

@@ -3,6 +3,7 @@ module private MyWebLog.Handlers.Helpers
 
 open System.Text.Json
 open Microsoft.AspNetCore.Http
+open MyWebLog.Views
 
 /// Session extensions to get and set objects
 type ISession with
@@ -25,6 +26,10 @@ module ViewContext =
     [<Literal>]
     let AntiCsrfTokens = "csrf"
     
+    /// The unified application view context
+    [<Literal>]
+    let AppViewContext = "app"
+    
     /// The categories for this web log
     [<Literal>]
     let Categories = "categories"
@@ -122,7 +127,6 @@ module ViewContext =
     let WebLog = "web_log"
 
 
-
 /// The HTTP item key for loading the session
 let private sessionLoadedKey = "session-loaded"
 
@@ -174,10 +178,6 @@ let addToHash key (value : obj) (hash : Hash) =
     if hash.ContainsKey key then hash[key] <- value else hash.Add(key, value)
     hash
 
-/// Add anti-CSRF tokens to the given hash
-let withAntiCsrf (ctx : HttpContext) =
-    addToHash ViewContext.AntiCsrfTokens ctx.CsrfTokenSet 
-
 open System.Security.Claims
 open Giraffe
 open Giraffe.Htmx
@@ -186,55 +186,68 @@ open Giraffe.ViewEngine
 /// htmx script tag
 let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
 
-/// Populate the DotLiquid hash with standard information
+/// Get the current user messages, and commit the session so that they are preserved
-let addViewContext ctx (hash : Hash) = task {
+let private getCurrentMessages ctx = task {
     let! messages = messages ctx
     do! commitSession ctx
-    return
+    return messages
-        if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then
+}
-            // We have already populated everything; just update messages
+
-            hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage[]; messages ]
+/// Generate the view context for a response
-            hash
+let private generateViewContext pageTitle messages includeCsrf (ctx: HttpContext) =
-        else
+    { WebLog          = ctx.WebLog
-            ctx.User.Claims
+      UserId          = ctx.User.Claims
                         |> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
-            |> Option.map (fun claim -> addToHash ViewContext.UserId claim.Value hash)
+                        |> Option.map (fun claim -> WebLogUserId claim.Value)
-            |> Option.defaultValue hash
+      PageTitle       = pageTitle
-            |> addToHash ViewContext.WebLog          ctx.WebLog
+      Csrf            = if includeCsrf then Some ctx.CsrfTokenSet else None
-            |> addToHash ViewContext.PageList        (PageListCache.get ctx)
+      PageList        = PageListCache.get ctx
-            |> addToHash ViewContext.Categories      (CategoryCache.get ctx)
+      Categories      = CategoryCache.get ctx
-            |> addToHash ViewContext.CurrentPage     ctx.Request.Path.Value[1..]
+      CurrentPage     = ctx.Request.Path.Value[1..]
-            |> addToHash ViewContext.Messages        messages
+      Messages        = messages
-            |> addToHash ViewContext.Generator       ctx.Generator
+      Generator       = ctx.Generator
-            |> addToHash ViewContext.HtmxScript      htmxScript
+      HtmxScript      = htmxScript
-            |> addToHash ViewContext.IsLoggedOn      ctx.User.Identity.IsAuthenticated
+      IsAuthor        = ctx.HasAccessLevel Author
-            |> addToHash ViewContext.IsAuthor        (ctx.HasAccessLevel Author)
+      IsEditor        = ctx.HasAccessLevel Editor
-            |> addToHash ViewContext.IsEditor        (ctx.HasAccessLevel Editor)
+      IsWebLogAdmin   = ctx.HasAccessLevel WebLogAdmin
-            |> addToHash ViewContext.IsWebLogAdmin   (ctx.HasAccessLevel WebLogAdmin)
+      IsAdministrator = ctx.HasAccessLevel Administrator }
-            |> addToHash ViewContext.IsAdministrator (ctx.HasAccessLevel Administrator)
+
+
+/// Populate the DotLiquid hash with standard information
+let addViewContext ctx (hash: Hash) = task {
+    let! messages = getCurrentMessages ctx
+    if hash.ContainsKey ViewContext.AppViewContext then
+        let oldApp = hash[ViewContext.AppViewContext] :?> AppViewContext
+        let newApp = { oldApp with Messages = Array.concat [ oldApp.Messages; messages ] }
+        return
+            hash
+            |> addToHash ViewContext.AppViewContext newApp
+            |> addToHash ViewContext.Messages       newApp.Messages
+    else
+        let app =
+            generateViewContext (string hash[ViewContext.PageTitle]) messages
+                                (hash.ContainsKey ViewContext.AntiCsrfTokens) ctx
+        return
+            hash
+            |> addToHash ViewContext.UserId          (app.UserId |> Option.map string |> Option.defaultValue "")
+            |> addToHash ViewContext.WebLog          app.WebLog
+            |> addToHash ViewContext.PageList        app.PageList
+            |> addToHash ViewContext.Categories      app.Categories
+            |> addToHash ViewContext.CurrentPage     app.CurrentPage
+            |> addToHash ViewContext.Messages        app.Messages
+            |> addToHash ViewContext.Generator       app.Generator
+            |> addToHash ViewContext.HtmxScript      app.HtmxScript
+            |> addToHash ViewContext.IsLoggedOn      app.IsLoggedOn
+            |> addToHash ViewContext.IsAuthor        app.IsAuthor
+            |> addToHash ViewContext.IsEditor        app.IsEditor
+            |> addToHash ViewContext.IsWebLogAdmin   app.IsWebLogAdmin
+            |> addToHash ViewContext.IsAdministrator app.IsAdministrator
 }
 
 /// Is the request from htmx?
 let isHtmx (ctx: HttpContext) =
     ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
 
-/// Render a view for the specified theme, using the specified template, layout, and hash
-let viewForTheme themeId template next ctx (hash : Hash) = task {
-    let! hash = addViewContext ctx hash
-    let (ThemeId theme) = themeId
-    // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
-    //       the net effect is a "layout" capability similar to Razor or Pug
-    
-    // Render view content...
-    let! contentTemplate = TemplateCache.get theme template ctx.Data
-    let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
-    
-    // ...then render that content with its layout
-    let! layoutTemplate = TemplateCache.get theme (if isHtmx ctx then "layout-partial" else "layout") ctx.Data
-    
-    return! htmlString (layoutTemplate.Render hash) next ctx
-}
-
 /// Convert messages to headers (used for htmx responses)
 let messagesToHeaders (messages: UserMessage array) : HttpHandler =
     seq {
@@ -249,49 +262,14 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
     }
     |> Seq.reduce (>=>)
 
-/// Render a bare view for the specified theme, using the specified template and hash
-let bareForTheme themeId template next ctx (hash : Hash) = task {
-    let! hash = addViewContext ctx hash
-    let (ThemeId theme) = themeId
-    
-    if not (hash.ContainsKey ViewContext.Content) then
-        let! contentTemplate = TemplateCache.get theme template ctx.Data
-        addToHash ViewContext.Content (contentTemplate.Render hash) hash |> ignore
-    
-    // Bare templates are rendered with layout-bare
-    let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
-    return!
-        (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
-         >=> htmlString (layoutTemplate.Render hash))
-            next ctx
-}
-
-/// Return a view for the web log's default theme
-let themedView template next ctx hash = task {
-    let! hash = addViewContext ctx hash
-    return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
-}
-
-/// Display a view for the admin theme
-let adminView template =
-    viewForTheme (ThemeId "admin") template
-
-/// Display a bare view for the admin theme
-let adminBareView template =
-    bareForTheme (ThemeId "admin") template
-
 /// Redirect after doing some action; commits session and issues a temporary redirect
 let redirectToGet url : HttpHandler = fun _ ctx -> task {
     do! commitSession ctx
-    return! redirectTo false (WebLog.relativeUrl ctx.WebLog (Permalink url)) earlyReturn ctx
+    return! redirectTo false (ctx.WebLog.RelativeUrl(Permalink url)) earlyReturn ctx
 }
 
-/// Validate the anti cross-site request forgery token in the current request
+/// The MIME type for podcast episode JSON chapters
-let validateCsrf : HttpHandler = fun next ctx -> task {
+let JSON_CHAPTERS = "application/json+chapters"
-    match! ctx.AntiForgery.IsRequestValidAsync ctx with
-    | true -> return! next ctx
-    | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
-}
 
 
 /// Handlers for error conditions
@@ -303,29 +281,106 @@ module Error =
     let notAuthorized : HttpHandler = fun next ctx ->
         if ctx.Request.Method = "GET" then
             let redirectUrl = $"user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
-            if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectToGet redirectUrl) next ctx
+            (next, ctx)
-            else redirectToGet redirectUrl next ctx
+            ||> if isHtmx ctx then withHxRedirect redirectUrl >=> withHxRetarget "body" >=> redirectToGet redirectUrl
+                else redirectToGet redirectUrl
         else
             if isHtmx ctx then
                 let messages = [|
-                    { UserMessage.error with
+                    { UserMessage.Error with
-                        Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}"
+                        Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" }
-                    }
                 |]
                 (messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
             else setStatusCode 401 earlyReturn ctx
 
-    /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
+    /// Handle 404s
     let notFound : HttpHandler =
         handleContext (fun ctx ->
             if isHtmx ctx then
                 let messages = [|
-                    { UserMessage.error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
+                    { UserMessage.Error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
                 |]
-                (messagesToHeaders messages >=> setStatusCode 404) earlyReturn ctx
+                RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
-            else
+            else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
-                (setStatusCode 404 >=> text "Not found") earlyReturn ctx)
     
+    let server message : HttpHandler =
+        handleContext (fun ctx ->
+            if isHtmx ctx then
+                let messages = [| { UserMessage.Error with Message = message } |]
+                ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
+            else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
+
+
+/// Render a view for the specified theme, using the specified template, layout, and hash
+let viewForTheme themeId template next ctx (hash: Hash) = task {
+    let! hash = addViewContext ctx hash
+    
+    // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
+    //       the net effect is a "layout" capability similar to Razor or Pug
+    
+    // Render view content...
+    match! TemplateCache.get themeId template ctx.Data with
+    | Ok contentTemplate ->
+        let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
+        // ...then render that content with its layout
+        match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
+        | Ok layoutTemplate ->  return! htmlString (layoutTemplate.Render hash) next ctx
+        | Error message -> return! Error.server message next ctx
+    | Error message -> return! Error.server message next ctx
+}
+
+/// Render a bare view for the specified theme, using the specified template and hash
+let bareForTheme themeId template next ctx (hash: Hash) = task {
+    let! hash        = addViewContext ctx hash
+    let  withContent = task {
+        if hash.ContainsKey ViewContext.Content then return Ok hash
+        else
+            match! TemplateCache.get themeId template ctx.Data with
+            | Ok contentTemplate -> return Ok(addToHash ViewContext.Content (contentTemplate.Render hash) hash)
+            | Error message -> return Error message 
+    }
+    match! withContent with
+    | Ok completeHash ->
+        // Bare templates are rendered with layout-bare
+        match! TemplateCache.get themeId "layout-bare" ctx.Data with
+        | Ok layoutTemplate ->
+            return!
+                (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array)
+                 >=> htmlString (layoutTemplate.Render completeHash))
+                    next ctx
+        | Error message -> return! Error.server message next ctx
+    | Error message -> return! Error.server message next ctx
+}
+
+/// Return a view for the web log's default theme
+let themedView template next ctx hash = task {
+    let! hash = addViewContext ctx hash
+    return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
+}
+
+/// Display a page for an admin endpoint
+let adminPage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
+    let! messages = getCurrentMessages ctx
+    let  appCtx   = generateViewContext pageTitle messages includeCsrf ctx
+    let  layout   = if isHtmx ctx then Layout.partial else Layout.full
+    return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx
+}
+
+/// Display a bare page for an admin endpoint
+let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
+    let! messages = getCurrentMessages ctx
+    let  appCtx   = generateViewContext pageTitle messages includeCsrf ctx
+    return!
+        (    messagesToHeaders appCtx.Messages
+         >=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx
+}
+
+/// Validate the anti cross-site request forgery token in the current request
+let validateCsrf : HttpHandler = fun next ctx -> task {
+    match! ctx.AntiForgery.IsRequestValidAsync ctx with
+    | true -> return! next ctx
+    | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
+}
 
 /// Require a user to be logged on
 let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
@@ -333,17 +388,16 @@ let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
 /// Require a specific level of access for a route
 let requireAccess level : HttpHandler = fun next ctx -> task {
     match ctx.UserAccessLevel with
-    | Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx
+    | Some userLevel when userLevel.HasAccess level -> return! next ctx
     | Some userLevel ->
         do! addMessage ctx
-                { UserMessage.warning with
+                { UserMessage.Warning with
-                    Message = $"The page you tried to access requires {AccessLevel.toString level} privileges"
+                    Message = $"The page you tried to access requires {level} privileges"
-                    Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges"
+                    Detail = Some $"Your account only has {userLevel} privileges" }
-                }
         return! Error.notAuthorized next ctx
     | None ->
         do! addMessage ctx
-                { UserMessage.warning with Message = "The page you tried to access required you to be logged on" }
+                { UserMessage.Warning with Message = "The page you tried to access required you to be logged on" }
         return! Error.notAuthorized next ctx
 }
 
@@ -356,36 +410,39 @@ open System.Threading.Tasks
 /// Create a Task with a Some result for the given object
 let someTask<'T> (it: 'T) = Task.FromResult(Some it)
 
-open System.Collections.Generic
+/// Create an absolute URL from a string that may already be an absolute URL
+let absoluteUrl (url: string) (ctx: HttpContext) =
+    if url.StartsWith "http" then url else ctx.WebLog.AbsoluteUrl(Permalink url)
+
+
 open MyWebLog.Data
 
-/// Get the templates available for the current web log's theme (in a key/value pair list)
+/// Get the templates available for the current web log's theme (in a meta item list)
 let templatesForTheme (ctx: HttpContext) (typ: string) = backgroundTask {
     match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with
     | Some theme ->
         return seq {
-            KeyValuePair.Create ("", $"- Default (single-{typ}) -")
+            { Name = ""; Value = $"- Default (single-{typ}) -" }
             yield!
                 theme.Templates
                 |> Seq.ofList
                 |> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}")
-                |> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name))
+                |> Seq.map (fun it -> { Name = it.Name; Value = it.Name })
         }
-        |> Array.ofSeq
+    | None -> return seq { { Name = ""; Value = $"- Default (single-{typ}) -" } }
-    | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |]
 }
 
 /// Get all authors for a list of posts as metadata items
 let getAuthors (webLog: WebLog) (posts: Post list) (data: IData) =
     posts
-    |> List.map (fun p -> p.AuthorId)
+    |> List.map _.AuthorId
     |> List.distinct
     |> data.WebLogUser.FindNames webLog.Id
 
 /// Get all tag mappings for a list of posts as metadata items
 let getTagMappings (webLog: WebLog) (posts: Post list) (data: IData) =
     posts
-    |> List.map (fun p -> p.Tags)
+    |> List.map _.Tags
     |> List.concat
     |> List.distinct
     |> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id
@@ -401,12 +458,12 @@ let getCategoryIds slug ctx =
     |> Seq.map (fun c -> CategoryId c.Id)
     |> List.ofSeq
 
-open System
+open NodaTime
-open System.Globalization
 
 /// Parse a date/time to UTC 
-let parseToUtc (date : string) =
+let parseToUtc (date: string) : Instant =
-    DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
+    let result = roundTrip.Parse date
+    if result.Success then result.Value else raise result.Exception
 
 open Microsoft.Extensions.DependencyInjection
 open Microsoft.Extensions.Logging
@@ -436,4 +493,3 @@ let warn (name : string) (ctx : HttpContext) msg =
     let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
     let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
     log.LogWarning msg
-    

src/MyWebLog/Handlers/Page.fs

@@ -9,21 +9,22 @@ open MyWebLog.ViewModels
 // GET /admin/pages/page/{pageNbr}
 let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let! pages = ctx.Data.Page.FindPageOfPages ctx.WebLog.Id pageNbr
+    let displayPages =
+        pages
+        |> Seq.ofList
+        |> Seq.truncate 25
+        |> Seq.map (DisplayPage.FromPageMinimal ctx.WebLog)
+        |> List.ofSeq
     return!
-        hashForPage "Pages"
+        Views.Page.pageList displayPages pageNbr (pages.Length > 25)
-        |> withAntiCsrf ctx
+        |> adminPage "Pages" true next ctx
-        |> addToHash "pages"     (pages |> List.map (DisplayPage.fromPageMinimal ctx.WebLog))
-        |> addToHash "page_nbr"  pageNbr
-        |> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}")
-        |> addToHash "next_page" $"/page/{pageNbr + 1}"
-        |> adminView "page-list" next ctx
 }
 
 // GET /admin/page/{id}/edit
 let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let! result = task {
         match pgId with
-        | "new" -> return Some ("Add a New Page", { Page.empty with Id = PageId "new"; AuthorId = ctx.UserId })
+        | "new" -> return Some ("Add a New Page", { Page.Empty with Id = PageId "new"; AuthorId = ctx.UserId })
         | _ ->
             match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
             | Some page -> return Some ("Edit Page", page)
@@ -31,29 +32,21 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     }
     match result with
     | Some (title, page) when canEdit page.AuthorId ctx ->
-        let  model     = EditPageModel.fromPage page
+        let  model     = EditPageModel.FromPage page
         let! templates = templatesForTheme ctx "page"
-        return!
+        return! adminPage title true next ctx (Views.Page.pageEdit model templates)
-            hashForPage title
-            |> withAntiCsrf ctx
-            |> addToHash ViewContext.Model model
-            |> addToHash "metadata" (
-                 Array.zip model.MetaNames model.MetaValues
-                 |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
-            |> addToHash "templates" templates
-            |> adminView "page-edit" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/page/{id}/delete
+// DELETE /admin/page/{id}
 let delete pgId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     match! ctx.Data.Page.Delete (PageId pgId) ctx.WebLog.Id with
     | true ->
         do! PageListCache.update ctx
-        do! addMessage ctx { UserMessage.success with Message = "Page deleted successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Page deleted successfully" }
-    | false -> do! addMessage ctx { UserMessage.error with Message = "Page not found; nothing deleted" }
+    | false -> do! addMessage ctx { UserMessage.Error with Message = "Page not found; nothing deleted" }
-    return! redirectToGet "admin/pages" next ctx
+    return! all 1 next ctx
 }
 
 // GET /admin/page/{id}/permalinks
@@ -61,10 +54,9 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
     match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
     | Some pg when canEdit pg.AuthorId ctx ->
         return!
-            hashForPage "Manage Prior Permalinks"
+            ManagePermalinksModel.FromPage pg
-            |> withAntiCsrf ctx
+            |> Views.Helpers.managePermalinks
-            |> addToHash ViewContext.Model (ManagePermalinksModel.fromPage pg)
+            |> adminPage "Manage Prior Permalinks" true next ctx
-            |> adminView "permalinks" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
@@ -78,7 +70,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
         let  links = model.Prior |> Array.map Permalink |> List.ofArray
         match! ctx.Data.Page.UpdatePriorPermalinks pageId ctx.WebLog.Id links with
         | true ->
-            do! addMessage ctx { UserMessage.success with Message = "Page permalinks saved successfully" }
+            do! addMessage ctx { UserMessage.Success with Message = "Page permalinks saved successfully" }
             return! redirectToGet $"admin/page/{model.Id}/permalinks" next ctx
         | false -> return! Error.notFound next ctx
     | Some _ -> return! Error.notAuthorized next ctx
@@ -90,22 +82,21 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
     match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
     | Some pg when canEdit pg.AuthorId ctx ->
         return!
-            hashForPage "Manage Page Revisions"
+            ManageRevisionsModel.FromPage pg
-            |> withAntiCsrf ctx
+            |> Views.Helpers.manageRevisions
-            |> addToHash ViewContext.Model (ManageRevisionsModel.fromPage ctx.WebLog pg)
+            |> adminPage "Manage Page Revisions" true next ctx
-            |> adminView "revisions" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// GET /admin/page/{id}/revisions/purge
+// DELETE /admin/page/{id}/revisions
 let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let data = ctx.Data
     match! data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
     | Some pg ->
         do! data.Page.Update { pg with Revisions = [ List.head pg.Revisions ] }
-        do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
-        return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
+        return! editRevisions pgId next ctx
     | None -> return! Error.notFound next ctx
 }
 
@@ -124,40 +115,33 @@ let private findPageRevision pgId revDate (ctx : HttpContext) = task {
 let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! findPageRevision pgId revDate ctx with
     | Some pg, Some rev when canEdit pg.AuthorId ctx ->
-        return! {|
+        return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
-            content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
-        |}
-        |> makeHash |> adminBareView "" next ctx
     | Some _, Some _ -> return! Error.notAuthorized next ctx
-    | None, _
+    | None, _ | _, None -> return! Error.notFound next ctx
-    | _, None -> return! Error.notFound next ctx
 }
 
-open System
-
 // POST /admin/page/{id}/revision/{revision-date}/restore
 let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! findPageRevision pgId revDate ctx with
     | Some pg, Some rev when canEdit pg.AuthorId ctx ->
         do! ctx.Data.Page.Update
                 { pg with
-                    Revisions = { rev with AsOf = DateTime.UtcNow }
+                    Revisions = { rev with AsOf = Noda.now () }
-                                  :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
+                                  :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
-                }
+        do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
-        do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
         return! redirectToGet $"admin/page/{pgId}/revisions" next ctx
     | Some _, Some _ -> return! Error.notAuthorized next ctx
     | None, _
     | _, None -> return! Error.notFound next ctx
 }
 
-// POST /admin/page/{id}/revision/{revision-date}/delete
+// DELETE /admin/page/{id}/revision/{revision-date}
 let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! findPageRevision pgId revDate ctx with
     | Some pg, Some rev when canEdit pg.AuthorId ctx ->
         do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
-        do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
-        return! adminBareView "" next ctx (makeHash {| content = "" |})
+        return! adminBarePage "" false next ctx (fun _ -> [])
     | Some _, Some _ -> return! Error.notAuthorized next ctx
     | None, _
     | _, None -> return! Error.notFound next ctx
@@ -167,24 +151,24 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
 let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let! model   = ctx.BindFormAsync<EditPageModel>()
     let  data    = ctx.Data
-    let  now     = DateTime.UtcNow
+    let  now     = Noda.now ()
     let  tryPage =
         if model.IsNew then
-            { Page.empty with
+            { Page.Empty with
-                Id          = PageId.create ()
+                Id          = PageId.Create()
                 WebLogId    = ctx.WebLog.Id
                 AuthorId    = ctx.UserId
                 PublishedOn = now
             } |> someTask
-        else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
+        else data.Page.FindFullById (PageId model.Id) ctx.WebLog.Id
     match! tryPage with
     | Some page when canEdit page.AuthorId ctx ->
         let updateList  = page.IsInPageList <> model.IsShownInPageList
         let updatedPage = model.UpdatePage page now
         do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
         if updateList then do! PageListCache.update ctx
-        do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Page saved successfully" }
-        return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx
+        return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }

src/MyWebLog/Handlers/Post.fs

@@ -27,6 +27,7 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) =
     pageNbr, String.Join("/", slugParts), isFeed
 
 /// The type of post list being prepared
+[<Struct>]
 type ListType =
     | AdminList
     | CategoryList
@@ -42,23 +43,23 @@ open MyWebLog.ViewModels
 let preparePostList webLog posts listType (url: string) pageNbr perPage (data: IData) = task {
     let! authors     = getAuthors     webLog posts data
     let! tagMappings = getTagMappings webLog posts data
-    let  relUrl it   = Some <| WebLog.relativeUrl webLog (Permalink it)
+    let  relUrl it   = Some <| webLog.RelativeUrl(Permalink it)
     let  postItems   =
         posts
         |> Seq.ofList
         |> Seq.truncate perPage
-        |> Seq.map (PostListItem.fromPost webLog)
+        |> Seq.map (PostListItem.FromPost webLog)
         |> Array.ofSeq
     let! olderPost, newerPost =
         match listType with
         | SinglePost ->
             let post   = List.head posts
-            let dateTime = defaultArg post.PublishedOn post.UpdatedOn
+            let target = defaultArg post.PublishedOn post.UpdatedOn
-            data.Post.FindSurroundingPosts webLog.Id dateTime
+            data.Post.FindSurroundingPosts webLog.Id target
         | _ -> Task.FromResult(None, None)
     let newerLink =
         match listType, pageNbr with
-        | SinglePost,   _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
+        | SinglePost,   _ -> newerPost |> Option.map (fun it -> string it.Permalink)
         | _,            1 -> None
         | PostList,     2    when webLog.DefaultPage = "posts" -> Some ""
         | PostList,     _ -> relUrl $"page/{pageNbr - 1}"
@@ -70,7 +71,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
         | AdminList,    _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
     let olderLink =
         match listType, List.length posts > perPage with
-        | SinglePost,   _     -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
+        | SinglePost,   _     -> olderPost |> Option.map (fun it -> string it.Permalink)
         | _,            false -> None
         | PostList,     true  -> relUrl $"page/{pageNbr + 1}"
         | CategoryList, true  -> relUrl $"category/{url}/page/{pageNbr + 1}"
@@ -81,9 +82,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
           Authors    = authors
           Subtitle   = None
           NewerLink  = newerLink
-          NewerName  = newerPost |> Option.map (fun p -> p.Title)
+          NewerName  = newerPost |> Option.map _.Title
           OlderLink  = olderLink
-          OlderName  = olderPost |> Option.map (fun p -> p.Title)
+          OlderName  = olderPost |> Option.map _.Title
         }
     return
         makeHash {||}
@@ -115,7 +116,7 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
 
 // GET /page/{pageNbr}/
 let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx ->
-    redirectTo true (WebLog.relativeUrl ctx.WebLog (Permalink $"page/{pageNbr}")) next ctx
+    redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
 
 // GET /category/{slug}/
 // GET /category/{slug}/page/{pageNbr}
@@ -184,7 +185,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
                     let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}"
                     return!
                         redirectTo true
-                            (WebLog.relativeUrl webLog (Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
+                            (webLog.RelativeUrl(Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}"""))
                             next ctx
                 | _ -> return! Error.notFound next ctx
     | None, _, _ -> return! Error.notFound next ctx
@@ -200,22 +201,60 @@ let home : HttpHandler = fun next ctx -> task {
         | Some page ->
             return!
                 hashForPage page.Title
-                |> addToHash "page" (DisplayPage.fromPage webLog page)
+                |> addToHash "page" (DisplayPage.FromPage webLog page)
                 |> addToHash ViewContext.IsHome true
                 |> themedView (defaultArg page.Template "single-page") next ctx
         | None -> return! Error.notFound next ctx
 }
 
+// GET /{post-permalink}?chapters
+let chapters (post: Post) : HttpHandler = fun next ctx ->
+    match post.Episode with
+    | Some ep ->
+        match ep.Chapters with
+        | Some chapters ->
+            let chapterData =
+                chapters
+                |> Seq.ofList
+                |> Seq.map (fun it ->
+                    let dic = Dictionary<string, obj>()
+                    dic["startTime"] <- Math.Round(it.StartTime.TotalSeconds, 2)
+                    it.Title    |> Option.iter (fun ttl -> dic["title"]   <- ttl)
+                    it.ImageUrl |> Option.iter (fun img -> dic["img"]     <- absoluteUrl img ctx)
+                    it.Url      |> Option.iter (fun url -> dic["url"]     <- absoluteUrl url ctx)
+                    it.IsHidden |> Option.iter (fun toc -> dic["toc"]     <- not toc)
+                    it.EndTime  |> Option.iter (fun ent -> dic["endTime"] <- Math.Round(ent.TotalSeconds, 2))
+                    it.Location |> Option.iter (fun loc ->
+                        let locData = Dictionary<string, obj>()
+                        locData["name"] <- loc.Name
+                        locData["geo"]  <- loc.Geo
+                        loc.Osm |> Option.iter (fun osm -> locData["osm"] <- osm)
+                        dic["location"] <- locData)
+                    dic)
+                |> ResizeArray
+            let jsonFile = Dictionary<string, obj>()
+            jsonFile["version"]  <- "1.2.0"
+            jsonFile["title"]    <- post.Title
+            jsonFile["fileName"] <- absoluteUrl ep.Media ctx
+            if defaultArg ep.ChapterWaypoints false then jsonFile["waypoints"] <- true
+            jsonFile["chapters"] <- chapterData
+            (setContentType JSON_CHAPTERS >=> json jsonFile) next ctx
+        | None ->
+            match ep.ChapterFile with
+            | Some file -> redirectTo true file next ctx
+            | None -> Error.notFound next ctx
+    | None -> Error.notFound next ctx
+
+
+// ~~ ADMINISTRATION ~~
+
 // GET /admin/posts
 // GET /admin/posts/page/{pageNbr}
 let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let  data  = ctx.Data
     let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
     let! hash  = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
-    return!
+    return! adminPage "Posts" true next ctx (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay))
-           addToHash ViewContext.PageTitle "Posts" hash
-        |> withAntiCsrf ctx
-        |> adminView "post-list" next ctx
 }
 
 // GET /admin/post/{id}/edit
@@ -223,7 +262,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let  data   = ctx.Data
     let! result = task {
         match postId with
-        | "new" -> return Some ("Write a New Post", { Post.empty with Id = PostId "new" })
+        | "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
         | _ ->
             match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
             | Some post -> return Some ("Edit Post", post)
@@ -232,32 +271,25 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match result with
     | Some (title, post) when canEdit post.AuthorId ctx ->
         let! templates = templatesForTheme ctx "post"
-        let  model     = EditPostModel.fromPost ctx.WebLog post
+        let  model     = EditPostModel.FromPost ctx.WebLog post
-        return!
+        let  ratings   = [
-            hashForPage title
+            { Name = "";           Value = "&ndash; Default &ndash;" }
-            |> withAntiCsrf ctx
+            { Name = string Yes;   Value = "Yes" }
-            |> addToHash ViewContext.Model model
+            { Name = string No;    Value = "No" }
-            |> addToHash "metadata" (
+            { Name = string Clean; Value = "Clean" }
-                Array.zip model.MetaNames model.MetaValues
+        ]
-                |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
+        return! adminPage title true next ctx (Views.Post.postEdit model templates ratings)
-            |> addToHash "templates" templates
-            |> addToHash "explicit_values" [|
-                KeyValuePair.Create ("", "&ndash; Default &ndash;")
-                KeyValuePair.Create (ExplicitRating.toString Yes,   "Yes")
-                KeyValuePair.Create (ExplicitRating.toString No,    "No")
-                KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
-            |]
-            |> adminView "post-edit" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/post/{id}/delete
+// DELETE /admin/post/{id}
 let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
-    | true  -> do! addMessage ctx { UserMessage.success with Message = "Post deleted successfully" }
+    | true  -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
-    | false -> do! addMessage ctx { UserMessage.error with Message = "Post not found; nothing deleted" }
+    | false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
-    return! redirectToGet "admin/posts" next ctx
+    //return! redirectToGet "admin/posts" next ctx
+    return! all 1 next ctx
 }
 
 // GET /admin/post/{id}/permalinks
@@ -265,10 +297,9 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
     match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
     | Some post when canEdit post.AuthorId ctx ->
         return!
-            hashForPage "Manage Prior Permalinks"
+            ManagePermalinksModel.FromPost post
-            |> withAntiCsrf ctx
+            |> Views.Helpers.managePermalinks
-            |> addToHash ViewContext.Model (ManagePermalinksModel.fromPost post)
+            |> adminPage "Manage Prior Permalinks" true next ctx
-            |> adminView "permalinks" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
@@ -282,7 +313,7 @@ let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task
         let links = model.Prior |> Array.map Permalink |> List.ofArray
         match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
         | true ->
-            do! addMessage ctx { UserMessage.success with Message = "Post permalinks saved successfully" }
+            do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
             return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
         | false -> return! Error.notFound next ctx
     | Some _ -> return! Error.notAuthorized next ctx
@@ -294,22 +325,21 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
     match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
     | Some post when canEdit post.AuthorId ctx ->
         return!
-            hashForPage "Manage Post Revisions"
+            ManageRevisionsModel.FromPost post
-            |> withAntiCsrf ctx
+            |> Views.Helpers.manageRevisions
-            |> addToHash ViewContext.Model (ManageRevisionsModel.fromPost ctx.WebLog post)
+            |> adminPage "Manage Post Revisions" true next ctx
-            |> adminView "revisions" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// GET /admin/post/{id}/revisions/purge
+// DELETE /admin/post/{id}/revisions
 let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let data = ctx.Data
     match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
     | Some post when canEdit post.AuthorId ctx ->
         do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
-        do! addMessage ctx { UserMessage.success with Message = "Prior revisions purged successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
-        return! redirectToGet $"admin/post/{postId}/revisions" next ctx
+        return! editRevisions postId next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }
@@ -329,13 +359,9 @@ let private findPostRevision postId revDate (ctx : HttpContext) = task {
 let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! findPostRevision postId revDate ctx with
     | Some post, Some rev when canEdit post.AuthorId ctx ->
-        return! {|
+        return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
-            content = $"""<div class="mwl-revision-preview mb-3">{MarkupText.toHtml rev.Text}</div>"""
-        |}
-        |> makeHash |> adminBareView "" next ctx
     | Some _, Some _ -> return! Error.notAuthorized next ctx
-    | None, _
+    | None, _ | _, None -> return! Error.notFound next ctx
-    | _, None -> return! Error.notFound next ctx
 }
 
 // POST /admin/post/{id}/revision/{revision-date}/restore
@@ -344,46 +370,130 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
     | Some post, Some rev when canEdit post.AuthorId ctx ->
         do! ctx.Data.Post.Update
                 { post with
-                    Revisions = { rev with AsOf = DateTime.UtcNow }
+                    Revisions = { rev with AsOf = Noda.now () }
-                                  :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
+                                  :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
-                }
+        do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
-        do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
         return! redirectToGet $"admin/post/{postId}/revisions" next ctx
     | Some _, Some _ -> return! Error.notAuthorized next ctx
     | None, _
     | _, None -> return! Error.notFound next ctx
 }
 
-// POST /admin/post/{id}/revision/{revision-date}/delete
+// DELETE /admin/post/{id}/revision/{revision-date}
 let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! findPostRevision postId revDate ctx with
     | Some post, Some rev when canEdit post.AuthorId ctx ->
         do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
-        do! addMessage ctx { UserMessage.success with Message = "Revision deleted successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
-        return! adminBareView "" next ctx (makeHash {| content = "" |})
+        return! adminBarePage "" false next ctx (fun _ -> [])
     | Some _, Some _ -> return! Error.notAuthorized next ctx
     | None, _
     | _, None -> return! Error.notFound next ctx
 }
 
+// GET /admin/post/{id}/chapters
+let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
+    match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
+    | Some post
+        when    Option.isSome post.Episode
+             && Option.isSome post.Episode.Value.Chapters
+             && canEdit post.AuthorId ctx ->
+        return!
+            Views.Post.chapters false (ManageChaptersModel.Create post)
+            |> adminPage "Manage Chapters" true next ctx
+    | Some _ | None -> return! Error.notFound next ctx
+}
+
+// GET /admin/post/{id}/chapter/{idx}
+let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
+    match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
+    | Some post
+        when    Option.isSome post.Episode
+             && Option.isSome post.Episode.Value.Chapters
+             && canEdit post.AuthorId ctx ->
+        let chapter =
+            if index = -1 then Some Chapter.Empty
+            else
+                let chapters = post.Episode.Value.Chapters.Value
+                if index < List.length chapters then Some chapters[index] else None
+        match chapter with
+        | Some chap ->
+            return!
+                Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
+                |> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true next ctx
+        | None -> return! Error.notFound next ctx
+    | Some _ | None -> return! Error.notFound next ctx
+}
+
+// POST /admin/post/{id}/chapter/{idx}
+let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
+    let data = ctx.Data
+    match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
+    | Some post
+        when    Option.isSome post.Episode
+             && Option.isSome post.Episode.Value.Chapters
+             && canEdit post.AuthorId ctx ->
+        let! form     = ctx.BindFormAsync<EditChapterModel>()
+        let  chapters = post.Episode.Value.Chapters.Value
+        if index >= -1 && index < List.length chapters then
+            try
+                let chapter     = form.ToChapter()
+                let existing    = if index = -1 then chapters else List.removeAt index chapters
+                let updatedPost =
+                    { post with
+                        Episode = Some
+                          { post.Episode.Value with
+                              Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
+                do! data.Post.Update updatedPost
+                do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
+                return!
+                    Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
+                    |> adminBarePage "Manage Chapters" true next ctx
+            with
+            | ex -> return! Error.server ex.Message next ctx
+        else return! Error.notFound next ctx
+    | Some _ | None -> return! Error.notFound next ctx
+}
+
+// DELETE /admin/post/{id}/chapter/{idx}
+let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
+    let data = ctx.Data
+    match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
+    | Some post
+        when    Option.isSome post.Episode
+             && Option.isSome post.Episode.Value.Chapters
+             && canEdit post.AuthorId ctx ->
+        let  chapters = post.Episode.Value.Chapters.Value
+        if index >= 0 && index < List.length chapters then
+            let updatedPost =
+                { post with
+                    Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } }
+            do! data.Post.Update updatedPost
+            do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
+            return!
+                Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)
+                |> adminPage "Manage Chapters" true next ctx
+        else return! Error.notFound next ctx
+    | Some _ | None -> return! Error.notFound next ctx
+}
+
 // POST /admin/post/save
 let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let! model   = ctx.BindFormAsync<EditPostModel>()
     let  data    = ctx.Data
-    let  now     = DateTime.UtcNow
     let  tryPost =
         if model.IsNew then
-            { Post.empty with
+            { Post.Empty with
-                Id        = PostId.create ()
+                Id        = PostId.Create()
                 WebLogId  = ctx.WebLog.Id
-                AuthorId  = ctx.UserId
+                AuthorId  = ctx.UserId }
-            } |> someTask
+            |> someTask
-        else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
+        else data.Post.FindFullById (PostId model.Id) ctx.WebLog.Id
     match! tryPost with
     | Some post when canEdit post.AuthorId ctx ->
         let priorCats   = post.CategoryIds
         let updatedPost =
-            model.UpdatePost post now
+            model.UpdatePost post (Noda.now ())
             |> function
             | post ->
                 if model.SetPublished then
@@ -392,11 +502,10 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
                         { post with
                             PublishedOn = Some dt
                             UpdatedOn   = dt
-                            Revisions   = [ { (List.head post.Revisions) with AsOf = dt } ]
+                            Revisions   = [ { (List.head post.Revisions) with AsOf = dt } ] }
-                        }
                     else { post with PublishedOn = Some dt }
                 else post
-        do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost
+        do! (if model.IsNew then data.Post.Add else data.Post.Update) updatedPost
         // If the post was published or its categories changed, refresh the category cache
         if model.DoPublish
            || not (priorCats
@@ -404,8 +513,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
                    |> List.distinct
                    |> List.length = List.length priorCats) then
             do! CategoryCache.update ctx
-        do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
-        return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
+        return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
     | Some _ -> return! Error.notAuthorized next ctx
     | None -> return! Error.notFound next ctx
 }

src/MyWebLog/Handlers/Routes.fs

@@ -16,22 +16,27 @@ module CatchAll =
         let data     = ctx.Data
         let debug    = debug "Routes.CatchAll" ctx
         let textLink =
-            let _, extra = WebLog.hostAndPath webLog
+            let extra = webLog.ExtraPath
             let url   = string ctx.Request.Path
-            (if extra = "" then url else url.Substring extra.Length).ToLowerInvariant ()
+            (if extra = "" then url else url[extra.Length..]).ToLowerInvariant()
         let await it = (Async.AwaitTask >> Async.RunSynchronously) it
         seq {
             debug (fun () -> $"Considering URL {textLink}")
             // Home page directory without the directory slash 
-            if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
+            if textLink = "" then yield redirectTo true (webLog.RelativeUrl Permalink.Empty)
-            let permalink = Permalink (textLink.Substring 1)
+            let permalink = Permalink textLink[1..]
             // Current post
             match data.Post.FindByPermalink permalink webLog.Id |> await with
             | Some post ->
                 debug (fun () -> "Found post by permalink")
-                let hash = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data |> await
+                if post.Status = Published || Option.isSome ctx.UserAccessLevel then
+                    if ctx.Request.Query.ContainsKey "chapters" then
+                        yield Post.chapters post
+                    else
                         yield fun next ctx ->
-                       addToHash ViewContext.PageTitle post.Title hash
+                            Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data
+                            |> await
+                            |> addToHash ViewContext.PageTitle post.Title
                             |> themedView (defaultArg post.Template "single-post") next ctx
             | None -> ()
             // Current page
@@ -40,7 +45,7 @@ module CatchAll =
                 debug (fun () -> "Found page by permalink")
                 yield fun next ctx ->
                     hashForPage page.Title
-                    |> addToHash "page"             (DisplayPage.fromPage webLog page)
+                    |> addToHash "page"             (DisplayPage.FromPage webLog page)
                     |> addToHash ViewContext.IsPage true
                     |> themedView (defaultArg page.Template "single-page") next ctx
             | None -> ()
@@ -56,25 +61,25 @@ module CatchAll =
             match data.Post.FindByPermalink altLink webLog.Id |> await with
             | Some post ->
                 debug (fun () -> "Found post by trailing-slash-agnostic permalink")
-                yield redirectTo true (WebLog.relativeUrl webLog post.Permalink)
+                yield redirectTo true (webLog.RelativeUrl post.Permalink)
             | None -> ()
             // Page differing only by trailing slash
             match data.Page.FindByPermalink altLink webLog.Id |> await with
             | Some page ->
                 debug (fun () -> "Found page by trailing-slash-agnostic permalink")
-                yield redirectTo true (WebLog.relativeUrl webLog page.Permalink)
+                yield redirectTo true (webLog.RelativeUrl page.Permalink)
             | None -> ()
             // Prior post
             match data.Post.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
             | Some link ->
                 debug (fun () -> "Found post by prior permalink")
-                yield redirectTo true (WebLog.relativeUrl webLog link)
+                yield redirectTo true (webLog.RelativeUrl link)
             | None -> ()
             // Prior page
             match data.Page.FindCurrentPermalink [ permalink; altLink ] webLog.Id |> await with
             | Some link ->
                 debug (fun () -> "Found page by prior permalink")
-                yield redirectTo true (WebLog.relativeUrl webLog link)
+                yield redirectTo true (webLog.RelativeUrl link)
             | None -> ()
             debug (fun () -> "No content found")
         }
@@ -90,11 +95,11 @@ module Asset =
     // GET /theme/{theme}/{**path}
     let serve (urlParts: string seq) : HttpHandler = fun next ctx -> task {
         let path = urlParts |> Seq.skip 1 |> Seq.head
-        match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
+        match! ctx.Data.ThemeAsset.FindById(ThemeAssetId.Parse path) with
         | Some asset ->
             match Upload.checkModified asset.UpdatedOn ctx with
             | Some threeOhFour -> return! threeOhFour next ctx
-            | None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
+            | None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc()) path asset.Data next ctx
         | None -> return! Error.notFound next ctx
     }
 
@@ -106,12 +111,13 @@ let router : HttpHandler = choose [
     ]
     subRoute "/admin" (requireUser >=> choose [
         GET_HEAD >=> choose [
-            subRoute "/categor" (choose [
+            route    "/administration" >=> Admin.Dashboard.admin
-                route  "ies"       >=> Admin.listCategories
+            subRoute "/categor" (requireAccess WebLogAdmin >=> choose [
-                route  "ies/bare"  >=> Admin.listCategoriesBare
+                route  "ies"       >=> Admin.Category.all
-                routef "y/%s/edit"     Admin.editCategory
+                routef "y/%s/edit"     Admin.Category.edit
             ])
-            route    "/dashboard" >=> Admin.dashboard
+            route    "/dashboard" >=> Admin.Dashboard.user
+            route    "/my-info"   >=> User.myInfo
             subRoute "/page" (choose [
                 route  "s"                       >=> Page.all 1
                 routef "s/page/%i"                   Page.all
@@ -127,74 +133,97 @@ let router : HttpHandler = choose [
                 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" (choose [
+            subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
-                route ""     >=> Admin.settings
+                route    ""             >=> Admin.WebLog.settings
-                subRoute "/rss" (choose [
+                routef   "/rss/%s/edit"     Feed.editCustomFeed
-                    route  ""         >=> Feed.editSettings
+                subRoute "/redirect-rules" (choose [
-                    routef "/%s/edit"     Feed.editCustomFeed
+                    route  ""    >=> Admin.RedirectRules.all
+                    routef "/%i"     Admin.RedirectRules.edit
                 ])
                 subRoute "/tag-mapping" (choose [
-                    route  "s"        >=> Admin.tagMappings
+                    route  "s"        >=> Admin.TagMapping.all
-                    route  "s/bare"   >=> Admin.tagMappingsBare
+                    routef "/%s/edit"     Admin.TagMapping.edit
-                    routef "/%s/edit"     Admin.editMapping
+                ])
+                subRoute "/user" (choose [
+                    route  "s"        >=> User.all
+                    routef "/%s/edit"     User.edit
                 ])
             ])
-            route    "/theme/update" >=> Admin.themeUpdatePage
+            subRoute "/theme" (choose [
+                route "/list" >=> Admin.Theme.all
+                route "/new"  >=> Admin.Theme.add
+            ])
             subRoute "/upload" (choose [
                 route "s"    >=> Upload.list
                 route "/new" >=> Upload.showNew
             ])
-            subRoute "/user" (choose [
-                route  "s"        >=> User.all
-                route  "s/bare"   >=> User.bare
-                route  "/my-info" >=> User.myInfo
-                routef "/%s/edit"     User.edit
-            ])
         ]
         POST >=> validateCsrf >=> choose [
-            subRoute "/category" (choose [
+            subRoute "/cache" (choose [
-                route  "/save"      >=> Admin.saveCategory
+                routef "/theme/%s/refresh"   Admin.Cache.refreshTheme
-                routef "/%s/delete"     Admin.deleteCategory
+                routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
             ])
+            subRoute "/category" (requireAccess WebLogAdmin >=> choose [
+                route  "/save"      >=> Admin.Category.save
+                routef "/%s/delete"     Admin.Category.delete
+            ])
+            route    "/my-info" >=> User.saveMyInfo
             subRoute "/page" (choose [
                 route  "/save"                   >=> Page.save
                 route  "/permalinks"             >=> Page.savePermalinks
-                routef "/%s/delete"                  Page.delete
-                routef "/%s/revision/%s/delete"      Page.deleteRevision
                 routef "/%s/revision/%s/restore"     Page.restoreRevision
-                routef "/%s/revisions/purge"         Page.purgeRevisions
             ])
             subRoute "/post" (choose [
                 route  "/save"                   >=> Post.save
                 route  "/permalinks"             >=> Post.savePermalinks
-                routef "/%s/delete"                  Post.delete
+                routef "/%s/chapter/%i"              Post.saveChapter
-                routef "/%s/revision/%s/delete"      Post.deleteRevision
                 routef "/%s/revision/%s/restore"     Post.restoreRevision
-                routef "/%s/revisions/purge"         Post.purgeRevisions
             ])
-            subRoute "/settings" (choose [
+            subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
-                route ""     >=> Admin.saveSettings
+                route "" >=> Admin.WebLog.saveSettings
                 subRoute "/rss" (choose [
                     route  ""      >=> Feed.saveSettings
                     route  "/save" >=> Feed.saveCustomFeed
-                    routef "/%s/delete"     Feed.deleteCustomFeed
                 ])
-                subRoute "/tag-mapping" (choose [
+                subRoute "/redirect-rules" (choose [
-                    route  "/save"      >=> Admin.saveMapping
+                    routef "/%i"      Admin.RedirectRules.save
-                    routef "/%s/delete"     Admin.deleteMapping
+                    routef "/%i/up"   Admin.RedirectRules.moveUp
+                    routef "/%i/down" Admin.RedirectRules.moveDown
                 ])
+                route "/tag-mapping/save" >=> Admin.TagMapping.save
+                route "/user/save"        >=> User.save
             ])
-            route    "/theme/update" >=> Admin.updateTheme
+            subRoute "/theme" (choose [
-            subRoute "/upload" (choose [
+                route  "/new"       >=> Admin.Theme.save
-                route   "/save"        >=> Upload.save
+                routef "/%s/delete"     Admin.Theme.delete
-                routexp "/delete/(.*)"     Upload.deleteFromDisk
-                routef  "/%s/delete"       Upload.deleteFromDb
             ])
-            subRoute "/user" (choose [
+            route "/upload/save" >=> Upload.save
-                route  "/my-info"   >=> User.saveMyInfo
+        ]
-                route  "/save"      >=> User.save
+        DELETE >=> validateCsrf >=> choose [
-                routef "/%s/delete"     User.delete
+            routef "/category/%s" Admin.Category.delete
+            subRoute "/page" (choose [
+                routef "/%s"             Page.delete
+                routef "/%s/revision/%s" Page.deleteRevision
+                routef "/%s/revisions"   Page.purgeRevisions
+            ])
+            subRoute "/post" (choose [
+                routef "/%s"             Post.delete
+                routef "/%s/chapter/%i"  Post.deleteChapter
+                routef "/%s/revision/%s" Post.deleteRevision
+                routef "/%s/revisions"   Post.purgeRevisions
+            ])
+            subRoute "/settings" (requireAccess WebLogAdmin >=> choose [
+                routef "/redirect-rules/%i" Admin.RedirectRules.delete
+                routef "/rss/%s"            Feed.deleteCustomFeed
+                routef "/tag-mapping/%s"    Admin.TagMapping.delete
+                routef "/user/%s"           User.delete
+            ])
+            subRoute "/upload" (requireAccess WebLogAdmin >=> choose [
+                routexp "/disk/(.*)" Upload.deleteFromDisk
+                routef  "/%s"        Upload.deleteFromDb
             ])
         ]
     ])
@@ -223,7 +252,7 @@ let routerWithPath extraPath : HttpHandler =
 
 /// Handler to apply Giraffe routing with a possible sub-route
 let handleRoute : HttpHandler = fun next ctx ->
-    let _, extraPath = WebLog.hostAndPath ctx.WebLog
+    let extraPath = ctx.WebLog.ExtraPath
     (if extraPath = "" then router else routerWithPath extraPath) next ctx
 
 

src/MyWebLog/Handlers/Upload.fs

@@ -29,15 +29,17 @@ module private Helpers =
 
 // ~~ SERVING UPLOADS ~~
 
+open System.Globalization
 open Giraffe
 open Microsoft.AspNetCore.Http
+open NodaTime
 
 /// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
 let checkModified since (ctx: HttpContext) : HttpHandler option =
     match ctx.Request.Headers.IfModifiedSince with
     | it when it.Count < 1 -> None
-    | it when since > DateTime.Parse it[0] -> None
+    | it when since > Instant.FromDateTimeUtc(DateTime.Parse(it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
-    | _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
+    | _ -> Some (setStatusCode 304)
 
 
 open Microsoft.AspNetCore.Http.Headers
@@ -73,7 +75,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
             | Some upload ->
                 match checkModified upload.UpdatedOn ctx with
                 | Some threeOhFour -> return! threeOhFour next ctx
-                | None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
+                | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc()) path upload.Data next ctx
             | None -> return! Error.notFound next ctx
     else
         return! Error.notFound next ctx
@@ -85,7 +87,7 @@ open System.Text.RegularExpressions
 open MyWebLog.ViewModels
 
 /// Turn a string into a lowercase URL-safe slug
-let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant ()
+let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant()
 
 // GET /admin/uploads
 let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
@@ -105,37 +107,25 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
                     Name             = name
                     Path             = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
                     UpdatedOn        = create
-                    Source           = UploadDestination.toString Disk
+                    Source           = string Disk })
-                })
-            |> List.ofSeq
         with
         | :? DirectoryNotFoundException -> [] // This is fine
         | ex ->
             warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
             []
-    let allFiles =
-        dbUploads
-        |> List.map (DisplayUpload.fromUpload webLog Database)
-        |> List.append diskUploads
-        |> List.sortByDescending (fun file -> file.UpdatedOn, file.Path)
     return!
-        hashForPage "Uploaded Files"
+        dbUploads
-        |> withAntiCsrf ctx
+        |> Seq.ofList
-        |> addToHash "files" allFiles
+        |> Seq.map (DisplayUpload.FromUpload webLog Database)
-        |> adminView "upload-list" next ctx
+        |> Seq.append diskUploads
+        |> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
+        |> Views.WebLog.uploadList
+        |> adminPage "Uploaded Files" true next ctx
 }
 
 // GET /admin/upload/new
 let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
-    hashForPage "Upload a File"
+    adminPage "Upload a File" true next ctx Views.WebLog.uploadNew
-    |> withAntiCsrf ctx
-    |> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
-    |> adminView "upload-new" next ctx
-
-
-/// Redirect to the upload list
-let showUploads : HttpHandler =
-    redirectToGet "admin/uploads"
 
 // POST /admin/upload/save
 let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
@@ -143,22 +133,22 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
         let upload    = Seq.head ctx.Request.Form.Files
         let fileName  = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
                                        Path.GetExtension(upload.FileName).ToLowerInvariant())
-        let  localNow = WebLog.localTime ctx.WebLog DateTime.Now
+        let  now      = Noda.now ()
+        let  localNow = ctx.WebLog.LocalTime now
         let  year     = localNow.ToString "yyyy"
         let  month    = localNow.ToString "MM"
         let! form     = ctx.BindFormAsync<UploadFileModel>()
         
-        match UploadDestination.parse form.Destination with
+        match UploadDestination.Parse form.Destination with
         | Database ->
             use stream = new MemoryStream()
             do! upload.CopyToAsync stream
             let file =
-                {   Id        = UploadId.create ()
+                {   Id        = UploadId.Create()
                     WebLogId  = ctx.WebLog.Id
                     Path      = Permalink $"{year}/{month}/{fileName}"
-                    UpdatedOn = DateTime.UtcNow
+                    UpdatedOn = now
-                    Data      = stream.ToArray ()
+                    Data      = stream.ToArray() }
-                }
             do! ctx.Data.Upload.Add file
         | Disk ->
             let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
@@ -166,18 +156,18 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
             use stream   = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
             do! upload.CopyToAsync stream
         
-        do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
-        return! showUploads next ctx
+        return! redirectToGet "admin/uploads" next ctx
     else
         return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
 }
 
-// POST /admin/upload/{id}/delete
+// DELETE /admin/upload/{id}
-let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let deleteFromDb upId : HttpHandler = fun next ctx -> task {
     match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
     | Ok fileName ->
-        do! addMessage ctx { UserMessage.success with Message = $"{fileName} deleted successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
-        return! showUploads next ctx
+        return! list next ctx
     | Error _ -> return! Error.notFound next ctx
 }
 
@@ -192,14 +182,14 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
             path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
         else finished <- true
     
-// POST /admin/upload/delete/{**path}
+// DELETE /admin/upload/disk/{**path}
-let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
     let filePath = urlParts |> Seq.skip 1 |> Seq.head
     let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
     if File.Exists path then
         File.Delete path
         removeEmptyDirectories ctx.WebLog filePath
-        do! addMessage ctx { UserMessage.success with Message = $"{filePath} deleted successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
-        return! showUploads next ctx
+        return! list next ctx
     else return! Error.notFound next ctx
 }

src/MyWebLog/Handlers/User.fs

@@ -2,19 +2,31 @@
 module MyWebLog.Handlers.User
 
 open System
-open System.Security.Cryptography
+open Microsoft.AspNetCore.Http
-open System.Text
+open Microsoft.AspNetCore.Identity
+open MyWebLog
 
 // ~~ LOG ON / LOG OFF ~~
 
-/// Hash a password for a given user
+/// Create a password hash a password for a given user
-let hashedPassword (plainText : string) (email : string) (salt : Guid) =
+let createPasswordHash user password =
-    let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ] 
+    PasswordHasher<WebLogUser>().HashPassword(user, password)
-    use alg     = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
+
-    Convert.ToBase64String (alg.GetBytes 64)
+/// Verify whether a password is valid
+let verifyPassword user password (ctx: HttpContext) = backgroundTask {
+    match user with
+    | Some usr ->
+        let hasher = PasswordHasher<WebLogUser>()
+        match hasher.VerifyHashedPassword(usr, usr.PasswordHash, password) with
+        | PasswordVerificationResult.Success -> return Ok ()
+        | PasswordVerificationResult.SuccessRehashNeeded ->
+            do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword(usr, password) }
+            return Ok ()
+        | _ -> return Error "Log on attempt unsuccessful"
+    | None -> return Error "Log on attempt unsuccessful"
+}
 
 open Giraffe
-open MyWebLog
 open MyWebLog.ViewModels
 
 // GET /user/log-on
@@ -23,10 +35,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
         match returnUrl with
         | Some _ -> returnUrl
         | None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
-    hashForPage "Log On"
+    adminPage "Log On" true next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo })
-    |> withAntiCsrf ctx
-    |> addToHash ViewContext.Model { LogOnModel.empty with ReturnTo = returnTo }
-    |> adminView "log-on" next ctx
 
 
 open System.Security.Claims
@@ -37,13 +46,15 @@ open Microsoft.AspNetCore.Authentication.Cookies
 let doLogOn : HttpHandler = fun next ctx -> task {
     let! model   = ctx.BindFormAsync<LogOnModel>()
     let  data    = ctx.Data
-    match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with 
+    let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
-    | Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
+    match! verifyPassword tryUser model.Password ctx with 
+    | Ok _ ->
+        let user = tryUser.Value
         let claims = seq {
-            Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
+            Claim(ClaimTypes.NameIdentifier, string user.Id)
             Claim(ClaimTypes.Name,           $"{user.FirstName} {user.LastName}")
             Claim(ClaimTypes.GivenName,      user.PreferredName)
-            Claim (ClaimTypes.Role,           AccessLevel.toString user.AccessLevel)
+            Claim(ClaimTypes.Role,           string user.AccessLevel)
         }
         let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
 
@@ -51,122 +62,56 @@ let doLogOn : HttpHandler = fun next ctx -> task {
             AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
         do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
         do! addMessage ctx
-                { UserMessage.success with Message = $"Logged on successfully | Welcome to {ctx.WebLog.Name}!" }
+                { UserMessage.Success with
+                    Message = "Log on successful"
+                    Detail  = Some $"Welcome to {ctx.WebLog.Name}!" }
         return!
             match model.ReturnTo with
-            | Some url -> redirectTo false url next ctx
+            | Some url -> redirectTo false url next ctx // TODO: change to redirectToGet?
             | None -> redirectToGet "admin/dashboard" next ctx
-    | _ ->
+    | Error msg ->
-        do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
+        do! addMessage ctx { UserMessage.Error with Message = msg }
         return! logOn model.ReturnTo next ctx
 }
 
 // GET /user/log-off
 let logOff : HttpHandler = fun next ctx -> task {
     do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
-    do! addMessage ctx { UserMessage.info with Message = "Log off successful" }
+    do! addMessage ctx { UserMessage.Info with Message = "Log off successful" }
     return! redirectToGet "" next ctx
 }
 
 // ~~ ADMINISTRATION ~~
 
-open System.Collections.Generic
 open Giraffe.Htmx
-open Microsoft.AspNetCore.Http
-
-/// Create the hash needed to display the user list
-let private userListHash (ctx : HttpContext) = task {
-    let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
-    return!
-        hashForPage "User Administration"
-        |> withAntiCsrf ctx
-        |> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
-        |> addViewContext ctx
-}
 
 /// Got no time for URL/form manipulators...
 let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
 
-// GET /admin/users
+// GET /admin/settings/users
-let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let all : HttpHandler = fun next ctx -> task {
-    let! hash = userListHash ctx
+    let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
-    let! tmpl = TemplateCache.get "admin" "user-list-body" ctx.Data 
+    return! adminBarePage "User Administration" true next ctx (Views.User.userList users)
-    return!
-           addToHash "user_list" (tmpl.Render hash) hash
-        |> adminView "user-list" next ctx
-}
-
-// GET /admin/users/bare
-let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let! hash = userListHash ctx
-    return! adminBareView "user-list-body" next ctx hash
 }
 
 /// Show the edit user page
 let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
-    hashForPage (if model.IsNew then "Add a New User" else "Edit User")
+    adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true next ctx (Views.User.edit model)
-    |> withAntiCsrf ctx
-    |> addToHash ViewContext.Model model
-    |> addToHash "access_levels" [|
-        KeyValuePair.Create (AccessLevel.toString Author, "Author")
-        KeyValuePair.Create (AccessLevel.toString Editor, "Editor")
-        KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin")
-        if ctx.HasAccessLevel Administrator then
-            KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
-    |]
-    |> adminBareView "user-edit" next ctx
     
-// GET /admin/user/{id}/edit
+// GET /admin/settings/user/{id}/edit
-let edit usrId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let edit usrId : HttpHandler = fun next ctx -> task {
     let isNew   = usrId = "new"
     let userId  = WebLogUserId usrId
     let tryUser =
-        if isNew then someTask { WebLogUser.empty with Id = userId }
+        if isNew then someTask { WebLogUser.Empty with Id = userId }
         else ctx.Data.WebLogUser.FindById userId ctx.WebLog.Id
     match! tryUser with
-    | Some user -> return! showEdit (EditUserModel.fromUser user) next ctx
+    | Some user -> return! showEdit (EditUserModel.FromUser user) next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/user/save
+// DELETE /admin/settings/user/{id}
-let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let delete userId : HttpHandler = fun next ctx -> task {
-    let! model   = ctx.BindFormAsync<EditUserModel> ()
-    let  data    = ctx.Data
-    let  tryUser =
-        if model.IsNew then
-            { WebLogUser.empty with
-                Id = WebLogUserId.create ()
-                WebLogId = ctx.WebLog.Id
-                CreatedOn = DateTime.UtcNow
-            } |> someTask
-        else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
-    match! tryUser with
-    | Some user when model.Password = model.PasswordConfirm ->
-        let updatedUser = model.UpdateUser user
-        if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
-            return! goAway next ctx
-        else
-            let updatedUser =
-                if model.Password = "" then updatedUser
-                else
-                    let salt = Guid.NewGuid ()
-                    { updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
-            do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) updatedUser
-            do! addMessage ctx
-                    { UserMessage.success with
-                        Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
-                    }
-            return! bare next ctx
-    | Some _ ->
-        do! addMessage ctx { UserMessage.error with Message = "The passwords did not match; nothing saved" }
-        return!
-            (withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
-                next ctx
-    | None -> return! Error.notFound next ctx
-}
-
-// POST /admin/user/{id}/delete
-let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let data = ctx.Data
     match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
     | Some user ->
@@ -176,64 +121,86 @@ let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
             match! data.WebLogUser.Delete user.Id user.WebLogId with
             | Ok _ ->
                 do! addMessage ctx
-                        { UserMessage.success with
+                        { UserMessage.Success with
-                            Message = $"User {WebLogUser.displayName user} deleted successfully"
+                            Message = $"User {user.DisplayName} deleted successfully" }
-                        }
+                return! all next ctx
-                return! bare next ctx
             | Error msg ->
                 do! addMessage ctx
-                        { UserMessage.error with
+                        { UserMessage.Error with
-                            Message = $"User {WebLogUser.displayName user} was not deleted"
+                            Message = $"User {user.DisplayName} was not deleted"
-                            Detail  = Some msg
+                            Detail  = Some msg }
-                        }
+                return! all next ctx
-                return! bare next ctx
     | None -> return! Error.notFound next ctx
 }
 
-/// Display the user "my info" page, with information possibly filled in
+// GET /admin/my-info
-let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandler = fun next ctx ->
-    hashForPage "Edit Your Information"
-    |> withAntiCsrf ctx
-    |> addToHash ViewContext.Model model
-    |> addToHash "access_level"    (AccessLevel.toString user.AccessLevel)
-    |> addToHash "created_on"      (WebLog.localTime ctx.WebLog user.CreatedOn)
-    |> addToHash "last_seen_on"    (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
-    |> adminView "my-info" next ctx
-
-
-// GET /admin/user/my-info
 let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     match! ctx.Data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
-    | Some user -> return! showMyInfo (EditMyInfoModel.fromUser user) user next ctx
+    | Some user ->
+        return!
+            Views.User.myInfo (EditMyInfoModel.FromUser user) user
+            |> adminPage "Edit Your Information" true next ctx
     | None -> return! Error.notFound next ctx
 }
 
-// POST /admin/user/my-info
+// POST /admin/my-info
 let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
     let! model = ctx.BindFormAsync<EditMyInfoModel>()
     let  data  = ctx.Data
     match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
     | Some user when model.NewPassword = model.NewPasswordConfirm ->
-        let pw, salt =
+        let pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
-            if model.NewPassword = "" then
-                user.PasswordHash, user.Salt
-            else
-                let newSalt = Guid.NewGuid ()
-                hashedPassword model.NewPassword user.Email newSalt, newSalt
         let user =
             { user with
                 FirstName     = model.FirstName
                 LastName      = model.LastName
                 PreferredName = model.PreferredName
-                PasswordHash  = pw
+                PasswordHash  = pw }
-                Salt          = salt
-            }
         do! data.WebLogUser.Update user
         let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
-        do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
+        do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" }
-        return! redirectToGet "admin/user/my-info" next ctx
+        return! redirectToGet "admin/my-info" next ctx
     | Some user ->
-        do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
+        do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
-        return! showMyInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user next ctx
+        return!
+            Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
+            |> adminPage "Edit Your Information" true next ctx
+    | None -> return! Error.notFound next ctx
+}
+
+// User save is not statically compilable; not sure why, but we'll revisit it at some point
+#nowarn "3511"
+
+// POST /admin/settings/user/save
+let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let! model   = ctx.BindFormAsync<EditUserModel>()
+    let  data    = ctx.Data
+    let  tryUser =
+        if model.IsNew then
+            { WebLogUser.Empty with
+                Id        = WebLogUserId.Create()
+                WebLogId  = ctx.WebLog.Id
+                CreatedOn = Noda.now () }
+            |> someTask
+        else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
+    match! tryUser with
+    | Some user when model.Password = model.PasswordConfirm ->
+        let updatedUser = model.UpdateUser user
+        if updatedUser.AccessLevel = Administrator && not (ctx.HasAccessLevel Administrator) then
+            return! goAway next ctx
+        else
+            let toUpdate =
+                if model.Password = "" then updatedUser
+                else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
+            do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
+            do! addMessage ctx
+                    { UserMessage.Success with
+                        Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" }
+            return! all next ctx
+    | Some _ ->
+        do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" }
+        return!
+            (withHxRetarget $"#user_{model.Id}" >=> showEdit { model with Password = ""; PasswordConfirm = "" })
+                next ctx
     | None -> return! Error.notFound next ctx
 }

src/MyWebLog/Maintenance.fs

@@ -4,6 +4,7 @@ open System
 open System.IO
 open Microsoft.Extensions.DependencyInjection
 open MyWebLog.Data
+open NodaTime
 
 /// Create the web log information
 let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
@@ -20,9 +21,9 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
             | false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
     
     // Create the web log
-    let webLogId   = WebLogId.create ()
+    let webLogId   = WebLogId.Create()
-    let userId     = WebLogUserId.create ()
+    let userId     = WebLogUserId.Create()
-    let homePageId = PageId.create ()
+    let homePageId = PageId.Create()
     let slug       = Handlers.Upload.makeSlug args[2]
     
     // If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
@@ -31,36 +32,31 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
     let  accessLevel = if List.isEmpty webLogs then Administrator else WebLogAdmin
         
     do! data.WebLog.Add
-            { WebLog.empty with
+            { WebLog.Empty with
                 Id          = webLogId
                 Name        = args[2]
                 Slug        = slug
                 UrlBase     = args[1]
-                DefaultPage = PageId.toString homePageId
+                DefaultPage = string homePageId
-                TimeZone    = timeZone
+                TimeZone    = timeZone }
-            }
     
     // Create the admin user
-    let salt = Guid.NewGuid ()
+    let now  = Noda.now ()
-    let now  = DateTime.UtcNow
+    let user =
-    
+        { WebLogUser.Empty with
-    do! data.WebLogUser.Add 
-            { WebLogUser.empty with
             Id            = userId
             WebLogId      = webLogId
             Email         = args[3]
             FirstName     = "Admin"
             LastName      = "User"
             PreferredName = "Admin"
-                PasswordHash  = Handlers.User.hashedPassword args[4] args[3] salt
-                Salt          = salt
             AccessLevel   = accessLevel
-                CreatedOn     = now
+            CreatedOn     = now }
-            }
+    do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] }
 
     // Create the default home page
     do! data.Page.Add
-            { Page.empty with
+            { Page.Empty with
                 Id          = homePageId
                 WebLogId    = webLogId
                 AuthorId    = userId
@@ -71,10 +67,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
                 Text        = "<p>This is your default home page.</p>"
                 Revisions   = [
                     {   AsOf = now
-                      Text = Html "<p>This is your default home page.</p>"
+                        Text = Html "<p>This is your default home page.</p>" }
-                    }
+                ] }
-                ]
-            }
 
     printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}"
     match accessLevel with
@@ -89,7 +83,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
 let createWebLog args sp = task {
     match args |> Array.length with
     | 5 -> do! doCreateWebLog args sp
-    | _ -> eprintfn "Usage: MyWebLog init [url] [name] [admin-email] [admin-pw]"
+    | _ -> eprintfn "Usage: myWebLog init [url] [name] [admin-email] [admin-pw]"
 }
 
 /// Import prior permalinks from a text files with lines in the format "[old] [new]"
@@ -112,8 +106,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
                 let! withLinks = data.Post.FindFullById post.Id post.WebLogId
                 let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
                              (old :: withLinks.Value.PriorPermalinks)
-                printfn $"{Permalink.toString old} -> {Permalink.toString current}"
+                printfn $"{old} -> {current}"
-            | None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
+            | None -> eprintfn $"Cannot find current post for {current}"
         printfn "Done!"
     | None -> eprintfn $"No web log found at {urlBase}"
 }
@@ -122,38 +116,39 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
 let importLinks args sp = task {
     match args |> Array.length with
     | 3 -> do! importPriorPermalinks args[1] args[2] sp
-    | _ -> eprintfn "Usage: MyWebLog import-links [url] [file-name]"
+    | _ -> eprintfn "Usage: myWebLog import-links [url] [file-name]"
 }
 
 // Loading a theme and restoring a backup are not statically compilable; this is OK
 #nowarn "3511"
 
+open Microsoft.Extensions.Logging
+
 /// Load a theme from the given ZIP file
 let loadTheme (args: string[]) (sp: IServiceProvider) = task {
-    if args.Length > 1 then
+    if args.Length = 2 then
         let fileName =
             match args[1].LastIndexOf Path.DirectorySeparatorChar with
             | -1 -> args[1]
             | it -> args[1][(it + 1)..]
-        match Handlers.Admin.getThemeName fileName with
+        match Handlers.Admin.Theme.deriveIdFromFileName fileName with
-        | Ok themeName ->
+        | Ok themeId ->
             let data   = sp.GetRequiredService<IData>()
-            let clean  = if args.Length > 2 then bool.Parse args[2] else true
             use stream = File.Open(args[1], FileMode.Open)
             use copy   = new MemoryStream()
             do! stream.CopyToAsync copy
-            do! Handlers.Admin.loadThemeFromZip themeName copy clean data
+            let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
-            printfn $"Theme {themeName} loaded successfully"
+            let fac = sp.GetRequiredService<ILoggerFactory>()
+            let log = fac.CreateLogger "MyWebLog.Themes"
+            log.LogInformation $"{theme.Name} v{theme.Version} ({theme.Id}) loaded"
         | Error message -> eprintfn $"{message}"
     else
-        eprintfn "Usage: MyWebLog load-theme [theme-zip-file-name] [*clean-load]"
+        eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
-        eprintfn "         * optional, defaults to true"
 }
 
 /// Back up a web log's data
 module Backup =
     
-    open System.Threading.Tasks
     open MyWebLog.Converters
     open Newtonsoft.Json
 
@@ -163,25 +158,22 @@ module Backup =
             Id: ThemeAssetId
             
             /// The updated date for this asset
-            UpdatedOn : DateTime
+            UpdatedOn: Instant
             
             /// The data for this asset, base-64 encoded
-            Data : string
+            Data: string }
-        }
         
         /// Create an encoded theme asset from the original theme asset
         static member fromAsset (asset: ThemeAsset) =
             {   Id        = asset.Id
                 UpdatedOn = asset.UpdatedOn
-                Data      = Convert.ToBase64String asset.Data
+                Data      = Convert.ToBase64String asset.Data }
-            }
     
         /// Create a theme asset from an encoded theme asset
         static member toAsset (encoded: EncodedAsset) : ThemeAsset =
             {   Id        = encoded.Id
                 UpdatedOn = encoded.UpdatedOn
-                Data      = Convert.FromBase64String encoded.Data
+                Data      = Convert.FromBase64String encoded.Data }
-            }
     
     /// An uploaded file, with the data base-64 encoded
     type EncodedUpload =
@@ -195,11 +187,10 @@ module Backup =
             Path: Permalink
             
             /// The date/time this upload was last updated (file time)
-            UpdatedOn : DateTime
+            UpdatedOn: Instant
             
             /// The data for the upload, base-64 encoded
-            Data : string
+            Data: string }
-        }
         
         /// Create an encoded uploaded file from the original uploaded file
         static member fromUpload (upload: Upload) : EncodedUpload =
@@ -207,8 +198,7 @@ module Backup =
                 WebLogId  = upload.WebLogId
                 Path      = upload.Path
                 UpdatedOn = upload.UpdatedOn
-                Data      = Convert.ToBase64String upload.Data
+                Data      = Convert.ToBase64String upload.Data }
-            }
         
         /// Create an uploaded file from an encoded uploaded file
         static member toUpload (encoded: EncodedUpload) : Upload =
@@ -216,8 +206,7 @@ module Backup =
                 WebLogId  = encoded.WebLogId
                 Path      = encoded.Path
                 UpdatedOn = encoded.UpdatedOn
-                Data      = Convert.FromBase64String encoded.Data
+                Data      = Convert.FromBase64String encoded.Data }
-            }
     
     /// A unified archive for a web log
     type Archive =
@@ -246,13 +235,11 @@ module Backup =
             Posts: Post list
             
             /// The uploaded files for this web log
-            Uploads : EncodedUpload list
+            Uploads: EncodedUpload list }
-        }
     
-    /// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
+    /// Create a JSON serializer
     let private getSerializer prettyOutput =
-        let serializer = JsonSerializer.CreateDefault ()
+        let serializer = Json.configure (JsonSerializer.CreateDefault())
-        Json.all () |> Seq.iter serializer.Converters.Add
         if prettyOutput then serializer.Formatting <- Formatting.Indented
         serializer
     
@@ -314,8 +301,7 @@ module Backup =
                 TagMappings = tagMaps
                 Pages       = pages   |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
                 Posts       = posts   |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions })
-                Uploads     = uploads |> List.map EncodedUpload.fromUpload
+                Uploads     = uploads |> List.map EncodedUpload.fromUpload }
-            }
         
         // Write the structure to the backup file
         if File.Exists fileName then File.Delete fileName
@@ -327,21 +313,21 @@ module Backup =
         displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive
     }
     
-    let private doRestore archive newUrlBase (data : IData) = task {
+    let private doRestore archive newUrlBase isInteractive (data: IData) = task {
         let! restore = task {
             match! data.WebLog.FindById archive.WebLog.Id with
             | Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase ->
                 do! data.WebLog.Delete webLog.Id
-                return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
+                return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase webLog.UrlBase }
             | Some _ ->
                 // Err'body gets new IDs...
-                let newWebLogId = WebLogId.create ()
+                let newWebLogId = WebLogId.Create()
-                let newCatIds   = archive.Categories  |> List.map (fun cat  -> cat.Id,  CategoryId.create   ()) |> dict
+                let newCatIds   = archive.Categories  |> List.map (fun cat  -> cat.Id,  CategoryId.Create()  ) |> dict
-                let newMapIds   = archive.TagMappings |> List.map (fun tm   -> tm.Id,   TagMapId.create     ()) |> dict
+                let newMapIds   = archive.TagMappings |> List.map (fun tm   -> tm.Id,   TagMapId.Create()    ) |> dict
-                let newPageIds  = archive.Pages       |> List.map (fun page -> page.Id, PageId.create       ()) |> dict
+                let newPageIds  = archive.Pages       |> List.map (fun page -> page.Id, PageId.Create()      ) |> dict
-                let newPostIds  = archive.Posts       |> List.map (fun post -> post.Id, PostId.create       ()) |> dict
+                let newPostIds  = archive.Posts       |> List.map (fun post -> post.Id, PostId.Create()      ) |> dict
-                let newUserIds  = archive.Users       |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
+                let newUserIds  = archive.Users       |> List.map (fun user -> user.Id, WebLogUserId.Create()) |> dict
-                let newUpIds    = archive.Uploads     |> List.map (fun up   -> up.Id,   UploadId.create     ()) |> dict
+                let newUpIds    = archive.Uploads     |> List.map (fun up   -> up.Id,   UploadId.Create()    ) |> dict
                 return
                     { archive with
                         WebLog      = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
@@ -356,60 +342,61 @@ module Backup =
                                           { page with
                                               Id       = newPageIds[page.Id]
                                               WebLogId = newWebLogId
-                                              AuthorId = newUserIds[page.AuthorId]
+                                              AuthorId = newUserIds[page.AuthorId] })
-                                          })
                         Posts       = archive.Posts
                                       |> List.map (fun post ->
                                           { post with
                                               Id          = newPostIds[post.Id]
                                               WebLogId    = newWebLogId
                                               AuthorId    = newUserIds[post.AuthorId]
-                                              CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c])
+                                              CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c]) })
-                                          })
                         Uploads     = archive.Uploads
-                                      |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId })
+                                      |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId }) }
-                    }
             | None ->
-                return
+                return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
-                    { archive with
-                        WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase }
-                    }
         }
         
         // Restore theme and assets (one at a time, as assets can be large)
+        if isInteractive then
             printfn ""
             printfn "- Importing theme..."
         do! data.Theme.Save restore.Theme
-        let! _ = restore.Assets |> List.map (EncodedAsset.toAsset >> data.ThemeAsset.Save) |> Task.WhenAll
+        restore.Assets
+        |> List.iter (EncodedAsset.toAsset >> data.ThemeAsset.Save >> Async.AwaitTask >> Async.RunSynchronously)
         
         // Restore web log data
         
-        printfn "- Restoring web log..."
+        if isInteractive then printfn "- Restoring web log..."
-        do! data.WebLog.Add restore.WebLog
+        // v2.0 backups will not have redirect rules; fix that if restoring to v2.1 or later
+        let webLog =
+            if isNull (box restore.WebLog.RedirectRules) then { restore.WebLog with RedirectRules = [] }
+            else restore.WebLog
+        do! data.WebLog.Add webLog
         
-        printfn "- Restoring users..."
+        if isInteractive then printfn "- Restoring users..."
         do! data.WebLogUser.Restore restore.Users
         
-        printfn "- Restoring categories and tag mappings..."
+        if isInteractive then printfn "- Restoring categories and tag mappings..."
-        do! data.TagMap.Restore   restore.TagMappings
+        if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore   restore.TagMappings
-        do! data.Category.Restore restore.Categories
+        if not (List.isEmpty restore.Categories)  then do! data.Category.Restore restore.Categories
         
-        printfn "- Restoring pages..."
+        if isInteractive then printfn "- Restoring pages..."
-        do! data.Page.Restore restore.Pages
+        if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
         
-        printfn "- Restoring posts..."
+        if isInteractive then printfn "- Restoring posts..."
-        do! data.Post.Restore restore.Posts
+        if not (List.isEmpty restore.Posts) then do! data.Post.Restore restore.Posts
         
         // TODO: comments not yet implemented
         
-        printfn "- Restoring uploads..."
+        if isInteractive then printfn "- Restoring uploads..."
+        if not (List.isEmpty restore.Uploads) then
             do! data.Upload.Restore (restore.Uploads |> List.map EncodedUpload.toUpload)
         
-        displayStats "Restored for <>NAME<>:" restore.WebLog restore
+        if isInteractive then displayStats "Restored for <>NAME<>:" restore.WebLog restore
     }
     
     /// Decide whether to restore a backup
-    let private restoreBackup (fileName : string) newUrlBase promptForOverwrite data = task {
+    let internal restoreBackup fileName newUrlBase promptForOverwrite isInteractive data = task {
         
         let serializer = getSerializer false
         use stream     = new FileStream(fileName, FileMode.Open)
@@ -424,10 +411,10 @@ module Backup =
             printfn "            theme in either case."
             printfn ""
             printf  "Continue? [Y/n] "
-            doOverwrite <- not ((Console.ReadKey ()).Key = ConsoleKey.N)
+            doOverwrite <- not (Console.ReadKey().Key = ConsoleKey.N)
         
         if doOverwrite then
-            do! doRestore archive newUrlBase data
+            do! doRestore archive newUrlBase isInteractive data
         else
             printfn $"{archive.WebLog.Name} backup restoration canceled"
     }
@@ -449,7 +436,7 @@ module Backup =
                 do! createBackup webLog fileName prettyOutput data
             | None -> eprintfn $"Error: no web log found for {args[1]}"
         else
-            eprintfn """Usage: MyWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
+            eprintfn """Usage: myWebLog backup [url-base] [*backup-file-name] [**"pretty"]"""
             eprintfn """          * optional - default is [web-log-slug].json"""
             eprintfn """         ** optional - default is non-pretty JSON output"""
     }
@@ -459,9 +446,9 @@ module Backup =
         if args.Length = 2 || args.Length = 3 then
             let data       = sp.GetRequiredService<IData>()
             let newUrlBase = if args.Length = 3 then Some args[2] else None
-            do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data
+            do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") true data
         else
-            eprintfn "Usage: MyWebLog restore [backup-file-name] [*url-base]"
+            eprintfn "Usage: myWebLog restore [backup-file-name] [*url-base]"
             eprintfn "         * optional - will restore to original URL base if omitted"
             eprintfn "       (use do-restore to skip confirmation prompt)"
     }
@@ -477,7 +464,7 @@ let private doUserUpgrade urlBase email (data : IData) = task {
             | WebLogAdmin ->
                 do! data.WebLogUser.Update { user with AccessLevel = Administrator }
                 printfn $"{email} is now an Administrator user"
-            | other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin"
+            | other -> eprintfn $"ERROR: {email} is an {other}, not a WebLogAdmin"
         | None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
     | None -> eprintfn $"ERROR: no web log found for {urlBase}"
 }
@@ -486,5 +473,24 @@ let private doUserUpgrade urlBase email (data : IData) = task {
 let upgradeUser (args: string[]) (sp: IServiceProvider) = task {
     match args.Length with
     | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData>())
-    | _ -> eprintfn "Usage: MyWebLog upgrade-user [web-log-url-base] [email-address]"
+    | _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
+}
+
+/// Set a user's password
+let doSetPassword urlBase email password (data: IData) = task {
+    match! data.WebLog.FindByHost urlBase with
+    | Some webLog ->
+        match! data.WebLogUser.FindByEmail email webLog.Id with
+        | Some user ->
+            do! data.WebLogUser.Update { user with PasswordHash = Handlers.User.createPasswordHash user password }
+            printfn $"Password for user {email} at {webLog.Name} set successfully"
+        | None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
+    | None -> eprintfn $"ERROR: no web log found for {urlBase}"
+}
+
+/// Set a user's password if the command-line arguments are good
+let setPassword (args: string[]) (sp: IServiceProvider) = task {
+    match args.Length with
+    | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData>())
+    | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]"
 }

src/MyWebLog/MyWebLog.fsproj

@@ -2,16 +2,19 @@
 
   <PropertyGroup>
     <OutputType>Exe</OutputType>
-    <TargetFramework>net6.0</TargetFramework>
     <PublishSingleFile>true</PublishSingleFile>
     <SelfContained>false</SelfContained>
-    <DebugType>embedded</DebugType>
-    <NoWarn>3391</NoWarn>
   </PropertyGroup>
 
   <ItemGroup>
     <Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
     <Compile Include="Caches.fs" />
+    <Compile Include="Views\Helpers.fs" />
+    <Compile Include="Views\Admin.fs" />
+    <Compile Include="Views\Page.fs" />
+    <Compile Include="Views\Post.fs" />
+    <Compile Include="Views\User.fs" />
+    <Compile Include="Views\WebLog.fs" />
     <Compile Include="Handlers\Helpers.fs" />
     <Compile Include="Handlers\Admin.fs" />
     <Compile Include="Handlers\Feed.fs" />
@@ -26,14 +29,15 @@
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="DotLiquid" Version="2.2.656" />
+    <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" />
-    <PackageReference Include="Giraffe" Version="6.0.0" />
+    <PackageReference Include="DotLiquid" Version="2.2.692" />
-    <PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
+    <PackageReference Include="Giraffe" Version="6.3.0" />
-    <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
+    <PackageReference Include="Giraffe.Htmx" Version="1.9.11" />
-    <PackageReference Include="NeoSmart.Caching.Sqlite" Version="6.0.1" />
+    <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.11" />
+    <PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="8.0.0" />
     <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
-    <PackageReference Update="FSharp.Core" Version="6.0.5" />
+    <PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" />
-    <PackageReference Include="System.ServiceModel.Syndication" Version="6.0.0" />
+    <PackageReference Update="FSharp.Core" Version="8.0.200" />
   </ItemGroup>
 
   <ItemGroup>
@@ -45,4 +49,10 @@
     <None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
   </ItemGroup>
 
+  <ItemGroup>
+    <AssemblyAttribute Include="System.Runtime.CompilerServices.InternalsVisibleToAttribute">
+      <_Parameter1>MyWebLog.Tests</_Parameter1>
+    </AssemblyAttribute>
+  </ItemGroup>
+
 </Project>

src/MyWebLog/Program.fs

@@ -10,12 +10,12 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
     /// Is the debug level enabled on the logger?
     let isDebug = log.IsEnabled LogLevel.Debug
         
-    member this.InvokeAsync (ctx : HttpContext) = task {
+    member _.InvokeAsync(ctx: HttpContext) = task {
         /// Create the full path of the request
         let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
         match WebLogCache.tryGet path with
         | Some webLog ->
-            if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
+            if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
             ctx.Items["webLog"] <- webLog
             if PageListCache.exists ctx then () else do! PageListCache.update ctx
             if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
@@ -26,9 +26,36 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
     }
 
 
+/// Middleware to check redirects for the current web log
+type RedirectRuleMiddleware(next: RequestDelegate, log: ILogger<RedirectRuleMiddleware>) =
+
+    /// Shorthand for case-insensitive string equality
+    let ciEquals str1 str2 =
+        System.String.Equals(str1, str2, System.StringComparison.InvariantCultureIgnoreCase)
+    
+    member _.InvokeAsync(ctx: HttpContext) = task {
+        let path    = ctx.Request.Path.Value.ToLower()
+        let matched =
+            WebLogCache.redirectRules ctx.WebLog.Id
+            |> List.tryPick (fun rule ->
+                match rule with
+                | WebLogCache.CachedRedirectRule.Text (urlFrom, urlTo) ->
+                    if ciEquals path urlFrom then Some urlTo else None
+                | WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) ->
+                    if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None)
+        match matched with
+        | Some url -> ctx.Response.Redirect(url, permanent = true)
+        | None -> return! next.Invoke ctx
+    }
+
+
 open System
+open System.IO
+open BitBadger.Documents
 open Microsoft.Extensions.DependencyInjection
 open MyWebLog.Data
+open Newtonsoft.Json
+open Npgsql
 
 /// Logic to obtain a data connection and implementation based on configured values
 module DataImplementation =
@@ -37,29 +64,43 @@ module DataImplementation =
     open RethinkDb.Driver.FSharp
     open RethinkDb.Driver.Net
     
+    /// Create an NpgsqlDataSource from the connection string, configuring appropriately
+    let createNpgsqlDataSource (cfg: IConfiguration) =
+        let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL")
+        let _ = builder.UseNodaTime()
+        // let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore))
+        (builder.Build >> Postgres.Configuration.useDataSource) ()
+
     /// Get the configured data implementation
     let get (sp: IServiceProvider) : IData =
         let config   = sp.GetRequiredService<IConfiguration>()
         let await it = (Async.AwaitTask >> Async.RunSynchronously) it
         let connStr    name = config.GetConnectionString name
         let hasConnStr name = (connStr >> isNull >> not) name
-        let createSQLite connStr =
+        let createSQLite connStr : IData =
+            Sqlite.Configuration.useConnectionString connStr
             let log  = sp.GetRequiredService<ILogger<SQLiteData>>()
-            let conn = new SqliteConnection (connStr)
+            let conn = Sqlite.Configuration.dbConn ()
             log.LogInformation $"Using SQLite database {conn.DataSource}"
-            await (SQLiteData.setUpConnection conn)
+            SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault()))
-            SQLiteData (conn, log)
         
         if hasConnStr "SQLite" then
-            upcast createSQLite (connStr "SQLite")
+            createSQLite (connStr "SQLite")
         elif hasConnStr "RethinkDB" then
             let log        = sp.GetRequiredService<ILogger<RethinkDbData>>()
-            Json.all () |> Seq.iter Converter.Serializer.Converters.Add 
+            let _          = Json.configure Converter.Serializer 
             let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
             let conn       = await (rethinkCfg.CreateConnectionAsync log)
-            upcast RethinkDbData (conn, rethinkCfg, log)
+            RethinkDbData(conn, rethinkCfg, log)
+        elif hasConnStr "PostgreSQL" then
+            createNpgsqlDataSource config
+            use conn = Postgres.Configuration.dataSource().CreateConnection()
+            let log  = sp.GetRequiredService<ILogger<PostgresData>>()
+            log.LogInformation $"Using PostgreSQL database {conn.Database}"
+            PostgresData(log, Json.configure (JsonSerializer.CreateDefault()))
         else
-            upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
+            if not (Directory.Exists "./data") then Directory.CreateDirectory "./data" |> ignore
+            createSQLite "Data Source=./data/myweblog.db;Cache=Shared"
 
 
 open System.Threading.Tasks
@@ -76,22 +117,25 @@ let showHelp () =
     printfn "init          Initializes a new web log"
     printfn "load-theme    Load a theme"
     printfn "restore       Restore a JSON file backup (prompt before overwriting)"
+    printfn "set-password  Set a password for a specific user"
     printfn "upgrade-user  Upgrade a WebLogAdmin user to a full Administrator"
     printfn " "
     printfn "For more information on a particular command, run it with no options."
     Task.FromResult()
 
 
+open BitBadger.AspNetCore.CanonicalDomains
 open Giraffe
 open Giraffe.EndpointRouting
 open Microsoft.AspNetCore.Authentication.Cookies
 open Microsoft.AspNetCore.Builder
 open Microsoft.AspNetCore.HttpOverrides
-open NeoSmart.Caching.Sqlite
+open Microsoft.Extensions.Caching.Distributed
+open NeoSmart.Caching.Sqlite.AspNetCore
 open RethinkDB.DistributedCache
 
 [<EntryPoint>]
-let rec main args =
+let main args =
 
     let builder = WebApplication.CreateBuilder(args)
     let _ = builder.Services.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
@@ -109,6 +153,7 @@ let rec main args =
     
     let sp   = builder.Services.BuildServiceProvider()
     let data = DataImplementation.get sp
+    let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
     
     task {
         do! data.StartUp()
@@ -120,23 +165,29 @@ let rec main args =
     match data with
     | :? RethinkDbData as rethink ->
         // A RethinkDB connection is designed to work as a singleton
-        builder.Services.AddSingleton<IData> data |> ignore
+        let _ = builder.Services.AddSingleton<IData> data
+        let _ =
             builder.Services.AddDistributedRethinkDBCache(fun opts ->
                 opts.TableName  <- "Session"
                 opts.Connection <- rethink.Conn)
-        |> ignore
+        ()
-    | :? SQLiteData as sql ->
+    | :? SQLiteData ->
         // ADO.NET connections are designed to work as per-request instantiation
         let cfg  = sp.GetRequiredService<IConfiguration>()
-        builder.Services.AddScoped<SqliteConnection> (fun sp ->
+        let _ = builder.Services.AddScoped<SqliteConnection>(fun sp -> Sqlite.Configuration.dbConn ())
-            let conn = new SqliteConnection (sql.Conn.ConnectionString)
+        let _ = builder.Services.AddScoped<IData, SQLiteData>()
-            SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
-            conn)
-        |> ignore
-        builder.Services.AddScoped<IData, SQLiteData> () |> ignore
         // Use SQLite for caching as well
-        let cachePath = Option.ofObj (cfg.GetConnectionString "SQLiteCachePath") |> Option.defaultValue "./session.db"
+        let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./data/session.db"
-        builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath) |> ignore
+        let _ = builder.Services.AddSqliteCache(fun o -> o.CachePath <- cachePath)
+        ()
+    | :? PostgresData as postgres ->
+        // ADO.NET Data Sources are designed to work as singletons
+        let _ = builder.Services.AddSingleton<NpgsqlDataSource>(Postgres.Configuration.dataSource ())
+        let _ = builder.Services.AddSingleton<IData> postgres
+        let _ =
+            builder.Services.AddSingleton<IDistributedCache>(fun _ ->
+                Postgres.DistributedCache() :> IDistributedCache)
+        ()
     | _ -> ()
     
     let _ = builder.Services.AddSession(fun opts ->
@@ -158,21 +209,36 @@ let rec main args =
     | Some it when it = "restore"      -> Maintenance.Backup.restoreFromBackup args app.Services
     | Some it when it = "do-restore"   -> Maintenance.Backup.restoreFromBackup args app.Services
     | Some it when it = "upgrade-user" -> Maintenance.upgradeUser              args app.Services
+    | Some it when it = "set-password" -> Maintenance.setPassword              args app.Services
     | Some it when it = "help"         -> showHelp ()
     | Some it ->
         printfn $"""Unrecognized command "{it}" - valid commands are:"""
         showHelp ()
-    | None ->
+    | None -> task {
+        // Load admin and default themes, and all themes in the /themes directory
+        do! Maintenance.loadTheme [| ""; "./admin-theme.zip"   |] app.Services
+        do! Maintenance.loadTheme [| ""; "./default-theme.zip" |] app.Services
+        if Directory.Exists "./themes" then
+            for themeFile in Directory.EnumerateFiles("./themes", "*-theme.zip") do
+                do! Maintenance.loadTheme [| ""; themeFile |] app.Services
+            
         let _ = app.UseForwardedHeaders()
+        
+        (app.Services.GetRequiredService<IConfiguration>().GetSection "CanonicalDomains").Value
+        |> (isNull >> not)
+        |> function true -> app.UseCanonicalDomains() |> ignore | false -> ()
+        
         let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
         let _ = app.UseMiddleware<WebLogMiddleware>()
+        let _ = app.UseMiddleware<RedirectRuleMiddleware>()
         let _ = app.UseAuthentication()
         let _ = app.UseStaticFiles()
         let _ = app.UseRouting()
         let _ = app.UseSession()
         let _ = app.UseGiraffe Handlers.Routes.endpoint
 
-        Task.FromResult (app.Run ())
+        app.Run()
+    }
     |> Async.AwaitTask |> Async.RunSynchronously
     
     0 // Exit code

src/MyWebLog/Views/Admin.fs

@@ -0,0 +1,190 @@
+module MyWebLog.Views.Admin
+
+open Giraffe.Htmx.Common
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+
+/// The administrator dashboard
+let dashboard (themes: Theme list) app = [
+    let templates      = TemplateCache.allNames ()
+    let cacheBaseUrl   = relUrl app "admin/cache/"
+    let webLogCacheUrl = $"{cacheBaseUrl}web-log/"
+    let themeCacheUrl  = $"{cacheBaseUrl}theme/"
+    let webLogDetail (webLog: WebLog) =
+        let refreshUrl = $"{webLogCacheUrl}{webLog.Id}/refresh"
+        div [ _class "row mwl-table-detail" ] [
+            div [ _class "col" ] [
+                txt webLog.Name; br []
+                small [] [
+                    span [ _class "text-muted" ] [ raw webLog.UrlBase ]; br []
+                    a [ _href refreshUrl; _hxPost refreshUrl ] [ raw "Refresh" ]
+                ]
+            ]
+        ]
+    let themeDetail (theme: Theme) =
+        let refreshUrl = $"{themeCacheUrl}{theme.Id}/refresh"
+        div [ _class "row mwl-table-detail" ] [
+            div [ _class "col-8" ] [
+                txt theme.Name; br []
+                small [] [
+                    span [ _class "text-muted" ] [ txt (string theme.Id); raw " • " ]
+                    a [ _href refreshUrl; _hxPost refreshUrl ] [ raw "Refresh" ]
+                ]
+            ]
+            div [ _class "col-4" ] [
+                raw (templates |> List.filter _.StartsWith(string theme.Id) |> List.length |> string)
+            ]
+        ]
+
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        fieldset [ _class "container mb-3 pb-0" ] [
+            legend [] [ raw "Themes" ]
+            span [ _hxGet (relUrl app "admin/theme/list"); _hxTrigger HxTrigger.Load; _hxSwap HxSwap.OuterHtml ] []
+        ]
+        fieldset [ _class "container mb-3 pb-0" ] [
+            legend [] [ raw "Caches" ]
+            p [ _class "pb-2" ] [
+                raw "myWebLog uses a few caches to ensure that it serves pages as fast as possible. ("
+                a [ _href "https://bitbadger.solutions/open-source/myweblog/advanced.html#cache-management"
+                    _target "_blank" ] [
+                    raw "more information"
+                ]; raw ")"
+            ]
+            div [ _class "row" ] [
+                div [ _class "col-12 col-lg-6 pb-3" ] [
+                    div [ _class "card" ] [ 
+                        header [ _class "card-header text-white bg-secondary" ] [ raw "Web Logs" ]
+                        div [ _class "card-body pb-0" ] [
+                            h6 [ _class "card-subtitle text-muted pb-3" ] [
+                                raw "These caches include the page list and categories for each web log"
+                            ]
+                            let webLogUrl = $"{cacheBaseUrl}web-log/"
+                            form [ _method "post"; _class "container g-0"; _hxNoBoost; _hxTarget "body"
+                                   _hxSwap $"{HxSwap.InnerHtml} show:window:top" ] [
+                                antiCsrf app
+                                button [ _type "submit"; _class "btn btn-sm btn-primary mb-2"
+                                         _hxPost $"{webLogUrl}all/refresh" ] [
+                                    raw "Refresh All"
+                                ]
+                                div [ _class "row mwl-table-heading" ] [ div [ _class "col" ] [ raw "Web Log" ] ]
+                                yield! WebLogCache.all () |> List.sortBy _.Name |> List.map webLogDetail
+                            ]
+                        ]
+                    ]
+                ]
+                div [ _class "col-12 col-lg-6 pb-3" ] [
+                    div [ _class "card" ] [
+                        header [ _class "card-header text-white bg-secondary" ] [ raw "Themes" ]
+                        div [ _class "card-body pb-0" ] [
+                            h6 [ _class "card-subtitle text-muted pb-3" ] [
+                                raw "The theme template cache is filled on demand as pages are displayed; "
+                                raw "refreshing a theme with no cached templates will still refresh its asset cache"
+                            ]
+                            form [ _method "post"; _class "container g-0"; _hxNoBoost; _hxTarget "body"
+                                   _hxSwap $"{HxSwap.InnerHtml} show:window:top" ] [
+                                antiCsrf app
+                                button [ _type "submit"; _class "btn btn-sm btn-primary mb-2"
+                                         _hxPost $"{themeCacheUrl}all/refresh" ] [
+                                    raw "Refresh All"
+                                ]
+                                div [ _class "row mwl-table-heading" ] [
+                                    div [ _class "col-8" ] [ raw "Theme" ]; div [ _class "col-4" ] [ raw "Cached" ]
+                                ]
+                                yield! themes |> List.filter (fun t -> t.Id <> ThemeId "admin") |> List.map themeDetail
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+        ]
+    ]
+]
+
+/// Display a list of themes
+let themeList (model: DisplayTheme list) app =
+    let themeCol = "col-12 col-md-6"
+    let slugCol  = "d-none d-md-block col-md-3"
+    let tmplCol  = "d-none d-md-block col-md-3"
+    div [ _id "theme_panel" ] [
+        a [ _href (relUrl app "admin/theme/new"); _class "btn btn-primary btn-sm mb-3"; _hxTarget "#theme_new" ] [
+            raw "Upload a New Theme"
+        ]
+        div [ _class "container g-0" ] [
+            div [ _class "row mwl-table-heading" ] [
+                div [ _class themeCol ] [ raw "Theme" ]
+                div [ _class slugCol ] [ raw "Slug" ]
+                div [ _class tmplCol ] [ raw "Templates" ]
+            ]
+        ]
+        div [ _class "row mwl-table-detail"; _id "theme_new" ] []
+        form [ _method "post"; _id "themeList"; _class "container g-0"; _hxTarget "#theme_panel"
+               _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [
+            antiCsrf app
+            for theme in model do
+                let url = relUrl app $"admin/theme/{theme.Id}"
+                div [ _class "row mwl-table-detail"; _id $"theme_{theme.Id}" ] [
+                    div [ _class $"{themeCol} no-wrap" ] [
+                        txt theme.Name
+                        if theme.IsInUse then span [ _class "badge bg-primary ms-2" ] [ raw "IN USE" ]
+                        if not theme.IsOnDisk then
+                            span [ _class "badge bg-warning text-dark ms-2" ] [ raw "NOT ON DISK" ]
+                        br []
+                        small [] [
+                            span [ _class "text-muted" ] [ txt $"v{theme.Version}" ]
+                            if not (theme.IsInUse || theme.Id = "default") then
+                                span [ _class "text-muted" ] [ raw " &bull; " ]
+                                a [ _href url; _hxDelete url; _class "text-danger"
+                                    _hxConfirm $"Are you sure you want to delete the theme “{theme.Name}”? This action cannot be undone." ] [
+                                    raw "Delete"
+                                ]
+                            span [ _class "d-md-none text-muted" ] [
+                                br []; raw "Slug: "; txt theme.Id; raw $" &bull; {theme.TemplateCount} Templates"
+                            ]
+                        ]
+                    ]
+                    div [ _class slugCol ] [ txt (string theme.Id) ]
+                    div [ _class tmplCol ] [ txt (string theme.TemplateCount) ]
+                ]
+        ]
+    ]
+    |> List.singleton
+
+
+/// Form to allow a theme to be uploaded
+let themeUpload app =
+    div [ _class "col" ] [
+        h5 [ _class "mt-2" ] [ raw app.PageTitle ]
+        form [ _action (relUrl app "admin/theme/new"); _method "post"; _class "container"
+               _enctype "multipart/form-data"; _hxNoBoost ] [
+            antiCsrf app
+            div [ _class "row " ] [
+                div [ _class "col-12 col-sm-6 pb-3" ] [
+                    div [ _class "form-floating" ] [
+                        input [ _type "file"; _id "file"; _name "file"; _class "form-control"; _accept ".zip"
+                                _placeholder "Theme File"; _required ]
+                        label [ _for "file" ] [ raw "Theme File" ]
+                    ]
+                ]
+                div [ _class "col-12 col-sm-6 pb-3 d-flex justify-content-center align-items-center" ] [
+                    div [ _class "form-check form-switch pb-2" ] [
+                        input [ _type "checkbox"; _name "DoOverwrite"; _id "doOverwrite"; _class "form-check-input"
+                                _value "true" ]
+                        label [ _for "doOverwrite"; _class "form-check-label" ] [ raw "Overwrite" ]
+                    ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col text-center" ] [
+                    button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Upload Theme" ]; raw " &nbsp; "
+                    button [ _type "button"; _class "btn btn-sm btn-secondary ms-3"
+                             _onclick "document.getElementById('theme_new').innerHTML = ''" ] [
+                        raw "Cancel"
+                    ]
+                ]
+            ]
+        ]
+    ]
+    |> List.singleton

src/MyWebLog/Views/Helpers.fs

@@ -0,0 +1,527 @@
+[<AutoOpen>]
+module MyWebLog.Views.Helpers
+
+open Microsoft.AspNetCore.Antiforgery
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Accessibility
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+open NodaTime
+open NodaTime.Text
+
+/// The rendering context for this application
+[<NoComparison; NoEquality>]
+type AppViewContext = {
+    /// The web log for this request
+    WebLog: WebLog
+    
+    /// The ID of the current user
+    UserId: WebLogUserId option
+    
+    /// The title of the page being rendered
+    PageTitle: string
+    
+    /// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form
+    Csrf: AntiforgeryTokenSet option
+    
+    /// The page list for the web log
+    PageList: DisplayPage array
+    
+    /// Categories and post counts for the web log
+    Categories: DisplayCategory array
+    
+    /// The URL of the page being rendered
+    CurrentPage: string
+    
+    /// User messages
+    Messages: UserMessage array
+    
+    /// The generator string for the rendered page
+    Generator: string
+    
+    /// A string to load the minified htmx script
+    HtmxScript: string
+    
+    /// Whether the current user is an author
+    IsAuthor: bool
+    
+    /// Whether the current user is an editor (implies author)
+    IsEditor: bool
+    
+    /// Whether the current user is a web log administrator (implies author and editor)
+    IsWebLogAdmin: bool
+    
+    /// Whether the current user is an installation administrator (implies all web log rights)
+    IsAdministrator: bool
+} with
+    
+    /// Whether there is a user logged on
+    member this.IsLoggedOn = Option.isSome this.UserId
+
+
+/// Create a relative URL for the current web log
+let relUrl app =
+    Permalink >> app.WebLog.RelativeUrl
+
+/// Add a hidden input with the anti-Cross Site Request Forgery (CSRF) token
+let antiCsrf app =
+    input [ _type "hidden"; _name app.Csrf.Value.FormFieldName; _value app.Csrf.Value.RequestToken ]
+
+/// Shorthand for encoded text in a template
+let txt = encodedText
+
+/// Shorthand for raw text in a template
+let raw = rawText
+
+/// Rel attribute to prevent opener information from being provided to the new window
+let _relNoOpener = _rel "noopener"
+
+/// The pattern for a long date
+let longDatePattern =
+    ZonedDateTimePattern.CreateWithInvariantCulture("MMMM d, yyyy", DateTimeZoneProviders.Tzdb)
+
+/// Create a long date
+let longDate app (instant: Instant) =
+    DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
+    |> Option.ofObj
+    |> Option.map (fun tz -> longDatePattern.Format(instant.InZone(tz)))
+    |> Option.defaultValue "--"
+    |> txt
+
+/// The pattern for a short time
+let shortTimePattern =
+    ZonedDateTimePattern.CreateWithInvariantCulture("h:mmtt", DateTimeZoneProviders.Tzdb)
+
+/// Create a short time
+let shortTime app (instant: Instant) =
+    DateTimeZoneProviders.Tzdb[app.WebLog.TimeZone]
+    |> Option.ofObj
+    |> Option.map (fun tz -> shortTimePattern.Format(instant.InZone(tz)).ToLowerInvariant())
+    |> Option.defaultValue "--"
+    |> txt
+
+/// Display "Yes" or "No" based on the state of a boolean value
+let yesOrNo value =
+    raw (if value then "Yes" else "No")
+
+/// Extract an attribute value from a list of attributes, remove that attribute if it is found 
+let extractAttrValue name attrs =
+    let valueAttr = attrs |> List.tryFind (fun x -> match x with KeyValue (key, _) when key = name -> true | _ -> false)
+    match valueAttr with
+    | Some (KeyValue (_, value)) ->
+        Some value,
+        attrs |> List.filter (fun x -> match x with KeyValue (key, _) when key = name -> false | _ -> true)
+    | Some _ | None -> None, attrs
+    
+/// Create a text input field
+let inputField fieldType attrs name labelText value extra =
+    let fieldId,  attrs = extractAttrValue "id"    attrs
+    let cssClass, attrs = extractAttrValue "class" attrs
+    div [ _class $"""form-floating {defaultArg cssClass ""}""" ] [
+        [ _type fieldType; _name name; _id (defaultArg fieldId name); _class "form-control"; _placeholder labelText
+          _value value ]
+        |> List.append attrs
+        |> input
+        label [ _for (defaultArg fieldId name) ] [ raw labelText ]
+        yield! extra
+    ]
+
+/// Create a text input field
+let textField attrs name labelText value extra =
+    inputField "text" attrs name labelText value extra
+
+/// Create a number input field
+let numberField attrs name labelText value extra =
+    inputField "number" attrs name labelText value extra
+
+/// Create an e-mail input field
+let emailField attrs name labelText value extra =
+    inputField "email" attrs name labelText value extra
+
+/// Create a password input field
+let passwordField attrs name labelText value extra =
+    inputField "password" attrs name labelText value extra
+
+/// Create a select (dropdown) field
+let selectField<'T, 'a>
+        attrs name labelText value (values: 'T seq) (idFunc: 'T -> 'a) (displayFunc: 'T -> string) extra =
+    let cssClass, attrs = extractAttrValue "class" attrs
+    div [ _class $"""form-floating {defaultArg cssClass ""}""" ] [
+        select ([ _name name; _id name; _class "form-control" ] |> List.append attrs) [
+            for item in values do
+                let itemId = string (idFunc item)
+                option [ _value itemId; if value = itemId then _selected ] [ raw (displayFunc item) ]
+        ]
+        label [ _for name ] [ raw labelText ]
+        yield! extra
+    ]
+
+/// Create a checkbox input styled as a switch
+let checkboxSwitch attrs name labelText (value: bool) extra =
+    let cssClass, attrs = extractAttrValue "class" attrs
+    div [ _class $"""form-check form-switch {defaultArg cssClass ""}""" ] [
+        [ _type "checkbox"; _name name; _id name; _class "form-check-input"; _value "true"; if value then _checked ]
+        |> List.append attrs
+        |> input
+        label [ _for name; _class "form-check-label" ] [ raw labelText ]
+        yield! extra
+    ]
+
+/// A standard save button
+let saveButton =
+    button [ _type "submit"; _class "btn btn-sm btn-primary" ] [ raw "Save Changes" ]
+
+/// A spacer bullet to use between action links
+let actionSpacer =
+    span [ _class "text-muted" ] [ raw " &bull; " ]
+
+/// Functions for generating content in varying layouts
+module Layout =
+    
+    /// Generate the title tag for a page
+    let private titleTag (app: AppViewContext) =
+        title [] [ txt app.PageTitle; raw " &laquo; Admin &laquo; "; txt app.WebLog.Name ]
+
+    /// Create a navigation link
+    let private navLink app name url =
+        let extraPath = app.WebLog.ExtraPath
+        let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
+        let active = if app.CurrentPage.StartsWith $"{path}{url}" then " active" else ""
+        li [ _class "nav-item" ] [
+            a [ _class $"nav-link{active}"; _href (relUrl app url) ] [ txt name ]
+        ]
+
+    /// Create a page view for the given content
+    let private pageView  (content: AppViewContext -> XmlNode list) app = [
+        header [] [
+            nav [ _class "navbar navbar-dark bg-dark navbar-expand-md justify-content-start px-2 position-fixed top-0 w-100" ] [
+                div [ _class "container-fluid" ] [
+                    a [ _class "navbar-brand"; _href (relUrl app ""); _hxNoBoost ] [ txt app.WebLog.Name ]
+                    button [ _type "button"; _class "navbar-toggler"; _data "bs-toggle" "collapse"
+                             _data "bs-target" "#navbarText"; _ariaControls "navbarText"; _ariaExpanded "false"
+                             _ariaLabel "Toggle navigation" ] [
+                        span [ _class "navbar-toggler-icon" ] []
+                    ]
+                    div [ _class "collapse navbar-collapse"; _id "navbarText" ] [
+                        if app.IsLoggedOn then
+                            ul [ _class "navbar-nav" ] [
+                                navLink app "Dashboard" "admin/dashboard"
+                                if app.IsAuthor then
+                                    navLink app "Pages"   "admin/pages"
+                                    navLink app "Posts"   "admin/posts"
+                                    navLink app "Uploads" "admin/uploads"
+                                if app.IsWebLogAdmin then
+                                    navLink app "Categories" "admin/categories"
+                                    navLink app "Settings"   "admin/settings"
+                                if app.IsAdministrator then navLink app "Admin" "admin/administration"
+                            ]
+                        ul [ _class "navbar-nav flex-grow-1 justify-content-end" ] [
+                            if app.IsLoggedOn then navLink app "My Info" "admin/my-info"
+                            li [ _class "nav-item" ] [
+                                a [ _class "nav-link"
+                                    _href "https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
+                                    _target "_blank" ] [
+                                    raw "Docs"
+                                ]
+                            ]
+                            if app.IsLoggedOn then
+                                li [ _class "nav-item" ] [
+                                    a [ _class "nav-link"; _href (relUrl app "user/log-off"); _hxNoBoost ] [
+                                        raw "Log Off"
+                                    ]
+                                ]
+                            else
+                                navLink app "Log On" "user/log-on"
+                        ]
+                    ]
+                ]
+            ]
+        ]
+        div [ _id "toastHost"; _class "position-fixed top-0 w-100"; _ariaLive "polite"; _ariaAtomic "true" ] [
+            div [ _id "toasts"; _class "toast-container position-absolute p-3 mt-5 top-0 end-0" ] [
+                for msg in app.Messages do
+                    let textColor = if msg.Level = "warning" then "" else " text-white"
+                    div [ _class "toast"; _roleAlert; _ariaLive "assertive"; _ariaAtomic "true"
+                          if msg.Level <> "success" then _data "bs-autohide" "false" ] [
+                        div [ _class $"toast-header bg-{msg.Level}{textColor}" ] [
+                            strong [ _class "me-auto text-uppercase" ] [
+                                raw (if msg.Level = "danger" then "error" else msg.Level)
+                            ]
+                            button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "toast"
+                                     _ariaLabel "Close" ] []
+                        ]
+                        div [ _class $"toast-body bg-{msg.Level} bg-opacity-25" ] [
+                            txt msg.Message
+                            if Option.isSome msg.Detail then
+                                hr []
+                                txt msg.Detail.Value
+                        ]
+                    ]
+            ]
+        ]
+        main [ _class "mx-3 mt-3" ] [
+            div [ _class "load-overlay p-5"; _id "loadOverlay" ] [ h1 [ _class "p-3" ] [ raw "Loading&hellip;" ] ]
+            yield! content app
+        ]
+        footer [ _class "position-fixed bottom-0 w-100" ] [
+            div [ _class "text-end text-white me-2" ] [
+                let version = app.Generator.Split ' '
+                small [ _class "me-1 align-baseline"] [ raw $"v{version[1]}" ]
+                img [ _src (relUrl app "themes/admin/logo-light.png"); _alt "myWebLog"; _width "120"; _height "34" ]
+            ]
+        ]
+    ]
+    
+    /// Render a page with a partial layout (htmx request)
+    let partial content app =
+        html [ _lang "en" ] [
+            titleTag app
+            yield! pageView content app
+        ]
+    
+    /// Render a page with a full layout
+    let full content app =
+        html [ _lang "en" ] [
+            meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
+            meta [ _name "generator"; _content app.Generator ]
+            titleTag app
+            link [ _rel "stylesheet"; _href "https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css"
+                   _integrity "sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3"
+                   _crossorigin "anonymous" ]
+            link [ _rel "stylesheet"; _href (relUrl app "themes/admin/admin.css") ]
+            body [ _hxBoost; _hxIndicator "#loadOverlay" ] [
+                yield! pageView content app
+                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.minified
+                script [ _src (relUrl app "themes/admin/admin.js") ] []
+            ]
+        ]
+    
+    /// Render a bare layout
+    let bare (content: AppViewContext -> XmlNode list) app =
+        html [ _lang "en" ] [
+            title [] []
+            yield! content app
+        ]
+
+
+// ~~ SHARED TEMPLATES BETWEEN POSTS AND PAGES
+open Giraffe.Htmx.Common
+
+/// The round-trip instant pattern
+let roundTrip = InstantPattern.CreateWithInvariantCulture "uuuu'-'MM'-'dd'T'HH':'mm':'ss'.'fffffff"
+
+/// Capitalize the first letter in the given string
+let private capitalize (it: string) =
+    $"{(string it[0]).ToUpper()}{it[1..]}"
+
+/// The common edit form shared by pages and posts
+let commonEdit (model: EditCommonModel) app = [
+    textField [ _class "mb-3"; _required; _autofocus ] (nameof model.Title) "Title" model.Title []
+    textField [ _class "mb-3"; _required ] (nameof model.Permalink) "Permalink" model.Permalink [
+        if not model.IsNew then
+            let urlBase = relUrl app $"admin/{model.Entity}/{model.Id}"
+            span [ _class "form-text" ] [
+                a [ _href $"{urlBase}/permalinks" ] [ raw "Manage Permalinks" ]; actionSpacer
+                a [ _href $"{urlBase}/revisions" ] [ raw "Manage Revisions" ]
+                if model.IncludeChapterLink then
+                    span [ _id "chapterEditLink" ] [
+                        actionSpacer; a [ _href $"{urlBase}/chapters" ] [ raw "Manage Chapters" ]
+                    ]
+            ]
+    ]
+    div [ _class "mb-2" ] [
+        label [ _for "text" ] [ raw "Text" ]; raw " &nbsp; &nbsp; "
+        div [ _class "btn-group btn-group-sm"; _roleGroup; _ariaLabel "Text format button group" ] [
+            input [ _type "radio"; _name (nameof model.Source); _id "source_html"; _class "btn-check"
+                    _value "HTML"; if model.Source = "HTML" then _checked ]
+            label [ _class "btn btn-sm btn-outline-secondary"; _for "source_html" ] [ raw "HTML" ]
+            input [ _type "radio"; _name (nameof model.Source); _id "source_md"; _class "btn-check"
+                    _value "Markdown"; if model.Source = "Markdown" then _checked ]
+            label [ _class "btn btn-sm btn-outline-secondary"; _for "source_md" ] [ raw "Markdown" ]
+        ]
+    ]
+    div [ _class "mb-3" ] [
+        textarea [ _name (nameof model.Text); _id (nameof model.Text); _class "form-control"; _rows "20" ] [
+            raw model.Text
+        ]
+    ]
+]
+
+
+/// Display a common template list
+let commonTemplates (model: EditCommonModel) (templates: MetaItem seq) =
+    selectField [ _class "mb-3" ] (nameof model.Template) $"{capitalize model.Entity} Template" model.Template templates
+                (_.Name) (_.Value) []
+
+
+/// Display the metadata item edit form
+let commonMetaItems (model: EditCommonModel) =
+    let items = Array.zip model.MetaNames model.MetaValues
+    let metaDetail idx (name, value) =
+        div [ _id $"meta_%i{idx}"; _class "row mb-3" ] [
+            div [ _class "col-1 text-center align-self-center" ] [
+                button [ _type "button"; _class "btn btn-sm btn-danger"; _onclick $"Admin.removeMetaItem({idx})" ] [
+                    raw "&minus;"
+                ]
+            ]
+            div [ _class "col-3" ] [ textField [ _id $"MetaNames_{idx}" ]  (nameof model.MetaNames)  "Name"  name  [] ]
+            div [ _class "col-8" ] [ textField [ _id $"MetaValues_{idx}" ] (nameof model.MetaValues) "Value" value [] ]
+        ]
+    
+    fieldset [] [
+        legend [] [
+            raw "Metadata "
+            button [ _type "button"; _class "btn btn-sm btn-secondary"; _data "bs-toggle" "collapse"
+                     _data "bs-target" "#meta_item_container" ] [
+                raw "show"
+            ]
+        ]
+        div [ _id "meta_item_container"; _class "collapse" ] [
+            div [ _id "meta_items"; _class "container" ] (items |> Array.mapi metaDetail |> List.ofArray)
+            button [ _type "button"; _class "btn btn-sm btn-secondary"; _onclick "Admin.addMetaItem()" ] [
+                raw "Add an Item"
+            ]
+            script [] [
+                raw """document.addEventListener("DOMContentLoaded", """
+                raw $"() => Admin.setNextMetaIndex({items.Length}))"
+            ]
+        ]
+    ]
+
+
+/// Revision preview template
+let commonPreview (rev: Revision) app =
+    div [ _class "mwl-revision-preview mb-3" ] [
+        rev.Text.AsHtml() |> addBaseToRelativeUrls app.WebLog.ExtraPath |> raw
+    ]
+    |> List.singleton
+
+
+/// Form to manage permalinks for pages or posts
+let managePermalinks (model: ManagePermalinksModel) app = [
+    let baseUrl = relUrl app $"admin/{model.Entity}/"
+    let linkDetail idx link =
+        div [ _id $"link_%i{idx}"; _class "row mb-3" ] [
+            div [ _class "col-1 text-center align-self-center" ] [
+                button [ _type "button"; _class "btn btn-sm btn-danger"
+                         _onclick $"Admin.removePermalink({idx})" ] [
+                    raw "&minus;"
+                ]
+            ]
+            div [ _class "col-11" ] [
+                div [ _class "form-floating" ] [
+                    input [ _type "text"; _name "Prior"; _id $"prior_{idx}"; _class "form-control"; _placeholder "Link"
+                            _value link ]
+                    label [ _for $"prior_{idx}" ] [ raw "Link" ]
+                ]
+            ]
+        ]
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _action $"{baseUrl}permalinks"; _method "post"; _class "container" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name "Id"; _value model.Id ]
+            div [ _class "row" ] [
+                div [ _class "col" ] [
+                    p [ _style "line-height:1.2rem;" ] [
+                        strong [] [ txt model.CurrentTitle ]; br []
+                        small [ _class "text-muted" ] [
+                            span [ _class "fst-italic" ] [ txt model.CurrentPermalink ]; br []
+                            a [ _href $"{baseUrl}{model.Id}/edit" ] [
+                                raw $"&laquo; Back to Edit {capitalize model.Entity}"
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col" ] [
+                    button [ _type "button"; _class "btn btn-sm btn-secondary"; _onclick "Admin.addPermalink()" ] [
+                        raw "Add a Permalink"
+                    ]
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col" ] [
+                    div [ _id "permalinks"; _class "container g-0" ] [
+                        yield! Array.mapi linkDetail model.Prior
+                        script [] [
+                            raw """document.addEventListener("DOMContentLoaded", """
+                            raw $"() => Admin.setPermalinkIndex({model.Prior.Length}))"
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col " ] [
+                    button [ _type "submit"; _class "btn btn-primary" ] [ raw "Save Changes" ]
+                ]
+            ]
+        ]
+    ]
+]
+
+/// Form to manage revisions for pages or posts
+let manageRevisions (model: ManageRevisionsModel) app = [
+    let revUrlBase = relUrl app $"admin/{model.Entity}/{model.Id}/revision"
+    let revDetail idx (rev: Revision) =
+        let asOfString = roundTrip.Format rev.AsOf
+        let asOfId     = $"""rev_{asOfString.Replace(".", "_").Replace(":", "-")}"""
+        div [ _id asOfId; _class "row pb-3 mwl-table-detail" ] [
+            div [ _class "col-12 mb-1" ] [
+                longDate app rev.AsOf; raw " at "; shortTime app rev.AsOf; raw " "
+                span [ _class "badge bg-secondary text-uppercase ms-2" ] [ txt (string rev.Text.SourceType) ]
+                if idx = 0 then span [ _class "badge bg-primary text-uppercase ms-2" ] [ raw "Current Revision" ]
+                br []
+                if idx > 0 then
+                    let revUrlPrefix = $"{revUrlBase}/{asOfString}"
+                    let revRestore   = $"{revUrlPrefix}/restore"
+                    small [] [
+                        a [ _href $"{revUrlPrefix}/preview"; _hxTarget $"#{asOfId}_preview" ] [ raw "Preview" ]
+                        span [ _class "text-muted" ] [ raw " &bull; " ]
+                        a [ _href revRestore; _hxPost revRestore ] [ raw "Restore as Current" ]
+                        span [ _class "text-muted" ] [ raw " &bull; " ]
+                        a [ _href revUrlPrefix; _hxDelete revUrlPrefix; _hxTarget $"#{asOfId}"
+                            _hxSwap HxSwap.OuterHtml; _class "text-danger" ] [
+                            raw "Delete"
+                        ]
+                    ]
+            ]
+            if idx > 0 then div [ _id $"{asOfId}_preview"; _class "col-12" ] []
+        ]
+
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _method "post"; _hxTarget "body"; _class "container mb-3" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name "Id"; _value model.Id ]
+            div [ _class "row" ] [
+                div [ _class "col" ] [
+                    p [ _style "line-height:1.2rem;" ] [
+                        strong [] [ txt model.CurrentTitle ]; br []
+                        small [ _class "text-muted" ] [
+                            a [ _href (relUrl app $"admin/{model.Entity}/{model.Id}/edit") ] [
+                                raw $"&laquo; Back to Edit {(string model.Entity[0]).ToUpper()}{model.Entity[1..]}"
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+            if model.Revisions.Length > 1 then
+                div [ _class "row mb-3" ] [
+                    div [ _class "col" ] [
+                        button [ _type "button"; _class "btn btn-sm btn-danger"; _hxDelete $"{revUrlBase}s"
+                                 _hxConfirm "This will remove all revisions but the current one; are you sure this is what you wish to do?" ] [
+                            raw "Delete All Prior Revisions"
+                        ]
+                    ]
+                ]
+            div [ _class "row mwl-table-heading" ] [ div [ _class "col" ] [ raw "Revision" ] ]
+            yield! List.mapi revDetail model.Revisions
+        ]
+    ]
+]

src/MyWebLog/Views/Page.fs

@@ -0,0 +1,105 @@
+module MyWebLog.Views.Page
+
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+
+/// The form to edit pages
+let pageEdit (model: EditPageModel) templates app = [
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _action (relUrl app "admin/page/save"); _method "post"; _hxPushUrl "true"; _class "container" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name (nameof model.Id); _value model.Id ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col-9" ] (commonEdit model app)
+                div [ _class "col-3" ] [
+                    commonTemplates model templates
+                    checkboxSwitch [] (nameof model.IsShownInPageList) "Show in Page List" model.IsShownInPageList []
+                ]
+            ]
+            div [ _class "row mb-3" ] [ div [ _class "col" ] [ saveButton ] ]
+            div [ _class "row mb-3" ] [ div [ _class "col" ] [ commonMetaItems model ] ]
+        ]
+    ]
+]
+
+
+/// Display a list of pages for this web log
+let pageList (pages: DisplayPage list) pageNbr hasNext app = [
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        a [ _href (relUrl app "admin/page/new/edit"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Create a New Page" ]
+        if pages.Length = 0 then
+            p [ _class "text-muted fst-italic text-center" ] [ raw "This web log has no pages" ]
+        else
+            let titleCol = "col-12 col-md-5"
+            let linkCol  = "col-12 col-md-5"
+            let upd8Col  = "col-12 col-md-2"
+            form [ _method "post"; _class "container mb-3"; _hxTarget "body" ] [
+                antiCsrf app
+                div [ _class "row mwl-table-heading" ] [
+                    div [ _class titleCol ] [
+                        span [ _class "d-none d-md-inline" ] [ raw "Title" ]; span [ _class "d-md-none" ] [ raw "Page" ]
+                    ]
+                    div [ _class $"{linkCol} d-none d-md-inline-block" ] [ raw "Permalink" ]
+                    div [ _class $"{upd8Col} d-none d-md-inline-block" ] [ raw "Updated" ]
+                ]
+                for pg in pages do
+                    let pageLink = if pg.IsDefault then "" else pg.Permalink
+                    div [ _class "row mwl-table-detail" ] [
+                        div [ _class titleCol ] [
+                            txt pg.Title
+                            if pg.IsDefault then
+                                raw "   "; span [ _class "badge bg-success" ] [ raw "HOME PAGE" ]
+                            if pg.IsInPageList then
+                                raw "   "; span [ _class "badge bg-primary" ] [ raw "IN PAGE LIST" ]
+                            br [] ; small [] [
+                                let adminUrl = relUrl app $"admin/page/{pg.Id}"
+                                a [ _href (relUrl app pageLink); _target "_blank" ] [ raw "View Page" ]
+                                if app.IsEditor || (app.IsAuthor && app.UserId.Value = WebLogUserId pg.AuthorId) then
+                                    span [ _class "text-muted" ] [ raw " • " ]
+                                    a [ _href $"{adminUrl}/edit" ] [ raw "Edit" ]
+                                if app.IsWebLogAdmin then
+                                    span [ _class "text-muted" ] [ raw " • " ]
+                                    a [ _href adminUrl; _hxDelete adminUrl; _class "text-danger"
+                                        _hxConfirm $"Are you sure you want to delete the page “{pg.Title}”? This action cannot be undone." ] [
+                                        raw "Delete"
+                                    ]
+                            ]
+                        ]
+                        div [ _class linkCol ] [
+                            small [ _class "d-md-none" ] [ txt pageLink ]
+                            span [ _class "d-none d-md-inline" ] [ txt pageLink ]
+                        ]
+                        div [ _class upd8Col ] [
+                            small [ _class "d-md-none text-muted" ] [
+                                raw "Updated "; txt (pg.UpdatedOn.ToString "MMMM d, yyyy")
+                            ]
+                            span [ _class "d-none d-md-inline" ] [ txt (pg.UpdatedOn.ToString "MMMM d, yyyy") ]
+                        ]
+                    ]
+            ]
+            if pageNbr > 1 || hasNext then
+                div [ _class "d-flex justify-content-evenly mb-3" ] [
+                    div [] [
+                        if pageNbr > 1 then
+                            let prevPage = if pageNbr = 2 then "" else $"/page/{pageNbr - 1}"
+                            p [] [
+                                a [ _class "btn btn-secondary"; _href (relUrl app $"admin/pages{prevPage}") ] [
+                                    raw "« Previous"
+                                ]
+                            ]
+                    ]
+                    div [ _class "text-right" ] [
+                        if hasNext then
+                            p [] [
+                                a [ _class "btn btn-secondary"; _href (relUrl app $"admin/pages/page/{pageNbr + 1}") ] [
+                                    raw "Next »"
+                                ]
+                            ]
+                    ]
+                ]
+    ]
+]

src/MyWebLog/Views/Post.fs

@@ -0,0 +1,524 @@
+module MyWebLog.Views.Post
+
+open Giraffe.Htmx.Common
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+open NodaTime.Text
+
+/// The pattern for chapter start times
+let startTimePattern = DurationPattern.CreateWithInvariantCulture "H:mm:ss.FF"
+
+/// The form to add or edit a chapter
+let chapterEdit (model: EditChapterModel) app = [
+    let postUrl = relUrl app $"admin/post/{model.PostId}/chapter/{model.Index}"
+    h3 [ _class "my-3" ] [ raw (if model.Index < 0 then "Add" else "Edit"); raw " Chapter" ]
+    p [ _class "form-text" ] [
+        raw "Times may be entered as seconds; minutes and seconds; or hours, minutes and seconds. Fractional seconds "
+        raw "are supported to two decimal places."
+    ]
+    form [ _method "post"; _action postUrl; _hxPost postUrl; _hxTarget "#chapter_list"; _class "container" ] [
+        antiCsrf app
+        input [ _type "hidden"; _name "PostId"; _value model.PostId ]
+        input [ _type "hidden"; _name "Index"; _value (string model.Index) ]
+        div [ _class "row" ] [
+            div [ _class "col-6 col-lg-3 mb-3" ] [
+                textField [ _required; _autofocus ] (nameof model.StartTime) "Start Time"
+                          (if model.Index < 0 then "" else model.StartTime) []
+            ]
+            div [ _class "col-6 col-lg-3 mb-3" ] [
+                textField [] (nameof model.EndTime) "End Time" model.EndTime [
+                    span [ _class "form-text" ] [ raw "Optional; ends when next starts" ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-6 mb-3" ] [
+                textField [] (nameof model.Title) "Chapter Title" model.Title [
+                    span [ _class "form-text" ] [ raw "Optional" ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-6 col-xl-5 mb-3" ] [
+                textField [] (nameof model.ImageUrl) "Image URL" model.ImageUrl [
+                    span [ _class "form-text" ] [
+                        raw "Optional; a separate image to display while this chapter is playing"
+                    ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-6 col-xl-5 mb-3" ] [
+                textField [] (nameof model.Url) "URL" model.Url [
+                    span [ _class "form-text" ] [ raw "Optional; informational link for this chapter" ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-6 offset-lg-3 col-xl-2 offset-xl-0 mb-3 align-self-end d-flex flex-column" ] [
+                checkboxSwitch [] (nameof model.IsHidden) "Hidden Chapter" model.IsHidden []
+                span [ _class "mt-2 form-text" ] [ raw "Not displayed, but may update image and location" ]
+            ]
+        ]
+        div [ _class "row" ] [
+            let hasLoc, attrs = if model.LocationName = "" then false, [ _disabled ] else true, []
+            div [ _class "col-12 col-md-4 col-lg-3 offset-lg-1 mb-3 align-self-end" ] [
+                checkboxSwitch [ _onclick "Admin.checkChapterLocation()" ] "has_location" "Associate Location" hasLoc []
+            ]
+            div [ _class "col-12 col-md-8 col-lg-6 offset-lg-1 mb-3" ] [
+                textField (_required :: attrs) (nameof model.LocationName) "Name" model.LocationName []
+            ]
+            div [ _class "col-6 col-lg-4 offset-lg-2 mb-3" ] [
+                textField (_required :: attrs) (nameof model.LocationGeo) "Geo URL" model.LocationGeo [
+                    em [ _class "form-text" ] [
+                        a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/location/location.md#geo-recommended"
+                            _target "_blank"; _relNoOpener ] [
+                            raw "see spec"
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "col-6 col-lg-4 mb-3" ] [
+                textField attrs (nameof model.LocationOsm) "OpenStreetMap ID" model.LocationOsm [
+                    em [ _class "form-text" ] [
+                        raw "Optional; "
+                        a [ _href "https://www.openstreetmap.org/"; _target "_blank"; _relNoOpener ] [ raw "get ID" ]
+                        raw ", " 
+                        a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/location/location.md#osm-recommended"
+                            _target "_blank"; _relNoOpener ] [
+                            raw "see spec"
+                        ]
+                    ]
+                ]
+            ]
+        ]
+        div [ _class "row" ] [
+            div [ _class "col" ] [
+                let cancelLink = relUrl app $"admin/post/{model.PostId}/chapters"
+                if model.Index < 0 then
+                    checkboxSwitch [ _checked ] (nameof model.AddAnother) "Add Another New Chapter" true []
+                else
+                    input [ _type "hidden"; _name "AddAnother"; _value "false" ]
+                saveButton; raw " &nbsp; "
+                a [ _href cancelLink; _hxGet cancelLink; _class "btn btn-secondary"; _hxTarget "body" ] [ raw "Cancel" ]
+            ]
+        ]
+    ]
+]
+
+/// Display a list of chapters
+let chapterList withNew (model: ManageChaptersModel) app =
+    form [ _method "post"; _id "chapter_list"; _class "container mb-3"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
+        antiCsrf app
+        input [ _type "hidden"; _name "Id"; _value model.Id ]
+        div [ _class "row mwl-table-heading" ] [
+            div [ _class "col-3 col-md-2" ] [ raw "Start" ]
+            div [ _class "col-3 col-md-6 col-lg-8" ] [ raw "Title" ]
+            div [ _class "col-3 col-md-2 col-lg-1 text-center" ] [ raw "Image?" ]
+            div [ _class "col-3 col-md-2 col-lg-1 text-center" ] [ raw "Location?" ]
+        ]
+        yield! model.Chapters |> List.mapi (fun idx chapter ->
+            div [ _class "row mwl-table-detail"; _id $"chapter{idx}" ] [
+                div [ _class "col-3 col-md-2" ] [ txt (startTimePattern.Format chapter.StartTime) ]
+                div [ _class "col-3 col-md-6 col-lg-8" ] [
+                    match chapter.Title with
+                    | Some title -> txt title
+                    | None -> em [ _class "text-muted" ] [ raw "no title" ]
+                    br []
+                    small [] [
+                        if withNew then
+                            raw "&nbsp;"
+                        else
+                            let chapterUrl = relUrl app $"admin/post/{model.Id}/chapter/{idx}"
+                            a [ _href chapterUrl; _hxGet chapterUrl; _hxTarget $"#chapter{idx}"
+                                _hxSwap $"{HxSwap.InnerHtml} show:#chapter{idx}:top" ] [
+                                raw "Edit"
+                            ]
+                            span [ _class "text-muted" ] [ raw " &bull; " ]
+                            a [ _href chapterUrl; _hxDelete chapterUrl; _class "text-danger" ] [
+                                raw "Delete"
+                            ]
+                    ]
+                ]
+                div [ _class "col-3 col-md-2 col-lg-1 text-center" ] [ yesOrNo (Option.isSome chapter.ImageUrl) ]
+                div [ _class "col-3 col-md-2 col-lg-1 text-center" ] [ yesOrNo (Option.isSome chapter.Location) ]
+            ])
+        div [ _class "row pb-3"; _id "chapter-1" ] [
+            let newLink = relUrl app $"admin/post/{model.Id}/chapter/-1"
+            if withNew then
+                span [ _hxGet newLink; _hxTarget "#chapter-1"; _hxTrigger "load"; _hxSwap "show:#chapter-1:top" ] []
+            else
+                div [ _class "row pb-3 mwl-table-detail" ] [
+                    div [ _class "col-12" ] [
+                        a [ _class "btn btn-primary"; _href newLink; _hxGet newLink; _hxTarget "#chapter-1"
+                            _hxSwap "show:#chapter-1:top" ] [
+                            raw "Add a New Chapter"
+                        ]
+                    ]
+                ]
+        ]
+    ]
+    |> List.singleton
+
+/// Manage Chapters page
+let chapters withNew (model: ManageChaptersModel) app = [
+    h2 [ _class "my-3" ] [ txt app.PageTitle ]
+    article [] [
+        p [ _style "line-height:1.2rem;" ] [
+            strong [] [ txt model.Title ]; br []
+            small [ _class "text-muted" ] [
+                a [ _href (relUrl app $"admin/post/{model.Id}/edit") ] [
+                    raw "&laquo; Back to Edit Post"
+                ]
+            ]
+        ]
+        yield! chapterList withNew model app
+    ]
+]
+
+/// Display a list of posts
+let list (model: PostDisplay) app = [
+    let dateCol   = "col-xs-12 col-md-3 col-lg-2"
+    let titleCol  = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4"
+    let authorCol = "col-xs-12 col-md-2 col-lg-1"
+    let tagCol    = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block"
+    h2 [ _class "my-3" ] [ txt app.PageTitle ]
+    article [] [
+        a [ _href (relUrl app "admin/post/new/edit"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Write a New Post" ]
+        if model.Posts.Length > 0 then
+            form [ _method "post"; _class "container mb-3"; _hxTarget "body" ] [
+                antiCsrf app
+                div [ _class "row mwl-table-heading" ] [
+                    div [ _class dateCol ] [
+                        span [ _class "d-md-none" ] [ raw "Post" ]; span [ _class "d-none d-md-inline" ] [ raw "Date" ]
+                    ]
+                    div [ _class $"{titleCol} d-none d-md-inline-block" ] [ raw "Title" ]
+                    div [ _class $"{authorCol} d-none d-md-inline-block" ] [ raw "Author" ]
+                    div [ _class tagCol ] [ raw "Tags" ]
+                ]
+                for post in model.Posts do
+                    div [ _class "row mwl-table-detail" ] [
+                        div [ _class $"{dateCol} no-wrap" ] [
+                            small [ _class "d-md-none" ] [
+                                if post.PublishedOn.HasValue then
+                                    raw "Published "; txt (post.PublishedOn.Value.ToString "MMMM d, yyyy")
+                                else raw "Not Published"
+                                if post.PublishedOn.HasValue && post.PublishedOn.Value <> post.UpdatedOn then
+                                    em [ _class "text-muted" ] [
+                                        raw " (Updated "; txt (post.UpdatedOn.ToString "MMMM d, yyyy"); raw ")"
+                                    ]
+                            ]
+                            span [ _class "d-none d-md-inline" ] [
+                                if post.PublishedOn.HasValue then txt (post.PublishedOn.Value.ToString "MMMM d, yyyy")
+                                else raw "Not Published"
+                                if not post.PublishedOn.HasValue || post.PublishedOn.Value <> post.UpdatedOn then
+                                    br []
+                                    small [ _class "text-muted" ] [
+                                        em [] [ txt (post.UpdatedOn.ToString "MMMM d, yyyy") ]
+                                    ]
+                            ]
+                        ]
+                        div [ _class titleCol ] [
+                            if Option.isSome post.Episode then
+                                span [ _class "badge bg-success float-end text-uppercase mt-1" ] [ raw "Episode" ]
+                            raw post.Title; br []
+                            small [] [
+                                let postUrl = relUrl app $"admin/post/{post.Id}"
+                                a [ _href (relUrl app post.Permalink); _target "_blank" ] [ raw "View Post" ]
+                                if app.IsEditor || (app.IsAuthor && app.UserId.Value = WebLogUserId post.AuthorId) then
+                                    span [ _class "text-muted" ] [ raw " &bull; " ]
+                                    a [ _href $"{postUrl}/edit" ] [ raw "Edit" ]
+                                if app.IsWebLogAdmin then
+                                    span [ _class "text-muted" ] [ raw " &bull; " ]
+                                    a [ _href postUrl; _hxDelete postUrl; _class "text-danger"
+                                        _hxConfirm $"Are you sure you want to delete the post “{post.Title}”? This action cannot be undone." ] [
+                                        raw "Delete"
+                                    ]
+                            ]
+                        ]
+                        div [ _class authorCol ] [
+                            let author =
+                                model.Authors
+                                |> List.tryFind (fun a -> a.Name = post.AuthorId)
+                                |> Option.map _.Value
+                                |> Option.defaultValue "--"
+                                |> txt
+                            small [ _class "d-md-none" ] [
+                                raw "Authored by "; author; raw " | "
+                                raw (if post.Tags.Length = 0 then "No" else string post.Tags.Length)
+                                raw " Tag"; if post.Tags.Length <> 0 then raw "s"
+                            ]
+                            span [ _class "d-none d-md-inline" ] [ author ]
+                        ]
+                        div [ _class tagCol ] [
+                            let tags =
+                                post.Tags |> List.mapi (fun idx tag -> idx, span [ _class "no-wrap" ] [ txt tag ])
+                            for tag in tags do
+                                snd tag
+                                if fst tag < tags.Length - 1 then raw ", "
+                        ]
+                    ]
+            ]
+            if Option.isSome model.NewerLink || Option.isSome model.OlderLink then
+                div [ _class "d-flex justify-content-evenly mb-3" ] [
+                    div [] [
+                        if Option.isSome model.NewerLink then
+                            p [] [
+                                a [ _href model.NewerLink.Value; _class "btn btn-secondary"; ] [
+                                    raw "&laquo; Newer Posts"
+                                ]
+                            ]
+                    ]
+                    div [ _class "text-right" ] [
+                        if Option.isSome model.OlderLink then
+                            p [] [
+                                a [ _href model.OlderLink.Value; _class "btn btn-secondary" ] [
+                                    raw "Older Posts &raquo;"
+                                ]
+                            ]
+                    ]
+                ]
+        else
+            p [ _class "text-muted fst-italic text-center" ] [ raw "This web log has no posts" ]
+    ]
+]
+
+let postEdit (model: EditPostModel) templates (ratings: MetaItem list) app = [
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _action (relUrl app "admin/post/save"); _method "post"; _hxPushUrl "true"; _class "container" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name (nameof model.Id); _value model.Id ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col-12 col-lg-9" ] [
+                    yield! commonEdit model app
+                    textField [ _class "mb-3" ] (nameof model.Tags) "Tags" model.Tags [
+                        div [ _class "form-text" ] [ raw "comma-delimited" ]
+                    ]
+                    if model.Status = string Draft then
+                        checkboxSwitch [ _class "mb-2" ] (nameof model.DoPublish) "Publish This Post" model.DoPublish []
+                    saveButton
+                    hr [ _class "mb-3" ]
+                    fieldset [ _class "mb-3" ] [
+                        legend [] [
+                            span [ _class "form-check form-switch" ] [
+                                small [] [
+                                    input [ _type "checkbox"; _name (nameof model.IsEpisode)
+                                            _id (nameof model.IsEpisode); _class "form-check-input"; _value "true"
+                                            _data "bs-toggle" "collapse"; _data "bs-target" "#episode_items"
+                                            _onclick "Admin.toggleEpisodeFields()"; if model.IsEpisode then _checked ]
+                                ]
+                                label [ _for (nameof model.IsEpisode) ] [ raw "Podcast Episode" ]
+                            ]
+                        ]
+                        div [ _id "episode_items"
+                              _class $"""container p-0 collapse{if model.IsEpisode then " show" else ""}""" ] [
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-8 pb-3" ] [
+                                    textField [ _required ] (nameof model.Media) "Media File" model.Media [
+                                        div [ _class "form-text" ] [
+                                            raw "Relative URL will be appended to base media path (if set) "
+                                            raw "or served from this web log"
+                                        ]
+                                    ]
+                                ]
+                                div [ _class "col-12 col-md-4 pb-3" ] [
+                                    textField [] (nameof model.MediaType) "Media MIME Type" model.MediaType [
+                                        div [ _class "form-text" ] [ raw "Optional; overrides podcast default" ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row pb-3" ] [
+                                div [ _class "col" ] [
+                                    numberField [ _required ] (nameof model.Length) "Media Length (bytes)"
+                                                (string model.Length) [
+                                        div [ _class "form-text" ] [ raw "TODO: derive from above file name" ]
+                                    ]
+                                ]
+                                div [ _class "col" ] [
+                                    textField [] (nameof model.Duration) "Duration" model.Duration [
+                                        div [ _class "form-text" ] [
+                                            raw "Recommended; enter in "; code [] [ raw "HH:MM:SS"]; raw " format"
+                                        ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row pb-3" ] [
+                                div [ _class "col" ] [
+                                    textField [] (nameof model.Subtitle) "Subtitle" model.Subtitle [
+                                        div [ _class "form-text" ] [ raw "Optional; a subtitle for this episode" ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-8 pb-3" ] [
+                                    textField [] (nameof model.ImageUrl) "Image URL" model.ImageUrl [
+                                        div [ _class "form-text" ] [
+                                            raw "Optional; overrides podcast default; "
+                                            raw "relative URL served from this web log"
+                                        ]
+                                    ]
+                                ]
+                                div [ _class "col-12 col-md-4 pb-3" ] [
+                                    selectField [] (nameof model.Explicit) "Explicit Rating" model.Explicit ratings
+                                                (_.Name) (_.Value) [
+                                        div [ _class "form-text" ] [ raw "Optional; overrides podcast default" ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-8 pb-3" ] [
+                                    div [ _class "form-text" ] [ raw "Chapters" ]
+                                    div [ _class "form-check form-check-inline" ] [
+                                        input [ _type "radio"; _name (nameof model.ChapterSource)
+                                                _id "chapter_source_none"; _value "none"; _class "form-check-input"
+                                                if model.ChapterSource = "none" then _checked
+                                                _onclick "Admin.setChapterSource('none')" ]
+                                        label [ _for "chapter_source_none" ] [ raw "None" ]
+                                    ]
+                                    div [ _class "form-check form-check-inline" ] [
+                                        input [ _type "radio"; _name (nameof model.ChapterSource)
+                                                _id "chapter_source_internal"; _value "internal"
+                                                _class "form-check-input"
+                                                if model.ChapterSource= "internal" then _checked
+                                                _onclick "Admin.setChapterSource('internal')" ]
+                                        label [ _for "chapter_source_internal" ] [ raw "Defined Here" ]
+                                    ]
+                                    div [ _class "form-check form-check-inline" ] [
+                                        input [ _type "radio"; _name (nameof model.ChapterSource)
+                                                _id "chapter_source_external"; _value "external"
+                                                _class "form-check-input"
+                                                if model.ChapterSource = "external" then _checked
+                                                _onclick "Admin.setChapterSource('external')" ]
+                                        label [ _for "chapter_source_external" ] [ raw "Separate File" ]
+                                    ]
+                                ]
+                                div [ _class "col-md-4 d-flex justify-content-center" ] [
+                                    checkboxSwitch [ _class "align-self-center pb-3" ] (nameof model.ContainsWaypoints)
+                                                   "Chapters contain waypoints" model.ContainsWaypoints []
+                                ]
+                            ]
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-8 pb-3" ] [
+                                    textField [] (nameof model.ChapterFile) "Chapter File" model.ChapterFile [
+                                        div [ _class "form-text" ] [ raw "Relative URL served from this web log" ]
+                                    ]
+                                ]
+                                div [ _class "col-12 col-md-4 pb-3" ] [
+                                    textField [] (nameof model.ChapterType) "Chapter MIME Type" model.ChapterType [
+                                        div [ _class "form-text" ] [
+                                            raw "Optional; "; code [] [ raw "application/json+chapters" ]
+                                            raw " assumed if chapter file ends with "; code [] [ raw ".json" ]
+                                        ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-8 pb-3" ] [
+                                    textField [ _onkeyup "Admin.requireTranscriptType()" ] (nameof model.TranscriptUrl)
+                                              "Transcript URL" model.TranscriptUrl [
+                                        div [ _class "form-text" ] [
+                                            raw "Optional; relative URL served from this web log"
+                                        ]
+                                    ]
+                                ]
+                                div [ _class "col-12 col-md-4 pb-3" ] [
+                                    textField [ if model.TranscriptUrl <> "" then _required ]
+                                              (nameof model.TranscriptType) "Transcript MIME Type"
+                                              model.TranscriptType [
+                                        div [ _class "form-text" ] [ raw "Required if transcript URL provided" ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row pb-3" ] [
+                                div [ _class "col" ] [
+                                    textField [] (nameof model.TranscriptLang) "Transcript Language"
+                                              model.TranscriptLang [
+                                        div [ _class "form-text" ] [ raw "Optional; overrides podcast default" ]
+                                    ]
+                                ]
+                                div [ _class "col d-flex justify-content-center" ] [
+                                    checkboxSwitch [ _class "align-self-center pb-3" ] (nameof model.TranscriptCaptions)
+                                                   "This is a captions file" model.TranscriptCaptions []
+                                ]
+                            ]
+                            div [ _class "row pb-3" ] [
+                                div [ _class "col col-md-4" ] [
+                                    numberField [] (nameof model.SeasonNumber) "Season Number"
+                                                (string model.SeasonNumber) [
+                                        div [ _class "form-text" ] [ raw "Optional" ]
+                                    ]
+                                ]
+                                div [ _class "col col-md-8" ] [
+                                    textField [ _maxlength "128" ] (nameof model.SeasonDescription) "Season Description"
+                                              model.SeasonDescription [
+                                        div [ _class "form-text" ] [ raw "Optional" ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row pb-3" ] [
+                                div [ _class "col col-md-4" ] [
+                                    numberField [ _step "0.01" ] (nameof model.EpisodeNumber) "Episode Number"
+                                                model.EpisodeNumber [
+                                        div [ _class "form-text" ] [ raw "Optional; up to 2 decimal points" ]
+                                    ]
+                                ]
+                                div [ _class "col col-md-8" ] [
+                                    textField [ _maxlength "128" ] (nameof model.EpisodeDescription)
+                                              "Episode Description" model.EpisodeDescription [
+                                        div [ _class "form-text" ] [ raw "Optional" ]
+                                    ]
+                                ]
+                            ]
+                        ]
+                        script [] [
+                            raw """document.addEventListener("DOMContentLoaded", () => Admin.toggleEpisodeFields())"""
+                        ]
+                    ]
+                    commonMetaItems model
+                    if model.Status = string Published then
+                        fieldset [ _class "pb-3" ] [
+                            legend [] [ raw "Maintenance" ]
+                            div [ _class "container" ] [
+                                div [ _class "row" ] [
+                                    div [ _class "col align-self-center" ] [
+                                        checkboxSwitch [ _class "pb-2" ] (nameof model.SetPublished)
+                                                       "Set Published Date" model.SetPublished []
+                                    ]
+                                    div [ _class "col-4" ] [
+                                        div [ _class "form-floating" ] [
+                                            input [ _type "datetime-local"; _name (nameof model.PubOverride)
+                                                    _id (nameof model.PubOverride); _class "form-control"
+                                                    _placeholder "Override Date"
+                                                    if model.PubOverride.HasValue then
+                                                        _value (model.PubOverride.Value.ToString "yyyy-MM-dd\THH:mm") ]
+                                            label [ _for (nameof model.PubOverride); _class "form-label" ] [
+                                                raw "Published On"
+                                            ]
+                                        ]
+                                    ]
+                                    div [ _class "col-5 align-self-center" ] [
+                                        checkboxSwitch [ _class "pb-2" ] (nameof model.SetUpdated)
+                                                       "Purge revisions and<br>set as updated date as well"
+                                                       model.SetUpdated []
+                                    ]
+                                ]
+                            ]
+                        ]
+                ]
+                div [ _class "col-12 col-lg-3" ] [
+                    commonTemplates model templates
+                    fieldset [] [
+                        legend [] [ raw "Categories" ]
+                        for cat in app.Categories do
+                            div [ _class "form-check" ] [
+                                input [ _type "checkbox"; _name (nameof model.CategoryIds); _id $"category_{cat.Id}"
+                                        _class "form-check-input"; _value cat.Id
+                                        if model.CategoryIds |> Array.contains cat.Id then _checked ]
+                                label [ _for $"category_{cat.Id}"; _class "form-check-label"
+                                        match cat.Description with Some it -> _title it | None -> () ] [
+                                    yield! cat.ParentNames |> Array.map (fun _ -> raw "&nbsp; &rang; &nbsp;")
+                                    txt cat.Name
+                                ]
+                          ]
+                    ]
+                ]
+            ]
+        ]
+    ]
+    script [] [ raw "window.setTimeout(() => Admin.toggleEpisodeFields(), 500)" ]
+]

src/MyWebLog/Views/User.fs

@@ -0,0 +1,258 @@
+module MyWebLog.Views.User
+
+open Giraffe.Htmx.Common
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+
+/// User edit form
+let edit (model: EditUserModel) app =
+    let levelOption value name =
+        option [ _value value; if model.AccessLevel = value then _selected ] [ txt name ]
+    div [ _class "col-12" ] [
+        h5 [ _class "my-3" ] [ txt app.PageTitle ]
+        form [ _hxPost (relUrl app "admin/settings/user/save"); _method "post"; _class "container"
+               _hxTarget "#user_panel"; _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name "Id"; _value model.Id ]
+            div [ _class "row" ] [
+                div [ _class "col-12 col-md-5 col-lg-3 col-xxl-2 offset-xxl-1 mb-3" ] [
+                    div [ _class "form-floating" ] [
+                        select [ _name "AccessLevel"; _id "accessLevel"; _class "form-control"; _required
+                                 _autofocus ] [
+                            levelOption (string Author) "Author"
+                            levelOption (string Editor) "Editor"
+                            levelOption (string WebLogAdmin) "Web Log Admin"
+                            if app.IsAdministrator then levelOption (string Administrator) "Administrator"
+                        ]
+                        label [ _for "accessLevel" ] [ raw "Access Level" ]
+                    ]
+                ]
+                div [ _class "col-12 col-md-7 col-lg-4 col-xxl-3 mb-3" ] [
+                    emailField [ _required ] (nameof model.Email) "E-mail Address" model.Email []
+                ]
+                div [ _class "col-12 col-lg-5 mb-3" ] [
+                    textField [] (nameof model.Url) "User’s Personal URL" model.Url []
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col-12 col-md-6 col-lg-4 col-xl-3 offset-xl-1 pb-3" ] [
+                    textField [ _required ] (nameof model.FirstName) "First Name" model.FirstName []
+                ]
+                div [ _class "col-12 col-md-6 col-lg-4 col-xl-3 pb-3" ] [
+                    textField [ _required ] (nameof model.LastName) "Last Name" model.LastName []
+                ]
+                div [ _class "col-12 col-md-6 offset-md-3 col-lg-4 offset-lg-0 col-xl-3 offset-xl-1 pb-3" ] [
+                    textField [ _required ] (nameof model.PreferredName) "Preferred Name" model.PreferredName []
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col-12 col-xl-10 offset-xl-1" ] [
+                    fieldset [ _class "p-2" ] [
+                        legend [ _class "ps-1" ] [
+                            if not model.IsNew then raw "Change "
+                            raw "Password"
+                        ]
+                        if not model.IsNew then
+                            div [ _class "row" ] [
+                                div [ _class "col" ] [
+                                    p [ _class "form-text" ] [
+                                        raw "Optional; leave blank not change the user’s password"
+                                    ]
+                                ]
+                            ]
+                        div [ _class "row" ] [
+                            let attrs, newLbl = if model.IsNew then [ _required ], "" else [], "New "
+                            div [ _class "col-12 col-md-6 pb-3" ] [
+                                passwordField attrs (nameof model.Password) $"{newLbl}Password" "" []
+                            ]
+                            div [ _class "col-12 col-md-6 pb-3" ] [
+                                passwordField attrs (nameof model.PasswordConfirm) $"Confirm {newLbl}Password" "" []
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col text-center" ] [
+                    saveButton; raw "   "
+                    if model.IsNew then
+                        button [ _type "button"; _class "btn btn-sm btn-secondary ms-3"
+                                 _onclick "document.getElementById('user_new').innerHTML = ''" ] [
+                            raw "Cancel"
+                        ]
+                    else
+                        a [ _href (relUrl app "admin/settings/users"); _class "btn btn-sm btn-secondary ms-3" ] [
+                            raw "Cancel"
+                        ]
+                ]
+            ]
+        ]
+    ]
+    |> List.singleton
+
+
+/// User log on form
+let logOn (model: LogOnModel) (app: AppViewContext) = [
+    h2 [ _class "my-3" ] [ rawText "Log On to "; encodedText app.WebLog.Name ]
+    article [ _class "py-3" ] [
+        form [ _action (relUrl app "user/log-on"); _method "post"; _class "container"; _hxPushUrl "true" ] [
+            antiCsrf app
+            if Option.isSome model.ReturnTo then input [ _type "hidden"; _name "ReturnTo"; _value model.ReturnTo.Value ]
+            div [ _class "row" ] [
+                div [ _class "col-12 col-md-6 col-lg-4 offset-lg-2 pb-3" ] [
+                    emailField [ _required; _autofocus ] (nameof model.EmailAddress) "E-mail Address" "" []
+                ]
+                div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [
+                    passwordField [ _required ] (nameof model.Password) "Password" "" []
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col text-center" ] [
+                    button [ _type "submit"; _class "btn btn-primary" ] [ rawText "Log On" ]
+                ]
+            ]
+        ]
+    ]
+]
+
+
+/// The list of users for a web log (part of web log settings page)
+let userList (model: WebLogUser list) app =
+    let userCol  = "col-12 col-md-4 col-xl-3"
+    let emailCol = "col-12 col-md-4 col-xl-4"
+    let cre8Col  = "d-none d-xl-block col-xl-2"
+    let lastCol  = "col-12 col-md-4 col-xl-3"
+    let badge    = "ms-2 badge bg"
+    let userDetail (user: WebLogUser) =
+        div [ _class "row mwl-table-detail"; _id $"user_{user.Id}" ] [
+            div [ _class $"{userCol} no-wrap" ] [
+                txt user.PreferredName; raw " "
+                match user.AccessLevel with
+                | Administrator -> span [ _class $"{badge}-success"   ] [ raw "ADMINISTRATOR" ]
+                | WebLogAdmin   -> span [ _class $"{badge}-primary"   ] [ raw "WEB LOG ADMIN" ]
+                | Editor        -> span [ _class $"{badge}-secondary" ] [ raw "EDITOR" ]
+                | Author        -> span [ _class $"{badge}-dark"      ] [ raw "AUTHOR" ]
+                br []
+                if app.IsAdministrator || (app.IsWebLogAdmin && not (user.AccessLevel = Administrator)) then
+                    let userUrl = relUrl app $"admin/settings/user/{user.Id}"
+                    small [] [
+                        a [ _href $"{userUrl}/edit"; _hxTarget $"#user_{user.Id}"
+                            _hxSwap $"{HxSwap.InnerHtml} show:#user_{user.Id}:top" ] [
+                            raw "Edit"
+                        ]
+                        if app.UserId.Value <> user.Id then
+                            span [ _class "text-muted" ] [ raw " &bull; " ]
+                            a [ _href userUrl; _hxDelete userUrl; _class "text-danger"
+                                _hxConfirm $"Are you sure you want to delete the user “{user.PreferredName}”? This action cannot be undone. (This action will not succeed if the user has authored any posts or pages.)" ] [
+                                raw "Delete"
+                            ]
+                    ]
+            ]
+            div [ _class emailCol ] [
+                txt $"{user.FirstName} {user.LastName}"; br []
+                small [ _class "text-muted" ] [
+                    txt user.Email
+                    if Option.isSome user.Url then
+                        br []; txt user.Url.Value
+                ]
+            ]
+            div [ _class "d-none d-xl-block col-xl-2" ] [
+                if user.CreatedOn = Noda.epoch then raw "N/A" else longDate app user.CreatedOn
+            ]
+            div [ _class "col-12 col-md-4 col-xl-3" ] [
+                match user.LastSeenOn with
+                | Some it -> longDate app it; raw " at "; shortTime app it
+                | None -> raw "--"
+            ]
+        ]
+    div [ _id "user_panel" ] [
+        a [ _href (relUrl app "admin/settings/user/new/edit"); _class "btn btn-primary btn-sm mb-3"
+            _hxTarget "#user_new" ] [
+            raw "Add a New User"
+        ]
+        div [ _class "container g-0" ] [
+            div [ _class "row mwl-table-heading" ] [
+                div [ _class userCol ] [
+                    raw "User"; span [ _class "d-md-none" ] [ raw "; Full Name / E-mail; Last Log On" ]
+                ]
+                div [ _class $"{emailCol} d-none d-md-inline-block" ] [ raw "Full Name / E-mail" ]
+                div [ _class cre8Col ] [ raw "Created" ]
+                div [ _class $"{lastCol} d-none d-md-block" ] [ raw "Last Log On" ]
+            ]
+        ]
+        div [ _id "userList" ] [
+            div [ _class "container g-0" ] [
+                div [ _class "row mwl-table-detail"; _id "user_new" ] []
+            ]
+            form [ _method "post"; _class "container g-0"; _hxTarget "#user_panel"
+                   _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [
+                antiCsrf app
+                yield! List.map userDetail model
+            ]
+        ]
+    ]
+    |> List.singleton
+
+
+/// Edit My Info form
+let myInfo (model: EditMyInfoModel) (user: WebLogUser) app = [
+    h2 [ _class "my-3" ] [ txt app.PageTitle ]
+    article [] [
+        form [ _action (relUrl app "admin/my-info"); _method "post" ] [
+            antiCsrf app
+            div [ _class "d-flex flex-row flex-wrap justify-content-around" ] [
+                div [ _class "text-center mb-3 lh-sm" ] [
+                    strong [ _class "text-decoration-underline" ] [ raw "Access Level" ]; br []
+                    raw (string user.AccessLevel)
+                ]
+                div [ _class "text-center mb-3 lh-sm" ] [
+                    strong [ _class "text-decoration-underline" ] [ raw "Created" ]; br []
+                    if user.CreatedOn = Noda.epoch then raw "N/A" else longDate app user.CreatedOn
+                ]
+                div [ _class "text-center mb-3 lh-sm" ] [
+                    strong [ _class "text-decoration-underline" ] [ raw "Last Log On" ]; br []
+                    longDate app user.LastSeenOn.Value; raw " at "; shortTime app user.LastSeenOn.Value
+                ]
+            ]
+            div [ _class "container" ] [
+                div [ _class "row" ] [ div [ _class "col" ] [ hr [ _class "mt-0" ] ] ]
+                div [ _class "row mb-3" ] [
+                    div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [
+                        textField [ _required; _autofocus ] (nameof model.FirstName) "First Name" model.FirstName []
+                    ]
+                    div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [
+                        textField [ _required ] (nameof model.LastName) "Last Name" model.LastName []
+                    ]
+                    div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [
+                        textField [ _required ] (nameof model.PreferredName) "Preferred Name" model.PreferredName []
+                    ]
+                ]
+                div [ _class "row mb-3" ] [
+                    div [ _class "col" ] [
+                        fieldset [ _class "p-2" ] [
+                            legend [ _class "ps-1" ] [ raw "Change Password" ]
+                            div [ _class "row" ] [
+                                div [ _class "col" ] [
+                                    p [ _class "form-text" ] [
+                                        raw "Optional; leave blank to keep your current password"
+                                    ]
+                                ]
+                            ]
+                            div [ _class "row" ] [
+                                div [ _class "col-12 col-md-6 pb-3" ] [
+                                    passwordField [] (nameof model.NewPassword) "New Password" "" []
+                                ]
+                                div [ _class "col-12 col-md-6 pb-3" ] [
+                                    passwordField [] (nameof model.NewPasswordConfirm) "Confirm New Password" "" []
+                                ]
+                            ]
+                        ]
+                    ]
+                ]
+                div [ _class "row" ] [ div [ _class "col text-center mb-3" ] [ saveButton ] ]
+            ]
+        ]
+    ]
+]

src/MyWebLog/Views/WebLog.fs

@@ -0,0 +1,895 @@
+module MyWebLog.Views.WebLog
+
+open Giraffe.Htmx.Common
+open Giraffe.ViewEngine
+open Giraffe.ViewEngine.Accessibility
+open Giraffe.ViewEngine.Htmx
+open MyWebLog
+open MyWebLog.ViewModels
+
+/// Form to add or edit a category
+let categoryEdit (model: EditCategoryModel) app =
+    div [ _class "col-12" ] [
+        h5 [ _class "my-3" ] [ raw app.PageTitle ]
+        form [ _action (relUrl app "admin/category/save"); _method "post"; _class "container" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name (nameof model.CategoryId); _value model.CategoryId ]
+            div [ _class "row" ] [
+                div [ _class "col-12 col-sm-6 col-lg-4 col-xxl-3 offset-xxl-1 mb-3" ] [
+                    textField [ _required; _autofocus ] (nameof model.Name) "Name" model.Name []
+                ]
+                div [ _class "col-12 col-sm-6 col-lg-4 col-xxl-3 mb-3" ] [
+                    textField [ _required ] (nameof model.Slug) "Slug" model.Slug []
+                ]
+                div [ _class "col-12 col-lg-4 col-xxl-3 offset-xxl-1 mb-3" ] [
+                    let cats =
+                        app.Categories
+                        |> Seq.ofArray
+                        |> Seq.filter (fun c -> c.Id <> model.CategoryId)
+                        |> Seq.map (fun c ->
+                            let parents =
+                                c.ParentNames
+                                |> Array.map (fun it -> $"{it} &rang; ")
+                                |> String.concat ""
+                            { Name = c.Id; Value = $"{parents}{c.Name}" })
+                        |> Seq.append [ { Name = ""; Value = "&ndash; None &ndash;" } ]
+                    selectField [] (nameof model.ParentId) "Parent Category" model.ParentId cats (_.Name) (_.Value) []
+                ]
+                div [ _class "col-12 col-xl-10 offset-xl-1 mb-3" ] [
+                    textField [] (nameof model.Description) "Description" model.Description []
+                ]
+            ]
+            div [ _class "row mb-3" ] [
+                div [ _class "col text-center" ] [
+                    saveButton
+                    a [ _href (relUrl app "admin/categories"); _class "btn btn-sm btn-secondary ms-3" ] [ raw "Cancel" ]
+                ]
+            ]
+        ]
+    ]
+    |> List.singleton
+
+
+/// Category list page
+let categoryList includeNew app = [
+    let catCol  = "col-12 col-md-6 col-xl-5 col-xxl-4"
+    let descCol = "col-12 col-md-6 col-xl-7 col-xxl-8"
+    let categoryDetail (cat: DisplayCategory) =
+        div [ _class "row mwl-table-detail"; _id $"cat_{cat.Id}" ] [
+            div [ _class $"{catCol} no-wrap" ] [
+                if cat.ParentNames.Length > 0 then
+                    cat.ParentNames
+                    |> Seq.ofArray
+                    |> Seq.map (fun it -> raw $"{it} &rang; ")
+                    |> List.ofSeq
+                    |> small [ _class "text-muted" ]
+                raw cat.Name; br []
+                small [] [
+                    let catUrl = relUrl app $"admin/category/{cat.Id}"
+                    if cat.PostCount > 0 then
+                        a [ _href (relUrl app $"category/{cat.Slug}"); _target "_blank" ] [
+                            raw $"View { cat.PostCount} Post"; if cat.PostCount <> 1 then raw "s"
+                        ]; actionSpacer
+                    a [ _href $"{catUrl}/edit"; _hxTarget $"#cat_{cat.Id}"
+                        _hxSwap $"{HxSwap.InnerHtml} show:#cat_{cat.Id}:top" ] [
+                        raw "Edit"
+                    ]; actionSpacer
+                    a [ _href catUrl; _hxDelete catUrl; _hxTarget "body"; _class "text-danger"
+                        _hxConfirm $"Are you sure you want to delete the category “{cat.Name}”? This action cannot be undone." ] [
+                        raw "Delete"
+                    ]
+                ]
+            ]
+            div [ _class descCol ] [
+                match cat.Description with Some value -> raw value | None -> em [ _class "text-muted" ] [ raw "none" ]
+            ]
+        ]
+    let loadNew =
+        span [ _hxGet (relUrl app "admin/category/new/edit"); _hxTrigger HxTrigger.Load; _hxSwap HxSwap.OuterHtml ] []
+
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        a [ _href (relUrl app "admin/category/new/edit"); _class "btn btn-primary btn-sm mb-3"; _hxTarget "#cat_new" ] [
+            raw "Add a New Category"
+        ]
+        div [ _id "catList"; _class "container" ] [
+            if app.Categories.Length = 0 then
+                if includeNew then loadNew
+                else
+                    div [ _id "cat_new" ] [
+                        p [ _class "text-muted fst-italic text-center" ] [
+                            raw "This web log has no categories defined"
+                        ]
+                    ]
+            else
+                div [ _class "container" ] [
+                    div [ _class "row mwl-table-heading" ] [
+                        div [ _class catCol ] [ raw "Category"; span [ _class "d-md-none" ] [ raw "; Description" ] ]
+                        div [ _class $"{descCol} d-none d-md-inline-block" ] [ raw "Description" ]
+                    ]
+                ]
+                form [ _method "post"; _class "container" ] [
+                    antiCsrf app
+                    div [ _class "row mwl-table-detail"; _id "cat_new" ] [ if includeNew then loadNew ]
+                    yield! app.Categories |> Seq.ofArray |> Seq.map categoryDetail |> List.ofSeq
+                ]
+        ]
+    ]
+]
+
+
+/// The main dashboard
+let dashboard (model: DashboardModel) app = [
+    h2 [ _class "my-3" ] [ txt app.WebLog.Name; raw " &bull; Dashboard" ]
+    article [ _class "container" ] [
+        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" ] [ raw "Posts" ]
+                    div [ _class "card-body" ] [
+                        h6 [ _class "card-subtitle text-muted pb-3" ] [
+                            raw "Published "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Posts) ]
+                            raw "&nbsp; Drafts "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Drafts) ]
+                        ]
+                        if app.IsAuthor then
+                            a [ _href (relUrl app "admin/posts"); _class "btn btn-secondary me-2" ] [ raw "View All" ]
+                            a [ _href (relUrl app "admin/post/new/edit"); _class "btn btn-primary" ] [
+                                raw "Write a New Post"
+                            ]
+                    ]
+                ]
+            ]
+            section [ _class "col-lg-5 col-xl-4 pb-3" ] [
+                div [ _class "card" ] [
+                    header [ _class "card-header text-white bg-primary" ]  [ raw "Pages" ]
+                    div [ _class "card-body" ] [
+                        h6 [ _class "card-subtitle text-muted pb-3" ] [
+                            raw "All "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Pages) ]
+                            raw "&nbsp; Shown in Page List "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.ListedPages) ]
+                        ]
+                        if app.IsAuthor then
+                            a [ _href (relUrl app "admin/pages"); _class "btn btn-secondary me-2" ] [ raw "View All" ]
+                            a [ _href (relUrl app "admin/page/new/edit"); _class "btn btn-primary" ] [
+                                raw "Create a New Page"
+                            ]
+                    ]
+                ]
+            ]
+        ]
+        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" ] [ raw "Categories" ]
+                    div [ _class "card-body" ] [
+                        h6 [ _class "card-subtitle text-muted pb-3"] [
+                            raw "All "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.Categories) ]
+                            raw "&nbsp; Top Level "
+                            span [ _class "badge rounded-pill bg-secondary" ] [ raw (string model.TopLevelCategories) ]
+                        ]
+                        if app.IsWebLogAdmin then
+                            a [ _href (relUrl app "admin/categories"); _class "btn btn-secondary me-2" ] [
+                                raw "View All"
+                            ]
+                            a [ _href (relUrl app "admin/categories?new"); _class "btn btn-secondary" ] [
+                                raw "Add a New Category"
+                            ]
+                    ]
+                ]
+            ]
+        ]
+        if app.IsWebLogAdmin then
+            div [ _class "row pb-3" ] [
+                div [ _class "col text-end" ] [
+                    a [ _href (relUrl app "admin/settings"); _class "btn btn-secondary" ] [ raw "Modify Settings" ]
+                ]
+            ]
+    ]
+]
+
+
+/// Custom RSS feed edit form
+let feedEdit (model: EditCustomFeedModel) (ratings: MetaItem list) (mediums: MetaItem list) app = [
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _action (relUrl app "admin/settings/rss/save"); _method "post"; _class "container" ] [
+            antiCsrf app
+            input [ _type "hidden"; _name "Id"; _value model.Id ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col" ] [
+                    a [ _href (relUrl app "admin/settings#rss-settings") ] [ raw "&laquo; Back to Settings" ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col-12 col-lg-6" ] [
+                    fieldset [ _class "container pb-0" ] [
+                        legend [] [ raw "Identification" ]
+                        div [ _class "row" ] [
+                            div [ _class "col" ] [
+                                textField [ _required ] (nameof model.Path) "Relative Feed Path" model.Path [
+                                  span [ _class "form-text fst-italic" ] [ raw "Appended to "; txt app.WebLog.UrlBase ]
+                                ]
+                            ]
+                        ]
+                        div [ _class "row" ] [
+                            div [ _class "col py-3 d-flex align-self-center justify-content-center" ] [
+                                checkboxSwitch [ _onclick "Admin.checkPodcast()"; if model.IsPodcast then _checked ]
+                                               (nameof model.IsPodcast) "This Is a Podcast Feed" model.IsPodcast []
+                            ]
+                        ]
+                    ]
+                ]
+                div [ _class "col-12 col-lg-6" ] [
+                    fieldset [ _class "container pb-0" ] [
+                        legend [] [ raw "Feed Source" ]
+                        div [ _class "row d-flex align-items-center" ] [
+                            div [ _class "col-1 d-flex justify-content-end pb-3" ] [
+                                div [ _class "form-check form-check-inline me-0" ] [
+                                    input [ _type "radio"; _name (nameof model.SourceType); _id "SourceTypeCat"
+                                            _class "form-check-input"; _value "category"
+                                            if model.SourceType <> "tag" then _checked
+                                            _onclick "Admin.customFeedBy('category')" ]
+                                    label [ _for "SourceTypeCat"; _class "form-check-label d-none" ] [ raw "Category" ]
+                                ]
+                            ]
+                            div [ _class "col-11 pb-3" ] [
+                                let cats =
+                                    app.Categories
+                                    |> Seq.ofArray
+                                    |> Seq.map (fun c ->
+                                        let parents =
+                                            c.ParentNames
+                                            |> Array.map (fun it -> $"{it} &rang; ")
+                                            |> String.concat ""
+                                        { Name = c.Id; Value = $"{parents}{c.Name}" })
+                                    |> Seq.append [ { Name = ""; Value = "&ndash; Select Category &ndash;" } ]
+                                selectField [ _id "SourceValueCat"; _required
+                                              if model.SourceType = "tag" then _disabled ]
+                                            (nameof model.SourceValue) "Category" model.SourceValue cats (_.Name)
+                                            (_.Value) []
+                            ]
+                            div [ _class "col-1 d-flex justify-content-end pb-3" ] [
+                                div [ _class "form-check form-check-inline me-0" ] [
+                                    input [ _type "radio"; _name (nameof model.SourceType); _id "SourceTypeTag"
+                                            _class "form-check-input"; _value "tag"
+                                            if model.SourceType= "tag" then _checked
+                                            _onclick "Admin.customFeedBy('tag')" ]
+                                    label [ _for "sourceTypeTag"; _class "form-check-label d-none" ] [ raw "Tag" ]
+                                ]
+                            ]
+                            div [ _class "col-11 pb-3" ] [
+                                textField [ _id "SourceValueTag"; _required
+                                            if model.SourceType <> "tag" then _disabled ]
+                                          (nameof model.SourceValue) "Tag"
+                                          (if model.SourceType = "tag" then model.SourceValue else "") []
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col" ] [
+                    fieldset [ _class "container"; _id "podcastFields"; if not model.IsPodcast then _disabled ] [
+                        legend [] [ raw "Podcast Settings" ]
+                        div [ _class "row" ] [
+                            div [ _class "col-12 col-md-5 col-lg-4 offset-lg-1 pb-3" ] [
+                                textField [ _required ] (nameof model.Title) "Title" model.Title []
+                            ]
+                            div [ _class "col-12 col-md-4 col-lg-4 pb-3" ] [
+                                textField [] (nameof model.Subtitle) "Podcast Subtitle" model.Subtitle []
+                            ]
+                            div [ _class "col-12 col-md-3 col-lg-2 pb-3" ] [
+                                numberField [ _required ] (nameof model.ItemsInFeed) "# Episodes"
+                                            (string model.ItemsInFeed) []
+                            ]
+                        ]
+                        div [ _class "row" ] [
+                            div [ _class "col-12 col-md-5 col-lg-4 offset-lg-1 pb-3" ] [
+                                textField [ _required ] (nameof model.AppleCategory) "iTunes Category"
+                                          model.AppleCategory [
+                                    span [ _class "form-text fst-italic" ] [
+                                        a [ _href "https://www.thepodcasthost.com/planning/itunes-podcast-categories/"
+                                            _target "_blank"; _relNoOpener ] [
+                                            raw "iTunes Category / Subcategory List"
+                                        ]
+                                    ]
+                                ]
+                            ]
+                            div [ _class "col-12 col-md-4 pb-3" ] [
+                                textField [] (nameof model.AppleSubcategory) "iTunes Subcategory" model.AppleSubcategory
+                                          []
+                            ]
+                            div [ _class "col-12 col-md-3 col-lg-2 pb-3" ] [
+                                selectField [ _required ] (nameof model.Explicit) "Explicit Rating" model.Explicit
+                                            ratings (_.Name) (_.Value) []
+                            ]
+                        ]
+                        div [ _class "row" ] [
+                            div [ _class "col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3" ] [
+                                textField [ _required ] (nameof model.DisplayedAuthor) "Displayed Author"
+                                          model.DisplayedAuthor []
+                            ]
+                            div [ _class "col-12 col-md-6 col-lg-4 pb-3" ] [
+                                emailField [ _required ] (nameof model.Email) "Author E-mail" model.Email [
+                                    span [ _class "form-text fst-italic" ] [
+                                        raw "For iTunes, must match registered e-mail"
+                                    ]
+                                ]
+                            ]
+                            div [ _class "col-12 col-sm-5 col-md-4 col-lg-4 col-xl-3 offset-xl-1 col-xxl-2 offset-xxl-0 pb-3" ] [
+                                textField [] (nameof model.DefaultMediaType) "Default Media Type"
+                                          model.DefaultMediaType [
+                                    span [ _class "form-text fst-italic" ] [ raw "Optional; blank for no default" ]
+                                ]
+                            ]
+                            div [ _class "col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1 pb-3" ] [
+                                textField [ _required ] (nameof model.ImageUrl) "Image URL" model.ImageUrl [
+                                    span [ _class "form-text fst-italic"] [
+                                        raw "Relative URL will be appended to "; txt app.WebLog.UrlBase; raw "/"
+                                    ]
+                                ]
+                            ]
+                        ]
+                        div [ _class "row pb-3" ] [
+                            div [ _class "col-12 col-lg-10 offset-lg-1" ] [
+                                textField [ _required ] (nameof model.Summary) "Summary" model.Summary [
+                                    span [ _class "form-text fst-italic" ] [ raw "Displayed in podcast directories" ]
+                                ]
+                            ]
+                        ]
+                        div [ _class "row pb-3" ] [
+                            div [ _class "col-12 col-lg-10 offset-lg-1" ] [
+                                textField [] (nameof model.MediaBaseUrl) "Media Base URL" model.MediaBaseUrl [
+                                    span [ _class "form-text fst-italic" ] [
+                                        raw "Optional; prepended to episode media file if present"
+                                    ]
+                                ]
+                            ]
+                        ]
+                        div [ _class "row" ] [
+                            div [ _class "col-12 col-lg-5 offset-lg-1 pb-3" ] [
+                                textField [] (nameof model.FundingUrl) "Funding URL" model.FundingUrl [
+                                    span [ _class "form-text fst-italic" ] [
+                                        raw "Optional; URL describing donation options for this podcast, "
+                                        raw "relative URL supported"
+                                    ]
+                                ]
+                            ]
+                            div [ _class "col-12 col-lg-5 pb-3" ] [
+                                textField [ _maxlength "128" ] (nameof model.FundingText) "Funding Text"
+                                          model.FundingText [
+                                    span [ _class "form-text fst-italic" ] [ raw "Optional; text for the funding link" ]
+                                ]
+                            ]
+                        ]
+                        div [ _class "row pb-3" ] [
+                            div [ _class "col-8 col-lg-5 offset-lg-1 pb-3" ] [
+                                textField [] (nameof model.PodcastGuid) "Podcast GUID" model.PodcastGuid [
+                                    span [ _class "form-text fst-italic" ] [
+                                        raw "Optional; v5 UUID uniquely identifying this podcast; "
+                                        raw "once entered, do not change this value ("
+                                        a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid"
+                                            _target "_blank"; _relNoOpener ] [
+                                            raw "documentation"
+                                        ]; raw ")"
+                                    ]
+                                ]
+                            ]
+                            div [ _class "col-4 col-lg-3 offset-lg-2 pb-3" ] [
+                                selectField [] (nameof model.Medium) "Medium" model.Medium mediums (_.Name) (_.Value) [
+                                    span [ _class "form-text fst-italic" ] [
+                                        raw "Optional; medium of the podcast content ("
+                                        a [ _href "https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
+                                            _target "_blank"; _relNoOpener ] [
+                                            raw "documentation"
+                                        ]; raw ")"
+                                    ]
+                                ]
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [ div [ _class "col text-center" ] [ saveButton ] ]
+        ]
+    ]
+]
+
+
+/// Redirect Rule edit form
+let redirectEdit (model: EditRedirectRuleModel) app = [
+    let url = relUrl app $"admin/settings/redirect-rules/{model.RuleId}"
+    h3 [] [ raw (if model.RuleId < 0 then "Add" else "Edit"); raw " Redirect Rule" ]
+    form [ _action url; _hxPost url; _hxTarget "body"; _method "post"; _class "container" ] [
+        antiCsrf app
+        input [ _type "hidden"; _name "RuleId"; _value (string model.RuleId) ]
+        div [ _class "row" ] [
+            div [ _class "col-12 col-lg-5 mb-3" ] [
+                textField [ _autofocus; _required ] (nameof model.From) "From" model.From [
+                    span [ _class "form-text" ] [ raw "From local URL/pattern" ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-5 mb-3" ] [
+                textField [ _required ] (nameof model.To) "To" model.To [
+                    span [ _class "form-text" ] [ raw "To URL/pattern" ]
+                ]
+            ]
+            div [ _class "col-12 col-lg-2 mb-3" ] [
+                checkboxSwitch [] (nameof model.IsRegex) "Use RegEx" model.IsRegex []
+            ]
+        ]
+        if model.RuleId < 0 then
+            div [ _class "row mb-3" ] [
+                div [ _class "col-12 text-center" ] [
+                    label [ _class "me-1" ] [ raw "Add Rule" ]
+                    div [ _class "btn-group btn-group-sm"; _roleGroup; _ariaLabel "New rule placement button group" ] [
+                        input [ _type "radio"; _name "InsertAtTop"; _id "at_top"; _class "btn-check"; _value "true" ]
+                        label [ _class "btn btn-sm btn-outline-secondary"; _for "at_top" ] [ raw "Top" ]
+                        input [ _type "radio"; _name "InsertAtTop"; _id "at_bot"; _class "btn-check"; _value "false"
+                                _checked ]
+                        label [ _class "btn btn-sm btn-outline-secondary"; _for "at_bot" ] [ raw "Bottom" ]
+                    ]
+                ]
+            ]
+        div [ _class "row mb-3" ] [
+            div [ _class "col text-center" ] [
+                saveButton; raw " &nbsp; "
+                a [ _href (relUrl app "admin/settings/redirect-rules"); _class "btn btn-sm btn-secondary ms-3" ] [
+                    raw "Cancel"
+                ]
+            ]
+        ]
+    ]
+]
+
+
+/// The list of current redirect rules
+let redirectList (model: RedirectRule list) app = [
+    // Generate the detail for a redirect rule
+    let ruleDetail idx (rule: RedirectRule) =
+        let ruleId = $"rule_{idx}"
+        div [ _class "row mwl-table-detail"; _id ruleId ] [
+            div [ _class "col-5 no-wrap" ] [
+                txt rule.From; br []
+                small [] [
+                    let ruleUrl = relUrl app $"admin/settings/redirect-rules/{idx}"
+                    a [ _href ruleUrl; _hxTarget $"#{ruleId}"; _hxSwap $"{HxSwap.InnerHtml} show:#{ruleId}:top" ] [
+                        raw "Edit"
+                    ]
+                    if idx > 0 then
+                        actionSpacer; a [ _href $"{ruleUrl}/up"; _hxPost $"{ruleUrl}/up" ] [ raw "Move Up" ]
+                    if idx <> model.Length - 1 then
+                        actionSpacer; a [ _href $"{ruleUrl}/down"; _hxPost $"{ruleUrl}/down" ] [ raw "Move Down" ]
+                    actionSpacer
+                    a [ _class "text-danger"; _href ruleUrl; _hxDelete ruleUrl
+                        _hxConfirm "Are you sure you want to delete this redirect rule?" ] [
+                        raw "Delete"
+                    ]
+                ]
+            ]
+            div [ _class "col-5" ] [ txt rule.To ]
+            div [ _class "col-2 text-center" ] [ yesOrNo rule.IsRegex ]
+        ]
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        p [ _class "mb-3" ] [
+            a [ _href (relUrl app "admin/settings") ] [ raw "&laquo; Back to Settings" ]
+        ]
+        div [ _class "container" ] [
+            p [] [
+                a [ _href (relUrl app "admin/settings/redirect-rules/-1"); _class "btn btn-primary btn-sm mb-3"
+                    _hxTarget "#rule_new" ] [
+                    raw "Add Redirect Rule"
+                ]
+            ]
+            if List.isEmpty model then
+                div [ _id "rule_new" ] [
+                    p [ _class "text-muted text-center fst-italic" ] [
+                        raw "This web log has no redirect rules defined"
+                    ]
+                ]
+            else
+                div [ _class "container g-0" ] [
+                    div [ _class "row mwl-table-heading" ] [
+                        div [ _class "col-5" ] [ raw "From" ]
+                        div [ _class "col-5" ] [ raw "To" ]
+                        div [ _class "col-2 text-center" ] [ raw "RegEx?" ]
+                    ]
+                ]
+                div [ _class "row mwl-table-detail"; _id "rule_new" ] []
+                form [ _method "post"; _class "container g-0"; _hxTarget "body" ] [
+                    antiCsrf app; yield! List.mapi ruleDetail model
+                ]
+        ]
+        p [ _class "mt-3 text-muted fst-italic text-center" ] [
+            raw "This is an advanced feature; please "
+            a [ _href "https://bitbadger.solutions/open-source/myweblog/advanced.html#redirect-rules"
+                _target "_blank" ] [
+                raw "read and understand the documentation on this feature"
+            ]
+            raw " before adding rules."
+        ]
+    ]
+]
+
+
+/// Edit a tag mapping
+let tagMapEdit (model: EditTagMapModel) app = [
+    h5 [ _class "my-3" ] [ txt app.PageTitle ]
+    form [ _hxPost (relUrl app "admin/settings/tag-mapping/save"); _method "post"; _class "container"
+           _hxTarget "#tagList"; _hxSwap $"{HxSwap.OuterHtml} show:window:top" ] [
+        antiCsrf app
+        input [ _type "hidden"; _name "Id"; _value model.Id ]
+        div [ _class "row mb-3" ] [
+            div [ _class "col-6 col-lg-4 offset-lg-2" ] [
+                textField [ _autofocus; _required ] (nameof model.Tag) "Tag" model.Tag []
+            ]
+            div [ _class "col-6 col-lg-4" ] [
+                textField [ _required ] (nameof model.UrlValue) "URL Value" model.UrlValue []
+            ]
+        ]
+        div [ _class "row mb-3" ] [
+            div [ _class "col text-center" ] [
+                saveButton; raw " &nbsp; "
+                a [ _href (relUrl app "admin/settings/tag-mappings"); _class "btn btn-sm btn-secondary ms-3" ] [
+                    raw "Cancel"
+                ]
+            ]
+        ]
+    ]
+]
+
+
+/// Display a list of the web log's current tag mappings
+let tagMapList (model: TagMap list) app =
+    let tagMapDetail (map: TagMap) =
+        let url = relUrl app $"admin/settings/tag-mapping/{map.Id}"
+        div [ _class "row mwl-table-detail"; _id $"tag_{map.Id}" ] [
+            div [ _class "col no-wrap" ] [
+                txt map.Tag; br []
+                small [] [
+                    a [ _href $"{url}/edit"; _hxTarget $"#tag_{map.Id}"
+                        _hxSwap $"{HxSwap.InnerHtml} show:#tag_{map.Id}:top" ] [
+                        raw "Edit"
+                    ]; actionSpacer
+                    a [ _href url; _hxDelete url; _class "text-danger"
+                        _hxConfirm $"Are you sure you want to delete the mapping for “{map.Tag}”? This action cannot be undone." ] [
+                        raw "Delete"
+                    ]
+                ]
+            ]
+            div [ _class "col" ] [ txt map.UrlValue ]
+        ]
+    div [ _id "tagList"; _class "container" ] [
+        if List.isEmpty model then
+            div [ _id "tag_new" ] [
+                p [ _class "text-muted text-center fst-italic" ] [ raw "This web log has no tag mappings" ]
+            ]
+        else
+            div [ _class "container g-0" ] [
+                div [ _class "row mwl-table-heading" ] [
+                    div [ _class "col" ] [ raw "Tag" ]
+                    div [ _class "col" ] [ raw "URL Value" ]
+                ]
+            ]
+            form [ _method "post"; _class "container g-0"; _hxTarget "#tagList"; _hxSwap HxSwap.OuterHtml ] [
+                antiCsrf app
+                div [ _class "row mwl-table-detail"; _id "tag_new" ] []
+                yield! List.map tagMapDetail model
+            ]
+    ]
+    |> List.singleton
+
+
+/// The list of uploaded files for a web log
+let uploadList (model: DisplayUpload seq) app = [
+    let webLogBase = $"upload/{app.WebLog.Slug}/"
+    let relativeBase = relUrl app $"upload/{app.WebLog.Slug}/"
+    let absoluteBase = app.WebLog.AbsoluteUrl(Permalink webLogBase)
+    let uploadDetail (upload: DisplayUpload) =
+        div [ _class "row mwl-table-detail" ] [
+            div [ _class "col-6" ] [
+                let badgeClass = if upload.Source = string Disk then "secondary" else "primary"
+                let pathAndName = $"{upload.Path}{upload.Name}"
+                span [ _class $"badge bg-{badgeClass} text-uppercase float-end mt-1" ] [ raw upload.Source ]
+                raw upload.Name; br []
+                small [] [
+                    a [ _href $"{relativeBase}{pathAndName}"; _target "_blank" ] [ raw "View File" ]
+                    actionSpacer; span [ _class "text-muted" ] [ raw "Copy " ]
+                    a [ _href $"{absoluteBase}{pathAndName}"; _hxNoBoost
+                        _onclick $"return Admin.copyText('{absoluteBase}{pathAndName}', this)" ] [
+                        raw "Absolute"
+                    ]
+                    span [ _class "text-muted" ] [ raw " | " ]
+                    a [ _href $"{relativeBase}{pathAndName}"; _hxNoBoost
+                        _onclick $"return Admin.copyText('{relativeBase}{pathAndName}', this)" ] [
+                        raw "Relative"
+                    ]
+                    if app.WebLog.ExtraPath <> "" then
+                        span [ _class "text-muted" ] [ raw " | " ]
+                        a [ _href $"{webLogBase}{pathAndName}"; _hxNoBoost
+                            _onclick $"return Admin.copyText('/{webLogBase}{pathAndName}', this)" ] [
+                            raw "For Post"
+                        ]
+                    span [ _class "text-muted" ] [ raw " Link" ]
+                    if app.IsWebLogAdmin then
+                        actionSpacer
+                        let deleteUrl =
+                            if upload.Source = string "Disk" then $"admin/upload/disk/{pathAndName}"
+                            else $"admin/upload/{upload.Id}"
+                            |> relUrl app
+                        a [ _href deleteUrl; _hxDelete deleteUrl; _class "text-danger"
+                            _hxConfirm $"Are you sure you want to delete {upload.Name}? This action cannot be undone." ] [
+                            raw "Delete"
+                        ]
+                ]
+            ]
+            div [ _class "col-3" ] [ raw upload.Path ]
+            div [ _class "col-3" ] [
+                match upload.UpdatedOn with
+                | Some updated -> updated.ToString("yyyy-MM-dd/h:mmtt").ToLowerInvariant()
+                | None -> "--"
+                |> raw
+            ]
+        ]
+
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        a [ _href (relUrl app "admin/upload/new"); _class "btn btn-primary btn-sm mb-3" ] [ raw "Upload a New File" ]
+        form [ _method "post"; _class "container"; _hxTarget "body" ] [
+            antiCsrf app
+            div [ _class "row" ] [
+                div [ _class "col text-center" ] [
+                    em [ _class "text-muted" ] [ raw "Uploaded files served from" ]; br []; raw relativeBase
+                ]
+            ]
+            if Seq.isEmpty model then
+                div [ _class "row" ] [
+                    div [ _class "col text-muted fst-italic text-center" ] [
+                        br []; raw "This web log has uploaded files"
+                    ]
+                ]
+            else
+                div [ _class "row mwl-table-heading" ] [
+                    div [ _class "col-6" ] [ raw "File Name" ]
+                    div [ _class "col-3" ] [ raw "Path" ]
+                    div [ _class "col-3" ] [ raw "File Date/Time" ]
+                ]
+                yield! model |> Seq.map uploadDetail
+        ]
+    ]
+]
+
+
+/// Form to upload a new file
+let uploadNew app = [
+    h2 [ _class "my-3" ] [ raw app.PageTitle ]
+    article [] [
+        form [ _action (relUrl app "admin/upload/save"); _method "post"; _class "container"
+               _enctype "multipart/form-data"; _hxNoBoost ] [
+            antiCsrf app
+            div [ _class "row" ] [
+                div [ _class "col-12 col-md-6 pb-3" ] [
+                    div [ _class "form-floating" ] [
+                        input [ _type "file"; _id "file"; _name "File"; _class "form-control"; _placeholder "File"
+                                _required ]
+                        label [ _for "file" ] [ raw "File to Upload" ]
+                    ]
+                ]
+                div [ _class "col-12 col-md-6 pb-3 d-flex align-self-center justify-content-around" ] [
+                    div [ _class "text-center" ] [
+                        raw "Destination"; br []
+                        div [ _class "btn-group"; _roleGroup; _ariaLabel "Upload destination button group" ] [
+                            input [ _type "radio"; _name "Destination"; _id "destination_db"; _class "btn-check"
+                                    _value (string Database); if app.WebLog.Uploads = Database then _checked ]
+                            label [ _class "btn btn-outline-primary"; _for "destination_db" ] [ raw (string Database) ]
+                            input [ _type "radio"; _name "Destination"; _id "destination_disk"; _class "btn-check"
+                                    _value (string Disk); if app.WebLog.Uploads= Disk then _checked ]
+                            label [ _class "btn btn-outline-secondary"; _for "destination_disk" ] [ raw "Disk" ]
+                        ]
+                    ]
+                ]
+            ]
+            div [ _class "row pb-3" ] [
+                div [ _class "col text-center" ] [
+                    button [ _type "submit"; _class "btn btn-primary" ] [ raw "Upload File" ]
+                ]
+            ]
+        ]
+    ]
+]
+
+
+/// Web log settings page
+let webLogSettings
+        (model: SettingsModel) (themes: Theme list) (pages: Page list) (uploads: UploadDestination list)
+        (rss: EditRssModel) (app: AppViewContext) = [
+    let feedDetail (feed: CustomFeed) =
+        let source =
+            match feed.Source with
+            | Category (CategoryId catId) ->
+                app.Categories
+                |> Array.tryFind (fun cat -> cat.Id = catId)
+                |> Option.map _.Name
+                |> Option.defaultValue "--INVALID; DELETE THIS FEED--"
+                |> sprintf "Category: %s"
+            | Tag tag -> $"Tag: {tag}"
+        div [ _class "row mwl-table-detail" ] [
+            div [ _class "col-12 col-md-6" ] [
+                txt source
+                if Option.isSome feed.Podcast then
+                    raw " &nbsp; "; span [ _class "badge bg-primary" ] [ raw "PODCAST" ]
+                br []
+                small [] [
+                    let feedUrl = relUrl app $"admin/settings/rss/{feed.Id}"
+                    a [ _href (relUrl app (string feed.Path)); _target "_blank" ] [ raw "View Feed" ]
+                    actionSpacer
+                    a [ _href $"{feedUrl}/edit" ] [ raw "Edit" ]; actionSpacer
+                    a [ _href feedUrl; _hxDelete feedUrl; _class "text-danger"
+                        _hxConfirm $"Are you sure you want to delete the custom RSS feed based on {feed.Source}? This action cannot be undone." ] [
+                        raw "Delete"
+                    ]
+                ]
+            ]
+            div [ _class "col-12 col-md-6" ] [
+                small [ _class "d-md-none" ] [ raw "Served at "; txt (string feed.Path) ]
+                span [ _class "d-none d-md-inline" ] [ txt (string feed.Path) ]
+            ]
+        ]
+
+    h2 [ _class "my-3" ] [ txt app.WebLog.Name; raw " Settings" ]
+    article [] [
+        p [ _class "text-muted" ] [
+            raw "Go to: "; a [ _href "#users" ] [ raw "Users" ]; raw " &bull; "
+            a [ _href "#rss-settings" ] [ raw "RSS Settings" ]; raw " &bull; "
+            a [ _href "#tag-mappings" ] [ raw "Tag Mappings" ]; raw " &bull; "
+            a [ _href (relUrl app "admin/settings/redirect-rules") ] [ raw "Redirect Rules" ]
+        ]
+        fieldset [ _class "container mb-3" ] [
+            legend [] [ raw "Web Log Settings" ]
+            form [ _action (relUrl app "admin/settings"); _method "post" ] [
+                antiCsrf app
+                div [ _class "container g-0" ] [
+                    div [ _class "row" ] [
+                        div [ _class "col-12 col-md-6 col-xl-4 pb-3" ] [
+                            textField [ _required; _autofocus ] (nameof model.Name) "Name" model.Name []
+                        ]
+                        div [ _class "col-12 col-md-6 col-xl-4 pb-3" ] [
+                            textField [ _required ] (nameof model.Slug) "Slug" model.Slug [
+                                span [ _class "form-text" ] [
+                                    span [ _class "badge rounded-pill bg-warning text-dark" ] [ raw "WARNING" ]
+                                    raw " changing this value may break links ("
+                                    a [ _href "https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings"
+                                        _target "_blank" ] [
+                                            raw "more"
+                                    ]; raw ")"
+                                ]
+                            ]
+                        ]
+                        div [ _class "col-12 col-md-6 col-xl-4 pb-3" ] [
+                            textField [] (nameof model.Subtitle) "Subtitle" model.Subtitle []
+                        ]
+                        div [ _class "col-12 col-md-6 col-xl-4 offset-xl-1 pb-3" ] [
+                            selectField [ _required ] (nameof model.ThemeId) "Theme" model.ThemeId themes
+                                        (fun t -> string t.Id) (fun t -> $"{t.Name} (v{t.Version})") []
+                        ]
+                        div [ _class "col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3" ] [
+                            selectField [ _required ] (nameof model.DefaultPage) "Default Page" model.DefaultPage pages
+                                        (fun p -> string p.Id) (_.Title) []
+                        ]
+                        div [ _class "col-12 col-md-4 col-xl-2 pb-3" ] [
+                            numberField [ _required; _min "0"; _max "50" ] (nameof model.PostsPerPage) "Posts per Page"
+                                        (string model.PostsPerPage) []
+                        ]
+                    ]
+                    div [ _class "row" ] [
+                        div [ _class "col-12 col-md-4 col-xl-3 offset-xl-2 pb-3" ] [
+                            textField [ _required ] (nameof model.TimeZone) "Time Zone" model.TimeZone []
+                        ]
+                        div [ _class "col-12 col-md-4 col-xl-2" ] [
+                            checkboxSwitch [] (nameof model.AutoHtmx) "Auto-Load htmx" model.AutoHtmx []
+                            span [ _class "form-text fst-italic" ] [
+                                a [ _href "https://htmx.org"; _target "_blank"; _relNoOpener ] [ raw "What is this?" ]
+                            ]
+                        ]
+                        div [ _class "col-12 col-md-4 col-xl-3 pb-3" ] [
+                            selectField [] (nameof model.Uploads) "Default Upload Destination" model.Uploads uploads
+                                        string string []
+                        ]
+                    ]
+                    div [ _class "row pb-3" ] [
+                        div [ _class "col text-center" ] [
+                            button [ _type "submit"; _class "btn btn-primary" ] [ raw "Save Changes" ]
+                        ]
+                    ]
+                ]
+            ]
+        ]
+        fieldset [ _id "users"; _class "container mb-3 pb-0" ] [
+            legend [] [ raw "Users" ]
+            span [ _hxGet (relUrl app "admin/settings/users"); _hxTrigger HxTrigger.Load; _hxSwap HxSwap.OuterHtml ] []
+        ]
+        fieldset [ _id "rss-settings"; _class "container mb-3 pb-0" ] [
+            legend [] [ raw "RSS Settings" ]
+            form [ _action (relUrl app "admin/settings/rss"); _method "post"; _class "container g-0" ] [
+                antiCsrf app
+                div [ _class "row pb-3" ] [
+                    div [ _class "col col-xl-8 offset-xl-2" ] [
+                        fieldset [ _class "d-flex justify-content-evenly flex-row" ] [
+                            legend [] [ raw "Feeds Enabled" ]
+                            checkboxSwitch [] (nameof rss.IsFeedEnabled) "All Posts" rss.IsFeedEnabled []
+                            checkboxSwitch [] (nameof rss.IsCategoryEnabled) "Posts by Category" rss.IsCategoryEnabled
+                                           []
+                            checkboxSwitch [] (nameof rss.IsTagEnabled) "Posts by Tag" rss.IsTagEnabled []
+                        ]
+                    ]
+                ]
+                div [ _class "row" ] [
+                    div [ _class "col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3" ] [
+                        textField [] (nameof rss.FeedName) "Feed File Name" rss.FeedName [
+                            span [ _class "form-text" ] [ raw "Default is "; code [] [ raw "feed.xml" ] ]
+                        ]
+                    ]
+                    div [ _class "col-12 col-sm-6 col-md-4 col-xl-2 pb-3" ] [
+                        numberField [ _required; _min "0" ] (nameof rss.ItemsInFeed) "Items in Feed"
+                                    (string rss.ItemsInFeed) [
+                            span [ _class "form-text" ] [
+                                raw "Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ("
+                                raw (string app.WebLog.PostsPerPage); raw ")"
+                            ]
+                        ]
+                    ]
+                    div [ _class "col-12 col-md-5 col-xl-4 pb-3" ] [
+                        textField [] (nameof rss.Copyright) "Copyright String" rss.Copyright [
+                            span [ _class "form-text" ] [
+                                raw "Can be a "
+                                a [ _href "https://creativecommons.org/share-your-work/"; _target "_blank"
+                                    _relNoOpener ] [
+                                    raw "Creative Commons license string"
+                                ]
+                            ]
+                        ]
+                    ]
+                ]
+                div [ _class "row pb-3" ] [
+                    div [ _class "col text-center" ] [
+                        button [ _type "submit"; _class "btn btn-primary" ] [ raw "Save Changes" ]
+                    ]
+                ]
+            ]
+            fieldset [ _class "container mb-3 pb-0" ] [
+                legend [] [ raw "Custom Feeds" ]
+                a [ _class "btn btn-sm btn-secondary"; _href (relUrl app "admin/settings/rss/new/edit") ] [
+                    raw "Add a New Custom Feed"
+                ]
+                if app.WebLog.Rss.CustomFeeds.Length = 0 then
+                    p [ _class "text-muted fst-italic text-center" ] [ raw "No custom feeds defined" ]
+                else
+                    form [ _method "post"; _class "container g-0"; _hxTarget "body" ] [
+                        antiCsrf app
+                        div [ _class "row mwl-table-heading" ] [
+                            div [ _class "col-12 col-md-6" ] [
+                                span [ _class "d-md-none" ] [ raw "Feed" ]
+                                span [ _class "d-none d-md-inline" ] [ raw "Source" ]
+                            ]
+                            div [ _class "col-12 col-md-6 d-none d-md-inline-block" ] [ raw "Relative Path" ]
+                        ]
+                        yield! app.WebLog.Rss.CustomFeeds |> List.map feedDetail
+                    ]
+            ]
+        ]
+        fieldset [ _id "tag-mappings"; _class "container mb-3 pb-0" ] [
+            legend [] [ raw "Tag Mappings" ]
+            a [ _href (relUrl app "admin/settings/tag-mapping/new/edit"); _class "btn btn-primary btn-sm mb-3"
+                _hxTarget "#tag_new" ] [
+                raw "Add a New Tag Mapping"
+            ]
+            span [ _hxGet (relUrl app "admin/settings/tag-mappings"); _hxTrigger HxTrigger.Load
+                   _hxSwap HxSwap.OuterHtml ] []
+        ]
+    ]
+]

src/MyWebLog/appsettings.json

@@ -1,8 +1,15 @@
 {
-  "Generator": "myWebLog 2.0-beta05",
+  "Generator": "myWebLog 2.1.1",
   "Logging": {
     "LogLevel": {
       "MyWebLog.Handlers": "Information"
     }
+  },
+  "Kestrel": {
+    "Endpoints": {
+      "Http": {
+        "Url": "http://0.0.0.0:80"
+      }
+    }
   }
 }

src/admin-theme/_layout.liquid

@@ -1,64 +0,0 @@
-<header>
-  <nav class="navbar navbar-dark bg-dark navbar-expand-md justify-content-start px-2 position-fixed top-0 w-100">
-    <div class="container-fluid">
-      <a class="navbar-brand" href="{{ "" | relative_link }}" hx-boost="false">{{ 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 is_logged_on -%}
-          <ul class="navbar-nav">
-            {{ "admin/dashboard" | nav_link: "Dashboard" }}
-            {% if is_author %}
-              {{ "admin/pages" | nav_link: "Pages" }}
-              {{ "admin/posts" | nav_link: "Posts" }}
-              {{ "admin/uploads" | nav_link: "Uploads" }}
-            {% endif %}
-            {% if is_web_log_admin %}
-              {{ "admin/categories" | nav_link: "Categories" }}
-              {{ "admin/users" | nav_link: "Users" }}
-              {{ "admin/settings" | nav_link: "Settings" }}
-            {% endif %}
-          </ul>
-        {%- endif %}
-        <ul class="navbar-nav flex-grow-1 justify-content-end">
-          {% if is_logged_on -%}
-            {{ "admin/user/my-info" | nav_link: "My Info" }}
-            <li class="nav-item">
-              <a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
-            </li>
-          {%- else -%}
-            {{ "user/log-on" | nav_link: "Log On" }}
-          {%- endif %}
-        </ul>
-      </div>
-    </div>
-  </nav>
-</header>
-<main class="mx-3 mt-3">
-  <div class="messages mt-2" id="msgContainer">
-    {% 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>
-          {{ msg.detail.value }}
-        {% endif %}
-      </div>
-    {% endfor %}
-  </div>
-  {{ content }}
-</main>
-<footer class="position-fixed bottom-0 w-100">
-  <div class="container-fluid">
-    <div class="row">
-      <div class="col-xs-12 text-end">
-        {%- assign version = generator | split: " " -%}
-        <small class="me-1 align-baseline">v{{ version[1] }}</small>
-        <img src="{{ "themes/admin/logo-light.png" | relative_link }}" alt="myWebLog" width="120" height="34">
-      </div>
-    </div>
-  </div>
-</footer>

src/admin-theme/category-edit.liquid

@@ -1,54 +0,0 @@
-<div class="col-12">
-  <h5 class="my-3">{{ page_title }}</h5>
-  <form hx-post="{{ "admin/category/save" | relative_link }}" method="post" class="container"
-        hx-target="#catList" hx-swap="outerHTML show:window:top">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <input type="hidden" name="CategoryId" value="{{ model.category_id }}">
-      <div class="row">
-        <div class="col-12 col-sm-6 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
-          <div class="form-floating">
-            <input type="text" name="Name" id="name" class="form-control form-control-sm" placeholder="Name" autofocus
-                   required value="{{ model.name | escape }}">
-            <label for="name">Name</label>
-          </div>
-        </div>
-        <div class="col-12 col-sm-6 col-lg-4 col-xxl-3 mb-3">
-          <div class="form-floating">
-            <input type="text" name="Slug" id="slug" class="form-control form-control-sm" placeholder="Slug" required
-                   value="{{ model.slug | escape }}">
-            <label for="slug">Slug</label>
-          </div>
-        </div>
-        <div class="col-12 col-lg-4 col-xxl-3 offset-xxl-1 mb-3">
-          <div class="form-floating">
-            <select name="ParentId" id="parentId" class="form-control form-control-sm">
-              <option value=""{% if model.parent_id == "" %} selected="selected"{% endif %}>
-                &ndash; None &ndash;
-              </option>
-              {% for cat in categories -%}
-                {%- unless cat.id == model.category_id %}
-                  <option value="{{ cat.id }}"{% if model.parent_id == cat.id %} selected="selected"{% endif %}>
-                    {% for it in cat.parent_names %} &nbsp; &raquo; {% endfor %}{{ cat.name }}
-                  </option>
-                {% endunless -%}
-              {%- endfor %}
-            </select>
-            <label for="parentId">Parent Category</label>
-          </div>
-        </div>
-        <div class="col-12 col-xl-10 offset-xl-1 mb-3">
-          <div class="form-floating">
-            <input name="Description" id="description" class="form-control form-control-sm"
-                   placeholder="A short description of this category" value="{{ model.description | escape }}">
-            <label for="description">Description</label>
-          </div>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col text-center">
-          <button type="submit" class="btn btn-sm btn-primary">Save Changes</button>
-          <a href="{{ "admin/categories/bare" | relative_link }}" class="btn btn-sm btn-secondary ms-3">Cancel</a>
-        </div>
-      </div>
-  </form>
-</div>

src/admin-theme/category-list-body.liquid

@@ -1,45 +0,0 @@
-<form method="post" id="catList" class="container" hx-target="this" hx-swap="outerHTML show:window:top">
-  <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-  <div class="row mwl-table-detail" id="cat_new"></div>
-  {%- assign cat_count = categories | size -%}
-  {% if cat_count > 0 %}
-    {%- assign cat_col  = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
-    {%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
-    {% for cat in categories -%}
-      <div class="row mwl-table-detail" id="cat_{{ cat.id }}">
-        <div class="{{ cat_col }} no-wrap">
-          {%- if cat.parent_names %}
-            <small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small>
-          {%- endif %}
-          {{ cat.name }}<br>
-          <small>
-            {%- assign cat_url_base = "admin/category/" | append: cat.id -%}
-            {%- if cat.post_count > 0 %}
-              <a href="{{ cat | category_link }}" target="_blank">
-                View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
-              </a>
-              <span class="text-muted"> &bull; </span>
-            {%- endif %}
-            <a href="{{ cat_url_base | append: "/edit" | relative_link }}" hx-target="#cat_{{ cat.id }}"
-               hx-swap="innerHTML show:#cat_{{ cat.id }}:top">
-              Edit
-            </a>
-            <span class="text-muted"> &bull; </span>
-            {%- assign cat_del_link = cat_url_base | append: "/delete" | relative_link -%}
-            <a href="{{ cat_del_link }}" hx-post="{{ cat_del_link }}" class="text-danger"
-               hx-confirm="Are you sure you want to delete the category &ldquo;{{ cat.name }}&rdquo;? This action cannot be undone.">
-              Delete
-            </a>
-          </small>
-        </div>
-        <div class="{{ desc_col }}">
-          {%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
-        </div>
-      </div>
-    {%- endfor %}
-  {%- else -%}
-    <div class="row">
-      <div class="col-12 text-muted fst-italic text-center">This web log has no categores defined</div>
-    </div>
-  {%- endif %}
-</form>

src/admin-theme/category-list.liquid

@@ -1,16 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
-     hx-target="#cat_new">
-    Add a New Category
-  </a>
-  <div class="container">
-    {%- assign cat_col  = "col-12 col-md-6 col-xl-5 col-xxl-4" -%}
-    {%- assign desc_col = "col-12 col-md-6 col-xl-7 col-xxl-8" -%}
-    <div class="row mwl-table-heading">
-      <div class="{{ cat_col }}">Category<span class="d-md-none">; Description</span></div>
-      <div class="{{ desc_col }} d-none d-md-inline-block">Description</div>
-    </div>
-  </div>
-  {{ category_list }}
-</article>

src/admin-theme/custom-feed-edit.liquid

@@ -1,259 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <form action="{{ "admin/settings/rss/save" | relative_link }}" method="post">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <input type="hidden" name="Id" value="{{ model.id }}">
-    {%- assign typ = model.source_type -%}
-    <div class="container">
-      <div class="row pb-3">
-        <div class="col">
-          <a href="{{ "admin/settings/rss" | relative_link }}">&laquo; Back to RSS Settings</a>
-        </div>
-      </div>
-      <div class="row pb-3">
-        <div class="col-12 col-lg-6">
-          <fieldset class="container pb-0">
-            <legend>Identification</legend>
-            <div class="row">
-              <div class="col">
-                <div class="form-floating">
-                  <input type="text" name="Path" id="path" class="form-control" placeholder="Relative Feed Path"
-                         value="{{ model.path }}">
-                  <label for="path">Relative Feed Path</label>
-                  <span class="form-text fst-italic">Appended to {{ web_log.url_base }}/</span>
-                </div>
-              </div>
-            </div>
-            <div class="row">
-              <div class="col py-3 d-flex align-self-center justify-content-center">
-                <div class="form-check form-switch">
-                  <input type="checkbox" name="IsPodcast" id="isPodcast" class="form-check-input" value="true"
-                      {%- if model.is_podcast %} checked="checked"{% endif %} onclick="Admin.checkPodcast()">
-                  <label for="isPodcast" class="form-check-label">This Is a Podcast Feed</label>
-                </div>
-              </div>
-            </div>
-          </fieldset>
-        </div>
-        <div class="col-12 col-lg-6">
-          <fieldset class="container pb-0">
-            <legend>Feed Source</legend>
-            <div class="row d-flex align-items-center">
-              <div class="col-1 d-flex justify-content-end pb-3">
-                <div class="form-check form-check-inline me-0">
-                  <input type="radio" name="SourceType" id="sourceTypeCat" class="form-check-input" value="category"
-                         {%- unless typ == "tag" %} checked="checked" {% endunless -%}
-                         onclick="Admin.customFeedBy('category')">
-                  <label for="sourceTypeCat" class="form-check-label d-none">Category</label>
-                </div>
-              </div>
-              <div class="col-11 pb-3">
-                <div class="form-floating">
-                  <select name="SourceValue" id="sourceValueCat" class="form-control" required
-                          {%- if typ == "tag" %} disabled="disabled"{% endif %}>
-                    <option value="">&ndash; Select Category &ndash;</option>
-                    {% for cat in categories -%}
-                      <option value="{{ cat.id }}"
-                              {%- if typ != "tag" and model.source_value == cat.id %} selected="selected"{% endif -%}>
-                        {% for it in cat.parent_names %}{{ it }} &rang; {% endfor %}{{ cat.name }}
-                      </option>
-                    {%- endfor %}
-                  </select>
-                  <label for="sourceValueCat">Category</label>
-                </div>
-              </div>
-              <div class="col-1 d-flex justify-content-end pb-3">
-                <div class="form-check form-check-inline me-0">
-                  <input type="radio" name="SourceType" id="sourceTypeTag" class="form-check-input" value="tag"
-                         {%- if typ == "tag" %} checked="checked"{% endif %} onclick="Admin.customFeedBy('tag')">
-                  <label for="sourceTypeTag" class="form-check-label d-none">Tag</label>
-                </div>
-              </div>
-              <div class="col-11 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="SourceValue" id="sourceValueTag" class="form-control" placeholder="Tag"
-                         {%- unless typ == "tag" %} disabled="disabled"{% endunless %} required
-                         {%- if typ == "tag" %} value="{{ model.source_value }}"{% endif %}>
-                  <label for="sourceValueTag">Tag</label>
-                </div>
-              </div>
-            </div>
-          </fieldset>
-        </div>
-      </div>
-      <div class="row pb-3">
-        <div class="col">
-          <fieldset class="container" id="podcastFields"{% unless model.is_podcast %} disabled="disabled"{%endunless%}>
-            <legend>Podcast Settings</legend>
-            <div class="row">
-              <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="Title" id="title" class="form-control" placeholder="Title" required
-                         value="{{ model.title }}">
-                  <label for="title">Title</label>
-                </div>
-              </div>
-              <div class="col-12 col-md-4 col-lg-4 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
-                         value="{{ model.subtitle }}">
-                  <label for="subtitle">Podcast Subtitle</label>
-                </div>
-              </div>
-              <div class="col-12 col-md-3 col-lg-2 pb-3">
-                <div class="form-floating">
-                  <input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" placeholder="Items"
-                         required value="{{ model.items_in_feed }}">
-                  <label for="itemsInFeed"># Episodes</label>
-                </div>
-              </div>
-            </div>
-            <div class="row">
-              <div class="col-12 col-md-5 col-lg-4 offset-lg-1 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="AppleCategory" id="appleCategory" class="form-control"
-                         placeholder="iTunes Category" required value="{{ model.apple_category }}">
-                  <label for="appleCategory">iTunes Category</label>
-                  <span class="form-text fst-italic">
-                    <a href="https://www.thepodcasthost.com/planning/itunes-podcast-categories/" target="_blank"
-                       rel="noopener">
-                      iTunes Category / Subcategory List
-                    </a>
-                  </span>
-                </div>
-              </div>
-              <div class="col-12 col-md-4 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="AppleSubcategory" id="appleSubcategory" class="form-control"
-                         placeholder="iTunes Subcategory" value="{{ model.apple_subcategory }}">
-                  <label for="appleSubcategory">iTunes Subcategory</label>
-                </div>
-              </div>
-              <div class="col-12 col-md-3 col-lg-2 pb-3">
-                <div class="form-floating">
-                  <select name="Explicit" id="explicit" class="form-control" required>
-                    <option value="yes"{% if model.explicit == "yes" %} selected="selected"{% endif %}>Yes</option>
-                    <option value="no"{% if model.explicit == "no" %} selected="selected"{% endif %}>No</option>
-                    <option value="clean"{% if model.explicit == "clean" %} selected="selected"{% endif %}>
-                      Clean
-                    </option>
-                  </select>
-                  <label for="explicit">Explicit Rating</label>
-                </div>
-              </div>
-            </div>
-            <div class="row">
-              <div class="col-12 col-md-6 col-lg-4 offset-xxl-1 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="DisplayedAuthor" id="displayedAuthor" class="form-control"
-                         placeholder="Author" required value="{{ model.displayed_author }}">
-                  <label for="displayedAuthor">Displayed Author</label>
-                </div>
-              </div>
-              <div class="col-12 col-md-6 col-lg-4 pb-3">
-                <div class="form-floating">
-                  <input type="email" name="Email" id="email" class="form-control" placeholder="Email" required
-                         value="{{ model.email }}">
-                  <label for="email">Author E-mail</label>
-                  <span class="form-text fst-italic">For iTunes, must match registered e-mail</span>
-                </div>
-              </div>
-              <div class="col-12 col-sm-5 col-md-4 col-lg-4 col-xl-3 offset-xl-1 col-xxl-2 offset-xxl-0">
-                <div class="form-floating">
-                  <input type="text" name="DefaultMediaType" id="defaultMediaType" class="form-control"
-                         placeholder="Media Type" value="{{ model.default_media_type }}">
-                  <label for="defaultMediaType">Default Media Type</label>
-                  <span class="form-text fst-italic">Optional; blank for no default</span>
-                </div>
-              </div>
-              <div class="col-12 col-sm-7 col-md-8 col-lg-10 offset-lg-1">
-                <div class="form-floating">
-                  <input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL" required
-                         value="{{ model.image_url }}">
-                  <label for="imageUrl">Image URL</label>
-                  <span class="form-text fst-italic">Relative URL will be appended to {{ web_log.url_base }}/</span>
-                </div>
-              </div>
-            </div>
-            <div class="row pb-3">
-              <div class="col-12 col-lg-10 offset-lg-1">
-                <div class="form-floating">
-                  <input type="text" name="Summary" id="summary" class="form-control" placeholder="Summary" required
-                         value="{{ model.summary }}">
-                  <label for="summary">Summary</label>
-                  <span class="form-text fst-italic">Displayed in podcast directories</span>
-                </div>
-              </div>
-            </div>
-            <div class="row pb-3">
-              <div class="col-12 col-lg-10 offset-lg-1">
-                <div class="form-floating">
-                  <input type="text" name="MediaBaseUrl" id="mediaBaseUrl" class="form-control"
-                         placeholder="Media Base URL" value="{{ model.media_base_url }}">
-                  <label for="mediaBaseUrl">Media Base URL</label>
-                  <span class="form-text fst-italic">Optional; prepended to episode media file if present</span>
-                </div>
-              </div>
-            </div>
-            <div class="row">
-              <div class="col-12 col-lg-5 offset-lg-1 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="FundingUrl" id="fundingUrl" class="form-control" placeholder="Funding URL"
-                         value="{{ model.funding_url }}">
-                  <label for="fundingUrl">Funding URL</label>
-                  <span class="form-text fst-italic">
-                    Optional; URL describing donation options for this podcast, relative URL supported
-                  </span>
-                </div>
-              </div>
-              <div class="col-12 col-lg-5 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="FundingText" id="fundingText" class="form-control" maxlength="128"
-                         placeholder="Funding Text" value="{{ model.funding_text }}">
-                  <label for="fundingText">Funding Text</label>
-                  <span class="form-text fst-italic">Optional; text for the funding link</span>
-                </div>
-              </div>
-            </div>
-            <div class="row pb-3">
-              <div class="col-8 col-lg-5 offset-lg-1 pb-3">
-                <div class="form-floating">
-                  <input type="text" name="PodcastGuid" id="guid" class="form-control" placeholder="GUID"
-                         value="{{ model.podcast_guid }}">
-                  <label for="guid">Podcast GUID</label>
-                  <span class="form-text fst-italic">
-                    Optional; v5 UUID uniquely identifying this podcast; once entered, do not change this value
-                    (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#guid"
-                        target="_blank">documentation</a>)
-                  </span>
-                </div>
-              </div>
-              <div class="col-4 col-lg-3 offset-lg-2 pb-3">
-                <div class="form-floating">
-                  <select name="Medium" id="medium" class="form-control">
-                    {% for med in medium_values -%}
-                      <option value="{{ med[0] }}"{% if model.medium == med[0] %} selected{% endif %}>
-                        {{ med[1] }}
-                      </option>
-                    {%- endfor %}
-                  </select>
-                  <label for="medium">Medium</label>
-                  <span class="form-text fst-italic">
-                    Optional; medium of the podcast content
-                    (<a href="https://github.com/Podcastindex-org/podcast-namespace/blob/main/docs/1.0.md#medium"
-                        target="_blank">documentation</a>)
-                  </span>
-                </div>
-              </div>
-            </div>
-          </fieldset>
-        </div>
-      </div>
-      <div class="row pb-3">
-        <div class="col text-center">
-          <button type="submit" class="btn btn-primary">Save Changes</button>
-        </div>
-      </div>
-    </div>
-  </form>
-</article>

src/admin-theme/dashboard.liquid

@@ -1,59 +0,0 @@
-<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">
-      <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>
-          {% if is_author %}
-            <a href="{{ "admin/posts" | relative_link }}" class="btn btn-secondary me-2">View All</a>
-            <a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary">Write a New Post</a>
-          {% endif %}
-        </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>
-          {% if is_author %}
-            <a href="{{ "admin/pages" | relative_link }}" class="btn btn-secondary me-2">View All</a>
-            <a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary">Create a New Page</a>
-          {% endif %}
-        </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>
-          {% if is_web_log_admin %}
-            <a href="{{ "admin/categories" | relative_link }}" class="btn btn-secondary me-2">View All</a>
-            <a href="{{ "admin/category/new/edit" | relative_link }}" class="btn btn-secondary">Add a New Category</a>
-          {% endif %}
-        </div>
-      </div>
-    </section>
-  </div>
-  {% if is_web_log_admin %}
-    <div class="row pb-3">
-      <div class="col text-end">
-        <a href="{{ "admin/settings" | relative_link }}" class="btn btn-secondary">Modify Settings</a>
-      </div>
-    </div>
-  {% endif %}
-</article>

src/admin-theme/layout-bare.liquid

@@ -1,5 +0,0 @@
-<!DOCTYPE html>
-<html lang="en">
-<head><title></title></head>
-<body>{{ content }}</body>
-</html>

src/admin-theme/layout-partial.liquid

@@ -1,10 +0,0 @@
-<!DOCTYPE html>
-<html lang="en">
-  <head>
-    <title>{{ page_title | strip_html }} &laquo; Admin &laquo; {{ web_log.name | strip_html }}</title>
-  </head>
-  <body>
-    {% include_template "_layout" %}
-    <script>Admin.dismissSuccesses()</script>
-  </body>
-</html>

src/admin-theme/layout.liquid

@@ -1,32 +0,0 @@
-<!DOCTYPE html>
-<html lang="en">
-  <head>
-    <meta name="viewport" content="width=device-width, initial-scale=1">
-    <meta name="generator" content="{{ generator }}">
-    <title>{{ page_title | strip_html }} &laquo; Admin &laquo; {{ web_log.name | strip_html }}</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" | relative_link }}">
-  </head>
-  <body hx-boost="true">
-    {% include_template "_layout" %}
-    <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>
-    {{ htmx_script }}
-    <script>
-      const cssLoaded = [...document.styleSheets].filter(it => it.href.indexOf("bootstrap.min.css") > -1).length > 0
-      if (!cssLoaded) {
-        const local = document.createElement("link")
-        local.rel = "stylesheet"
-        local.href = "{{ "themes/admin/bootstrap.min.css" | relative_link }}"
-        document.getElementsByTagName("link")[0].prepend(local)
-      }
-      setTimeout(function () {
-        if (!bootstrap) document.write('<script src=\"{{ "script/bootstrap.bundle.min.js" | relative_link }}\"><\/script>')
-      }, 2000)
-    </script>
-    <script src="{{ "themes/admin/admin.js" | relative_link }}"></script>
-    <script>Admin.dismissSuccesses()</script>
-  </body>
-</html>

src/admin-theme/log-on.liquid

@@ -1,30 +0,0 @@
-<h2 class="my-3">Log On to {{ web_log.name }}</h2>
-<article class="py-3">
-  <form action="{{ "user/log-on" | relative_link }}" method="post" hx-push-url="true">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    {% if model.return_to %}
-      <input type="hidden" name="ReturnTo" value="{{ model.return_to.value }}">
-    {% endif %}
-    <div class="container">
-      <div class="row">
-        <div class="col-12 col-md-6 col-lg-4 offset-lg-2 pb-3">
-          <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-12 col-md-6 col-lg-4 pb-3">
-          <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/admin-theme/my-info.liquid

@@ -1,77 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <form action="{{ "admin/user/my-info" | relative_link }}" method="post">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <div class="d-flex flex-row flex-wrap justify-content-around">
-      <div class="text-center mb-3 lh-sm">
-        <strong class="text-decoration-underline">Access Level</strong><br>{{ access_level }}
-      </div>
-      <div class="text-center mb-3 lh-sm">
-        <strong class="text-decoration-underline">Created</strong><br>{{ created_on | date: "MMMM d, yyyy" }}
-      </div>
-      <div class="text-center mb-3 lh-sm">
-        <strong class="text-decoration-underline">Last Log On</strong><br>
-        {{ last_seen_on | date: "MMMM d, yyyy" }} at {{ last_seen_on | date: "h:mmtt" | downcase }}
-      </div>
-    </div>
-    <div class="container">
-      <div class="row"><div class="col"><hr class="mt-0"></div></div>
-      <div class="row mb-3">
-        <div class="col-12 col-md-6 col-lg-4 pb-3">
-          <div class="form-floating">
-            <input type="text" name="FirstName" id="firstName" class="form-control" autofocus required
-                   placeholder="First" value="{{ model.first_name }}">
-            <label for="firstName">First Name</label>
-          </div>
-        </div>
-        <div class="col-12 col-md-6 col-lg-4 pb-3">
-          <div class="form-floating">
-            <input type="text" name="LastName" id="lastName" class="form-control" required
-                   placeholder="Last" value="{{ model.last_name }}">
-            <label for="lastName">Last Name</label>
-          </div>
-        </div>
-        <div class="col-12 col-md-6 col-lg-4 pb-3">
-          <div class="form-floating">
-            <input type="text" name="PreferredName" id="preferredName" class="form-control" required
-                   placeholder="Preferred" value="{{ model.preferred_name }}">
-            <label for="preferredName">Preferred Name</label>
-          </div>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col">
-          <fieldset class="p-2">
-            <legend class="ps-1">Change Password</legend>
-            <div class="row">
-              <div class="col">
-                <p class="form-text">Optional; leave blank to keep your current password</p>
-              </div>
-            </div>
-            <div class="row">
-              <div class="col-12 col-md-6 pb-3">
-                <div class="form-floating">
-                  <input type="password" name="NewPassword" id="newPassword" class="form-control"
-                         placeholder="Password">
-                  <label for="newPassword">New Password</label>
-                </div>
-              </div>
-              <div class="col-12 col-md-6 pb-3">
-                <div class="form-floating">
-                  <input type="password" name="NewPasswordConfirm" id="newPasswordConfirm" class="form-control"
-                         placeholder="Confirm">
-                  <label for="newPasswordConfirm">Confirm New Password</label>
-                </div>
-              </div>
-            </div>
-          </fieldset>
-        </div>
-      </div>
-      <div class="row">
-        <div class="col text-center mb-3">
-          <button type="submit" class="btn btn-primary">Save Changes</button>
-        </div>
-      </div>
-    </div>
-  </form>
-</article>

src/admin-theme/page-edit.liquid

@@ -1,112 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <form action="{{ "admin/page/save" | relative_link }}" method="post" hx-push-url="true">
-    <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-9">
-          <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 class="form-floating pb-3">
-            <input type="text" name="Permalink" id="permalink" class="form-control" required
-                   value="{{ model.permalink }}">
-            <label for="permalink">Permalink</label>
-            {%- unless model.is_new %}
-              <span class="form-text">
-                <a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
-                  Manage Permalinks
-                </a>
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ "admin/page/" | append: model.page_id | append: "/revisions" | relative_link }}">
-                  Manage Revisions
-                </a>
-              </span>
-            {% endunless -%}
-          </div>
-          <div class="mb-2">
-            <label for="text">Text</label> &nbsp; &nbsp;
-            <input type="radio" name="Source" id="source_html" class="btn-check" value="HTML"
-            {%- if model.source == "HTML" %} checked="checked"{% endif %}>
-            <label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
-            <input type="radio" name="Source" id="source_md" class="btn-check" value="Markdown"
-            {%- if model.source == "Markdown" %} checked="checked"{% endif %}>
-            <label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
-          </div>
-          <div class="mb-3">
-            <textarea name="Text" id="text" class="form-control">{{ model.text }}</textarea>
-          </div>
-        </div>
-        <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[0] %} 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 %}>
-            <label for="showList" class="form-check-label">Show in Page List</label>
-          </div>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col">
-          <button type="submit" class="btn btn-primary">Save Changes</button>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col">
-          <fieldset>
-            <legend>
-              Metadata
-              <button type="button" class="btn btn-sm btn-secondary" data-bs-toggle="collapse"
-                      data-bs-target="#metaItemContainer">
-                show
-              </button>
-            </legend>
-            <div id="metaItemContainer" class="collapse">
-              <div id="metaItems" class="container">
-                {%- for meta in metadata %}
-                  <div id="meta_{{ meta[0] }}" class="row mb-3">
-                    <div class="col-1 text-center align-self-center">
-                      <button type="button" class="btn btn-sm btn-danger" onclick="Admin.removeMetaItem({{ meta[0] }})">
-                        &minus;
-                      </button>
-                    </div>
-                    <div class="col-3">
-                      <div class="form-floating">
-                        <input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
-                               placeholder="Name" value="{{ meta[1] }}">
-                        <label for="metaNames_{{ meta[0] }}">Name</label>
-                      </div>
-                    </div>
-                    <div class="col-8">
-                      <div class="form-floating">
-                        <input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
-                               placeholder="Value" value="{{ meta[2] }}">
-                        <label for="metaValues_{{ meta[0] }}">Value</label>
-                      </div>
-                    </div>
-                  </div>
-                {% endfor -%}
-              </div>
-              <button type="button" class="btn btn-sm btn-secondary" onclick="Admin.addMetaItem()">Add an Item</button>
-              <script>
-                document.addEventListener("DOMContentLoaded", () => Admin.setNextMetaIndex({{ metadata | size }}))
-              </script>
-            </div>
-          </fieldset>
-        </div>
-      </div>
-    </div>
-  </form>
-</article>

src/admin-theme/page-list.liquid

@@ -1,77 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <a href="{{ "admin/page/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Create a New Page</a>
-  {%- assign page_count = pages | size -%}
-  {%- assign title_col = "col-12 col-md-5" -%}
-  {%- assign link_col  = "col-12 col-md-5" -%}
-  {%- assign upd8_col  = "col-12 col-md-2" -%}
-  <form method="post" class="container" hx-target="body">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <div class="row mwl-table-heading">
-      <div class="{{ title_col }}">
-        <span class="d-none d-md-inline">Title</span><span class="d-md-none">Page</span>
-      </div>
-      <div class="{{ link_col }} d-none d-md-inline-block">Permalink</div>
-      <div class="{{ upd8_col }} d-none d-md-inline-block">Updated</div>
-    </div>
-    {% if page_count > 0 %}
-      {% for pg in pages -%}
-        <div class="row mwl-table-detail">
-          <div class="{{ title_col }}">
-            {{ pg.title }}
-            {%- if pg.is_default %} &nbsp; <span class="badge bg-success">HOME PAGE</span>{% endif -%}
-            {%- if pg.is_in_page_list %} &nbsp; <span class="badge bg-primary">IN PAGE LIST</span> {% endif -%}<br>
-            <small>
-              {%- capture pg_link %}{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
-              <a href="{{ pg_link | relative_link }}" target="_blank">View Page</a>
-              {% if is_editor or is_author and user_id == pg.author_id %}
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ pg | edit_page_link }}">Edit</a>
-              {% endif %}
-              {% if is_web_log_admin %}
-                <span class="text-muted"> &bull; </span>
-                {%- assign pg_del_link = "admin/page/" | append: pg.id | append: "/delete" | relative_link -%}
-                <a href="{{ pg_del_link }}" hx-post="{{ pg_del_link }}" class="text-danger"
-                   hx-confirm="Are you sure you want to delete the page &ldquo;{{ pg.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
-                  Delete
-                </a>
-              {% endif %}
-            </small>
-          </div>
-          <div class="{{ link_col }}">
-            {%- capture pg_link %}/{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}{% endcapture -%}
-            <small class="d-md-none">{{ pg_link }}</small><span class="d-none d-md-inline">{{ pg_link }}</span>
-          </div>
-          <div class="{{ upd8_col }}">
-            <small class="d-md-none text-muted">Updated {{ pg.updated_on | date: "MMMM d, yyyy" }}</small>
-            <span class="d-none d-md-inline">{{ pg.updated_on | date: "MMMM d, yyyy" }}</span>
-          </div>
-        </div>
-      {%- endfor %}
-    {% else %}
-      <div class="row">
-        <div class="col text-muted fst-italic text-center">This web log has no pages</div>
-      </div>
-    {% endif %}
-  </form>
-  {% if page_nbr > 1 or page_count == 25 %}
-    <div class="d-flex justify-content-evenly pb-3">
-      <div>
-        {% if page_nbr > 1 %}
-          <p>
-            <a class="btn btn-default" href="{{ "admin/pages" | append: prev_page | relative_link }}">
-              &laquo; Previous
-            </a>
-          </p>
-        {% endif %}
-      </div>
-      <div class="text-right">
-        {% if page_count == 25 %}
-          <p>
-            <a class="btn btn-default" href="{{ "admin/pages" | append: next_page | relative_link }}">Next &raquo;</a>
-          </p>
-        {% endif %}
-      </div>
-    </div>
-  {% endif %}
-</article>

src/admin-theme/permalinks.liquid

@@ -1,60 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  {%- assign base_url = "admin/" | append: model.entity | append: "/" -%}
-  <form action="{{ base_url | append: "permalinks" | relative_link }}" method="post">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <input type="hidden" name="Id" value="{{ model.id }}">
-    <div class="container">
-      <div class="row">
-        <div class="col">
-          <p style="line-height:1.2rem;">
-            <strong>{{ model.current_title }}</strong><br>
-            <small class="text-muted">
-              <span class="fst-italic">{{ model.current_permalink }}</span><br>
-              <a href="{{ base_url | append: model.id | append: "/edit" | relative_link }}">
-                &laquo; Back to Edit {{ model.entity | capitalize }}
-              </a>
-            </small>
-          </p>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col">
-          <button type="button" class="btn btn-sm btn-secondary" onclick="Admin.addPermalink()">Add a Permalink</button>
-        </div>
-      </div>
-      <div class="row mb-3">
-        <div class="col">
-          <div id="permalinks" class="container">
-            {%- assign link_count = 0 -%}
-            {%- for link in model.prior %}
-              <div id="link_{{ link_count }}" class="row mb-3">
-                <div class="col-1 text-center align-self-center">
-                  <button type="button" class="btn btn-sm btn-danger" onclick="Admin.removePermalink({{ link_count }})">
-                    &minus;
-                  </button>
-                </div>
-                <div class="col-11">
-                  <div class="form-floating">
-                    <input type="text" name="Prior" id="prior_{{ link_count }}" class="form-control"
-                           placeholder="Link" value="{{ link }}">
-                    <label for="prior_{{ link_count }}">Link</label>
-                  </div>
-                </div>
-              </div>
-              {%- assign link_count = link_count | plus: 1 -%}
-            {% endfor -%}
-            <script>
-              document.addEventListener("DOMContentLoaded", () => Admin.setPermalinkIndex({{ link_count }}))
-            </script>
-          </div>
-        </div>
-      </div>
-      <div class="row pb-3">
-        <div class="col">
-          <button type="submit" class="btn btn-primary">Save Changes</button>
-        </div>
-      </div>
-    </div>
-  </form>
-</article>

src/admin-theme/post-edit.liquid

@@ -1,346 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <form action="{{ "admin/post/save" | relative_link }}" method="post" hx-push-url="true">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <input type="hidden" name="PostId" value="{{ model.post_id }}">
-    <div class="container">
-      <div class="row mb-3">
-        <div class="col-12 col-lg-9">
-          <div class="form-floating pb-3">
-            <input type="text" name="Title" id="title" class="form-control" placeholder="Title" autofocus required
-                   value="{{ model.title }}">
-            <label for="title">Title</label>
-          </div>
-          <div class="form-floating pb-3">
-            <input type="text" name="Permalink" id="permalink" class="form-control" placeholder="Permalink" required
-                   value="{{ model.permalink }}">
-            <label for="permalink">Permalink</label>
-            {%- unless model.is_new %}
-              <span class="form-text">
-                <a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
-                  Manage Permalinks
-                </a>
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ "admin/post/" | append: model.post_id | append: "/revisions" | relative_link }}">
-                  Manage Revisions
-                </a>
-              </span>
-            {% endunless -%}
-          </div>
-          <div class="mb-2">
-            <label for="text">Text</label> &nbsp; &nbsp;
-            <div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
-              <input type="radio" name="Source" id="source_html" class="btn-check" value="HTML"
-              {%- if model.source == "HTML" %} checked="checked"{% endif %}>
-              <label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
-              <input type="radio" name="Source" id="source_md" class="btn-check" value="Markdown"
-              {%- if model.source == "Markdown" %} checked="checked"{% endif %}>
-              <label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
-            </div>
-          </div>
-          <div class="pb-3">
-            <textarea name="Text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
-          </div>
-          <div class="form-floating pb-3">
-            <input type="text" name="Tags" id="tags" class="form-control" placeholder="Tags"
-                   value="{{ model.tags }}">
-            <label for="tags">Tags</label>
-            <div class="form-text">comma-delimited</div>
-          </div>
-          {% if model.status == "Draft" %}
-            <div class="form-check form-switch pb-2">
-              <input type="checkbox" name="DoPublish" id="doPublish" class="form-check-input" value="true">
-              <label for="doPublish" class="form-check-label">Publish This Post</label>
-            </div>
-          {% endif %}
-          <button type="submit" class="btn btn-primary pb-2">Save Changes</button>
-          <hr class="mb-3">
-          <fieldset class="mb-3">
-            <legend>
-              <span class="form-check form-switch">
-                <small>
-                  <input type="checkbox" name="IsEpisode" id="isEpisode" class="form-check-input" value="true"
-                         data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()"
-                         {%- if model.is_episode %}checked="checked"{% endif %}>
-                </small>
-                <label for="isEpisode">Podcast Episode</label>
-              </span>
-            </legend>
-            <div id="episodeItems" class="container p-0 collapse{% if model.is_episode %} show{% endif %}">
-              <div class="row">
-                <div class="col-12 col-md-8 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="Media" id="media" class="form-control" placeholder="Media" required
-                           value="{{ model.media }}">
-                    <label for="media">Media File</label>
-                    <div class="form-text">
-                      Relative URL will be appended to base media path (if set) or served from this web log
-                    </div>
-                  </div>
-                </div>
-                <div class="col-12 col-md-4 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="MediaType" id="mediaType" class="form-control" placeholder="Media Type"
-                           value="{{ model.media_type }}">
-                    <label for="mediaType">Media MIME Type</label>
-                    <div class="form-text">Optional; overrides podcast default</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row pb-3">
-                <div class="col">
-                  <div class="form-floating">
-                    <input type="number" name="Length" id="length" class="form-control" placeholder="Length" required
-                           value="{{ model.length }}">
-                    <label for="length">Media Length (bytes)</label>
-                    <div class="form-text">TODO: derive from above file name</div>
-                  </div>
-                </div>
-                <div class="col">
-                  <div class="form-floating">
-                    <input type="text" name="Duration" id="duration" class="form-control" placeholder="Duration"
-                           value="{{ model.duration }}">
-                    <label for="duration">Duration</label>
-                    <div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row pb-3">
-                <div class="col">
-                  <div class="form-floating">
-                    <input type="text" name="Subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
-                           value="{{ model.subtitle }}">
-                    <label for="subtitle">Subtitle</label>
-                    <div class="form-text">Optional; a subtitle for this episode</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row">
-                <div class="col-12 col-md-8 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="ImageUrl" id="imageUrl" class="form-control" placeholder="Image URL"
-                           value="{{ model.image_url }}">
-                    <label for="imageUrl">Image URL</label>
-                    <div class="form-text">
-                      Optional; overrides podcast default; relative URL served from this web log
-                    </div>
-                  </div>
-                </div>
-                <div class="col-12 col-md-4 pb-3">
-                  <div class="form-floating">
-                    <select name="Explicit" id="explicit" class="form-control">
-                      {% for exp_value in explicit_values %}
-                        <option value="{{ exp_value[0] }}"
-                                {%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
-                          {{ exp_value[1] }}
-                        </option>
-                      {% endfor %}
-                    </select>
-                    <label for="explicit">Explicit Rating</label>
-                    <div class="form-text">Optional; overrides podcast default</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row">
-                <div class="col-12 col-md-8 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="ChapterFile" id="chapterFile" class="form-control"
-                           placeholder="Chapter File" value="{{ model.chapter_file }}">
-                    <label for="chapterFile">Chapter File</label>
-                    <div class="form-text">Optional; relative URL served from this web log</div>
-                  </div>
-                </div>
-                <div class="col-12 col-md-4 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="ChapterType" id="chapterType" class="form-control"
-                           placeholder="Chapter Type" value="{{ model.chapter_type }}">
-                    <label for="chapterType">Chapter MIME Type</label>
-                    <div class="form-text">
-                      Optional; <code>application/json+chapters</code> assumed if chapter file ends with
-                      <code>.json</code>
-                    </div>
-                  </div>
-                </div>
-              </div>
-              <div class="row">
-                <div class="col-12 col-md-8 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="TranscriptUrl" id="transcriptUrl" class="form-control"
-                           placeholder="Transcript URL" value="{{ model.transcript_url }}"
-                           onkeyup="Admin.requireTranscriptType()">
-                    <label for="transcriptUrl">Transcript URL</label>
-                    <div class="form-text">Optional; relative URL served from this web log</div>
-                  </div>
-                </div>
-                <div class="col-12 col-md-4 pb-3">
-                  <div class="form-floating">
-                    <input type="text" name="TranscriptType" id="transcriptType" class="form-control"
-                           placeholder="Transcript Type" value="{{ model.transcript_type }}"
-                           {%- if model.transcript_url != "" %} required{% endif %}>
-                    <label for="transcriptType">Transcript MIME Type</label>
-                    <div class="form-text">Required if transcript URL provided</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row pb-3">
-                <div class="col">
-                  <div class="form-floating">
-                    <input type="text" name="TranscriptLang" id="transcriptLang" class="form-control"
-                           placeholder="Transcript Language" value="{{ model.transcript_lang }}">
-                    <label for="transcriptLang">Transcript Language</label>
-                    <div class="form-text">Optional; overrides podcast default</div>
-                  </div>
-                </div>
-                <div class="col d-flex justify-content-center">
-                  <div class="form-check form-switch align-self-center pb-3">
-                    <input type="checkbox" name="TranscriptCaptions" id="transcriptCaptions" class="form-check-input"
-                           value="true" {% if model.transcript_captions %} checked="checked"{% endif %}>
-                    <label for="transcriptCaptions">This is a captions file</label>
-                  </div>
-                </div>
-              </div>
-              <div class="row pb-3">
-                <div class="col col-md-4">
-                  <div class="form-floating">
-                    <input type="number" name="SeasonNumber" id="seasonNumber" class="form-control"
-                           placeholder="Season Number" value="{{ model.season_number }}">
-                    <label for="seasonNumber">Season Number</label>
-                    <div class="form-text">Optional</div>
-                  </div>
-                </div>
-                <div class="col col-md-8">
-                  <div class="form-floating">
-                    <input type="text" name="SeasonDescription" id="seasonDescription" class="form-control"
-                           placeholder="Season Description" maxlength="128" value="{{ model.season_description }}">
-                    <label for="seasonDescription">Season Description</label>
-                    <div class="form-text">Optional</div>
-                  </div>
-                </div>
-              </div>
-              <div class="row pb-3">
-                <div class="col col-md-4">
-                  <div class="form-floating">
-                    <input type="number" name="EpisodeNumber" id="episodeNumber" class="form-control" step="0.01"
-                           placeholder="Episode Number" value="{{ model.episode_number }}">
-                    <label for="episodeNumber">Episode Number</label>
-                    <div class="form-text">Optional; up to 2 decimal points</div>
-                  </div>
-                </div>
-                <div class="col col-md-8">
-                  <div class="form-floating">
-                    <input type="text" name="EpisodeDescription" id="episodeDescription" class="form-control"
-                           placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}">
-                    <label for="episodeDescription">Episode Description</label>
-                    <div class="form-text">Optional</div>
-                  </div>
-                </div>
-              </div>
-            </div>
-            <script>
-              document.addEventListener("DOMContentLoaded", () => Admin.toggleEpisodeFields())
-            </script>
-          </fieldset>
-          <fieldset class="pb-3">
-            <legend>
-              Metadata
-              <button type="button" class="btn btn-sm btn-secondary" data-bs-toggle="collapse"
-                      data-bs-target="#metaItemContainer">
-                show
-              </button>
-            </legend>
-            <div id="metaItemContainer" class="collapse">
-              <div id="metaItems" class="container">
-                {%- for meta in metadata %}
-                  <div id="meta_{{ meta[0] }}" class="row mb-3">
-                    <div class="col-1 text-center align-self-center">
-                      <button type="button" class="btn btn-sm btn-danger" onclick="Admin.removeMetaItem({{ meta[0] }})">
-                        &minus;
-                      </button>
-                    </div>
-                    <div class="col-3">
-                      <div class="form-floating">
-                        <input type="text" name="MetaNames" id="metaNames_{{ meta[0] }}" class="form-control"
-                               placeholder="Name" value="{{ meta[1] }}">
-                        <label for="metaNames_{{ meta[0] }}">Name</label>
-                      </div>
-                    </div>
-                    <div class="col-8">
-                      <div class="form-floating">
-                        <input type="text" name="MetaValues" id="metaValues_{{ meta[0] }}" class="form-control"
-                               placeholder="Value" value="{{ meta[2] }}">
-                        <label for="metaValues_{{ meta[0] }}">Value</label>
-                      </div>
-                    </div>
-                  </div>
-                {% endfor -%}
-              </div>
-              <button type="button" class="btn btn-sm btn-secondary" onclick="Admin.addMetaItem()">Add an Item</button>
-              <script>
-                document.addEventListener("DOMContentLoaded", () => Admin.setNextMetaIndex({{ metadata | size }}))
-              </script>
-            </div>
-          </fieldset>
-          {% if model.status == "Published" %}
-            <fieldset class="pb-3">
-              <legend>Maintenance</legend>
-              <div class="container">
-                <div class="row">
-                  <div class="col align-self-center">
-                    <div class="form-check form-switch pb-2">
-                      <input type="checkbox" name="SetPublished" id="setPublished" class="form-check-input"
-                             value="true">
-                      <label for="setPublished" class="form-check-label">Set Published Date</label>
-                    </div>
-                  </div>
-                  <div class="col-4">
-                    <div class="form-floating">
-                      <input type="datetime-local" name="PubOverride" id="pubOverride" class="form-control"
-                             placeholder="Override Date"
-                             {%- if model.pub_override -%}
-                               value="{{ model.pub_override | date: "yyyy-MM-dd\THH:mm" }}"
-                             {%- endif %}>
-                      <label for="pubOverride" class="form-label">Published On</label>
-                    </div>
-                  </div>
-                  <div class="col-5 align-self-center">
-                    <div class="form-check form-switch pb-2">
-                      <input type="checkbox" name="SetUpdated" id="setUpdated" class="form-check-input" value="true">
-                      <label for="setUpdated" class="form-check-label">
-                        Purge revisions and<br>set as updated date as well
-                      </label>
-                    </div>
-                  </div>
-                </div>
-              </div>
-            </fieldset>
-          {% endif %}
-        </div>
-        <div class="col-12 col-lg-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[0] %} selected="selected"{% endif %}>
-                  {{ tmpl[1] }}
-                </option>
-              {%- endfor %}
-            </select>
-            <label for="template">Post Template</label>
-          </div>
-          <fieldset>
-            <legend>Categories</legend>
-            {% for cat in categories %}
-              <div class="form-check">
-                <input type="checkbox" name="CategoryIds" id="categoryId_{{ cat.id }}" class="form-check-input"
-                       value="{{ cat.id }}" {% if model.category_ids contains cat.id %} checked="checked"{% endif %}>
-                <label for="categoryId_{{ cat.id }}" class="form-check-label"
-                       {%- if cat.description %} title="{{ cat.description.value | strip_html | escape }}"{% endif %}>
-                  {%- for it in cat.parent_names %}&nbsp; &rang; &nbsp;{% endfor %}{{ cat.name }}
-                </label>
-              </div>
-            {% endfor %}
-          </fieldset>
-        </div>
-      </div>
-    </div>
-  </form>
-</article>

src/admin-theme/post-list.liquid

@@ -1,100 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <a href="{{ "admin/post/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3">Write a New Post</a>
-  <form method="post" class="container" hx-target="body">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    {%- assign post_count = model.posts | size -%}
-    {%- assign date_col   = "col-xs-12 col-md-3 col-lg-2" -%}
-    {%- assign title_col  = "col-xs-12 col-md-7 col-lg-6 col-xl-5 col-xxl-4" -%}
-    {%- assign author_col = "col-xs-12 col-md-2 col-lg-1" -%}
-    {%- assign tag_col    = "col-lg-3 col-xl-4 col-xxl-5 d-none d-lg-inline-block" -%}
-    <div class="row mwl-table-heading">
-      <div class="{{ date_col }}">
-        <span class="d-md-none">Post</span><span class="d-none d-md-inline">Date</span>
-      </div>
-      <div class="{{ title_col }} d-none d-md-inline-block">Title</div>
-      <div class="{{ author_col }} d-none d-md-inline-block">Author</div>
-      <div class="{{ tag_col }}">Tags</div>
-    </div>
-    {%- if post_count > 0 %}
-      {% for post in model.posts -%}
-        <div class="row mwl-table-detail">
-          <div class="{{ date_col }} no-wrap">
-            <small class="d-md-none">
-              {%- if post.published_on -%}
-                Published {{ post.published_on | date: "MMMM d, yyyy" }}
-              {%- else -%}
-                Not Published
-              {%- endif -%}
-              {%- if post.published_on != post.updated_on -%}
-                <em class="text-muted"> (Updated {{ post.updated_on | date: "MMMM d, yyyy" }})</em>
-              {%- endif %}
-            </small>
-            <span class="d-none d-md-inline">
-              {%- if post.published_on -%}
-                {{ post.published_on | date: "MMMM d, yyyy" }}
-              {%- else -%}
-                Not Published
-              {%- endif -%}
-              {%- if post.published_on != post.updated_on %}<br>
-                <small class="text-muted"><em>{{ post.updated_on | date: "MMMM d, yyyy" }}</em></small>
-              {%- endif %}
-            </span>
-          </div>
-          <div class="{{ title_col }}">
-            {%- if post.episode %}<span class="badge bg-success float-end text-uppercase mt-1">Episode</span>{% endif -%}
-            {{ post.title }}<br>
-            <small>
-              <a href="{{ post | relative_link }}" target="_blank">View Post</a>
-              {% if is_editor or is_author and user_id == post.author_id %}
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ post | edit_post_link }}">Edit</a>
-              {% endif %}
-              {% if is_web_log_admin %}
-                <span class="text-muted"> &bull; </span>
-                {%- assign post_del_link = "admin/post/" | append: post.id | append: "/delete" | relative_link -%}
-                <a href="{{ post_del_link }}" hx-post="{{ post_del_link }}" class="text-danger"
-                   hx-confirm="Are you sure you want to delete the page &ldquo;{{ post.title | strip_html | escape }}&rdquo;? This action cannot be undone.">
-                  Delete
-                </a>
-              {% endif %}
-            </small>
-          </div>
-          <div class="{{ author_col }}">
-            {%- assign tag_count = post.tags | size -%}
-            <small class="d-md-none">
-              Authored by {{ model.authors | value: post.author_id }} |
-              {% if tag_count == 0 -%}
-                No
-              {%- else -%}
-                {{ tag_count }}
-              {%- endif %} Tag{% unless tag_count == 1 %}s{% endunless %}
-            </small>
-            <span class="d-none d-md-inline">{{ model.authors | value: post.author_id }}</span>
-          </div>
-          <div class="{{ tag_col }}">
-            <span class="no-wrap">{{ post.tags | join: "</span>, <span class='no-wrap'>" }}</span>
-          </div>
-        </div>
-      {%- endfor %}
-    {% else %}
-      <div class="row">
-        <div class="col text-muted fst-italic text-center">This web log has no posts</div>
-      </div>
-    {% endif %}
-  </form>
-  {% if model.newer_link or model.older_link %}
-    <div class="d-flex justify-content-evenly">
-      <div>
-        {% if model.newer_link %}
-          <p><a class="btn btn-default" href="{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
-        {% endif %}
-      </div>
-      <div class="text-right">
-        {% if model.older_link %}
-          <p><a class="btn btn-default" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
-        {% endif %}
-      </div>
-    </div>
-  {% endif %}
-</article>