Fix PostgreSQL v2.1 migration (#44)

fixes #43

.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

@@ -33,7 +33,7 @@ let zipTheme (name : string) (_ : TargetParameter) =
     |> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
 
 /// Frameworks supported by this build
-let frameworks = [ "net6.0"; "net7.0" ]
+let frameworks = [ "net6.0"; "net7.0"; "net8.0" ]
 
 /// Publish the project for the given runtime ID    
 let publishFor rid (_ : TargetParameter) =

build.fsproj

@@ -2,7 +2,7 @@
 
   <PropertyGroup>
     <OutputType>Exe</OutputType>
-    <TargetFramework>net7.0</TargetFramework>
+    <TargetFramework>net8.0</TargetFramework>
   </PropertyGroup>
 
   <ItemGroup>
@@ -10,11 +10,11 @@
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="Fake.Core.Target" Version="5.23.1" />
+    <PackageReference Include="Fake.Core.Target" Version="6.0.0" />
-    <PackageReference Include="Fake.DotNet.Cli" Version="5.23.1" />
+    <PackageReference Include="Fake.DotNet.Cli" Version="6.0.0" />
-    <PackageReference Include="Fake.IO.FileSystem" Version="5.23.1" />
+    <PackageReference Include="Fake.IO.FileSystem" Version="6.0.0" />
-    <PackageReference Include="Fake.IO.Zip" Version="5.23.1" />
+    <PackageReference Include="Fake.IO.Zip" Version="6.0.0" />
-    <PackageReference Include="MSBuild.StructuredLogger" Version="2.1.768" />
+    <PackageReference Include="MSBuild.StructuredLogger" Version="2.2.206" />
   </ItemGroup>
 
 </Project>

src/.dockerignore

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

src/Directory.Build.props

@@ -1,9 +1,9 @@
 <Project>
   <PropertyGroup>
-    <TargetFrameworks>net6.0;net7.0</TargetFrameworks>
+    <TargetFrameworks>net6.0;net7.0;net8.0</TargetFrameworks>
     <DebugType>embedded</DebugType>
-    <AssemblyVersion>2.0.0.0</AssemblyVersion>
+    <AssemblyVersion>2.1.0.0</AssemblyVersion>
-    <FileVersion>2.0.0.0</FileVersion>
+    <FileVersion>2.1.0.0</FileVersion>
-    <Version>2.0.0</Version>
+    <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

@@ -9,116 +9,123 @@ module Json =
     
     open Newtonsoft.Json
     
-    type CategoryIdConverter () =
+    type CategoryIdConverter() =
-        inherit JsonConverter<CategoryId> ()
+        inherit JsonConverter<CategoryId>()
-        override _.WriteJson (writer : JsonWriter, value : CategoryId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: CategoryId, _: JsonSerializer) =
-            writer.WriteValue (CategoryId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : CategoryId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: CategoryId, _: bool, _: JsonSerializer) =
             (string >> CategoryId) reader.Value
 
-    type CommentIdConverter () =
+    type CommentIdConverter() =
-        inherit JsonConverter<CommentId> ()
+        inherit JsonConverter<CommentId>()
-        override _.WriteJson (writer : JsonWriter, value : CommentId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: CommentId, _: JsonSerializer) =
-            writer.WriteValue (CommentId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: CommentId, _: bool, _: JsonSerializer) =
             (string >> CommentId) reader.Value
 
-    type CustomFeedIdConverter () =
+    type CommentStatusConverter() =
-        inherit JsonConverter<CustomFeedId> ()
+        inherit JsonConverter<CommentStatus>()
-        override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: CommentStatus, _: JsonSerializer) =
-            writer.WriteValue (CustomFeedId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedId, _ : bool, _ : JsonSerializer) =
+        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(string value)
+        override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedId, _: bool, _: JsonSerializer) =
             (string >> CustomFeedId) reader.Value
 
-    type CustomFeedSourceConverter () =
+    type CustomFeedSourceConverter() =
-        inherit JsonConverter<CustomFeedSource> ()
+        inherit JsonConverter<CustomFeedSource>()
-        override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: CustomFeedSource, _: JsonSerializer) =
-            writer.WriteValue (CustomFeedSource.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: CustomFeedSource, _: bool, _: JsonSerializer) =
-            (string >> CustomFeedSource.parse) reader.Value
+            (string >> CustomFeedSource.Parse) reader.Value
             
-    type ExplicitRatingConverter () =
+    type ExplicitRatingConverter() =
-        inherit JsonConverter<ExplicitRating> ()
+        inherit JsonConverter<ExplicitRating>()
-        override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: ExplicitRating, _: JsonSerializer) =
-            writer.WriteValue (ExplicitRating.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: ExplicitRating, _: bool, _: JsonSerializer) =
-            (string >> ExplicitRating.parse) reader.Value
+            (string >> ExplicitRating.Parse) reader.Value
         
-    type MarkupTextConverter () =
+    type MarkupTextConverter() =
-        inherit JsonConverter<MarkupText> ()
+        inherit JsonConverter<MarkupText>()
-        override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
-            writer.WriteValue (MarkupText.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : MarkupText, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
-            (string >> MarkupText.parse) reader.Value
+            (string >> MarkupText.Parse) reader.Value
             
-    type PermalinkConverter () =
+    type PermalinkConverter() =
-        inherit JsonConverter<Permalink> ()
+        inherit JsonConverter<Permalink>()
-        override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
-            writer.WriteValue (Permalink.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : Permalink, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
             (string >> Permalink) reader.Value
 
-    type PageIdConverter () =
+    type PageIdConverter() =
-        inherit JsonConverter<PageId> ()
+        inherit JsonConverter<PageId>()
-        override _.WriteJson (writer : JsonWriter, value : PageId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
-            writer.WriteValue (PageId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
             (string >> PageId) reader.Value
 
-    type PodcastMediumConverter () =
+    type PodcastMediumConverter() =
-        inherit JsonConverter<PodcastMedium> ()
+        inherit JsonConverter<PodcastMedium>()
-        override _.WriteJson (writer : JsonWriter, value : PodcastMedium, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
-            writer.WriteValue (PodcastMedium.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : PodcastMedium, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
-            (string >> PodcastMedium.parse) reader.Value
+            (string >> PodcastMedium.Parse) reader.Value
 
-    type PostIdConverter () =
+    type PostIdConverter() =
-        inherit JsonConverter<PostId> ()
+        inherit JsonConverter<PostId>()
-        override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
-            writer.WriteValue (PostId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : PostId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
             (string >> PostId) reader.Value
 
-    type TagMapIdConverter () =
+    type TagMapIdConverter() =
-        inherit JsonConverter<TagMapId> ()
+        inherit JsonConverter<TagMapId>()
-        override _.WriteJson (writer : JsonWriter, value : TagMapId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: TagMapId, _: JsonSerializer) =
-            writer.WriteValue (TagMapId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : TagMapId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: TagMapId, _: bool, _: JsonSerializer) =
             (string >> TagMapId) reader.Value
 
-    type ThemeAssetIdConverter () =
+    type ThemeAssetIdConverter() =
-        inherit JsonConverter<ThemeAssetId> ()
+        inherit JsonConverter<ThemeAssetId>()
-        override _.WriteJson (writer : JsonWriter, value : ThemeAssetId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: ThemeAssetId, _: JsonSerializer) =
-            writer.WriteValue (ThemeAssetId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeAssetId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: ThemeAssetId, _: bool, _: JsonSerializer) =
-            (string >> ThemeAssetId.ofString) reader.Value
+            (string >> ThemeAssetId.Parse) reader.Value
 
-    type ThemeIdConverter () =
+    type ThemeIdConverter() =
-        inherit JsonConverter<ThemeId> ()
+        inherit JsonConverter<ThemeId>()
-        override _.WriteJson (writer : JsonWriter, value : ThemeId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: ThemeId, _: JsonSerializer) =
-            writer.WriteValue (ThemeId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: ThemeId, _: bool, _: JsonSerializer) =
             (string >> ThemeId) reader.Value
     
-    type UploadIdConverter () =
+    type UploadIdConverter() =
-        inherit JsonConverter<UploadId> ()
+        inherit JsonConverter<UploadId>()
-        override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: UploadId, _: JsonSerializer) =
-            writer.WriteValue (UploadId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: UploadId, _: bool, _: JsonSerializer) =
             (string >> UploadId) reader.Value
     
-    type WebLogIdConverter () =
+    type WebLogIdConverter() =
-        inherit JsonConverter<WebLogId> ()
+        inherit JsonConverter<WebLogId>()
-        override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: WebLogId, _: JsonSerializer) =
-            writer.WriteValue (WebLogId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: WebLogId, _: bool, _: JsonSerializer) =
             (string >> WebLogId) reader.Value
 
-    type WebLogUserIdConverter () =
+    type WebLogUserIdConverter() =
         inherit JsonConverter<WebLogUserId> ()
-        override _.WriteJson (writer : JsonWriter, value : WebLogUserId, _ : JsonSerializer) =
+        override _.WriteJson(writer: JsonWriter, value: WebLogUserId, _: JsonSerializer) =
-            writer.WriteValue (WebLogUserId.toString value)
+            writer.WriteValue(string value)
-        override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogUserId, _ : bool, _ : JsonSerializer) =
+        override _.ReadJson(reader: JsonReader, _: Type, _: WebLogUserId, _: bool, _: JsonSerializer) =
             (string >> WebLogUserId) reader.Value
 
     open Microsoft.FSharpLu.Json
@@ -128,27 +135,28 @@ module Json =
     /// Configure a serializer to use these converters
     let configure (ser : JsonSerializer) =
         // Our converters
-        [   CategoryIdConverter       () :> JsonConverter
+        [ CategoryIdConverter() :> JsonConverter
-            CommentIdConverter        ()
+          CommentIdConverter()
-            CustomFeedIdConverter     ()
+          CommentStatusConverter()
-            CustomFeedSourceConverter ()
+          CustomFeedIdConverter()
-            ExplicitRatingConverter   ()
+          CustomFeedSourceConverter()
-            MarkupTextConverter       ()
+          ExplicitRatingConverter()
-            PermalinkConverter        ()
+          MarkupTextConverter()
-            PageIdConverter           ()
+          PermalinkConverter()
-            PodcastMediumConverter    ()
+          PageIdConverter()
-            PostIdConverter           ()
+          PodcastMediumConverter()
-            TagMapIdConverter         ()
+          PostIdConverter()
-            ThemeAssetIdConverter     ()
+          TagMapIdConverter()
-            ThemeIdConverter          ()
+          ThemeAssetIdConverter()
-            UploadIdConverter         ()
+          ThemeIdConverter()
-            WebLogIdConverter         ()
+          UploadIdConverter()
-            WebLogUserIdConverter     ()
+          WebLogIdConverter()
-        ] |> List.iter ser.Converters.Add
+          WebLogUserIdConverter() ]
+        |> List.iter ser.Converters.Add
         // NodaTime
         let _ = ser.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
         // Handles DUs with no associated data, as well as option fields
-        ser.Converters.Add (CompactUnionJsonConverter ())
+        ser.Converters.Add(CompactUnionJsonConverter())
         ser.NullValueHandling     <- NullValueHandling.Ignore
         ser.MissingMemberHandling <- MissingMemberHandling.Ignore
         ser

src/MyWebLog.Data/Interfaces.fs

@@ -7,6 +7,7 @@ open Newtonsoft.Json
 open NodaTime
 
 /// The result of a category deletion attempt
+[<Struct>]
 type CategoryDeleteResult =
     /// The category was deleted successfully
     | CategoryDeleted
@@ -32,7 +33,7 @@ type ICategoryData =
     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>
@@ -53,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
@@ -84,7 +85,7 @@ type IPageData =
     abstract member FindListed : WebLogId -> Task<Page list>
     
     /// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks)
-    abstract member FindPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
+    abstract member FindPageOfPages : WebLogId -> pageNbr: int -> Task<Page list>
     
     /// Restore pages from a backup
     abstract member Restore : Page list -> Task<unit>
@@ -125,20 +126,20 @@ type IPostData =
     
     /// Find posts to be displayed on a category list page (excluding revisions and prior permalinks)
     abstract member FindPageOfCategorizedPosts :
-        WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
+        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>
+    abstract member FindPageOfPosts : WebLogId -> pageNbr: int -> postsPerPage: int -> Task<Post list>
     
     /// Find posts to be displayed on a page (excluding revisions and prior permalinks)
-    abstract member FindPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
+    abstract member FindPageOfPublishedPosts : WebLogId -> pageNbr: int -> postsPerPage: int -> Task<Post list>
     
     /// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks)
     abstract member FindPageOfTaggedPosts :
-        WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
+        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 : Instant -> 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>
@@ -259,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>
     

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -5,16 +5,17 @@
 	</ItemGroup>
 
 	<ItemGroup>
-		<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta2" />
+		<PackageReference Include="BitBadger.Documents.Postgres" Version="3.0.0-rc-2" />
-		<PackageReference Include="Microsoft.Data.Sqlite" Version="7.0.3" />
+		<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.0.0-rc-2" />
-		<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="7.0.0" />
+		<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.3" />
-		<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="7.0.0" />
+		<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.2" />
+		<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
-		<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.1" />
+		<PackageReference Include="Npgsql.NodaTime" Version="8.0.2" />
-		<PackageReference Include="Npgsql.NodaTime" Version="7.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="8.0.200" />
 	</ItemGroup>
 
 	<ItemGroup>
@@ -22,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" />
@@ -45,4 +46,10 @@
 		<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

@@ -2,38 +2,37 @@ namespace MyWebLog.Data.Postgres
 
 open System.Threading
 open System.Threading.Tasks
-open BitBadger.Npgsql.FSharp.Documents
+open BitBadger.Documents.Postgres
 open Microsoft.Extensions.Caching.Distributed
 open NodaTime
-open Npgsql.FSharp
 
 /// Helper types and functions for the cache
 [<AutoOpen>]
 module private Helpers =
     
     /// The cache entry
-    type Entry =
+    type Entry = {
-        {   /// The ID of the cache entry
+        /// The ID of the cache entry
-            Id : string
+        Id: string
         
         /// The value to be cached
-            Payload : byte[]
+        Payload: byte array
         
         /// When this entry will expire
-            ExpireAt : Instant
+        ExpireAt: Instant
         
         /// The duration by which the expiration should be pushed out when being refreshed
-            SlidingExpiration : Duration option
+        SlidingExpiration: Duration option
         
         /// The must-expire-by date/time for the cache entry
-            AbsoluteExpiration : Instant option
+        AbsoluteExpiration: Instant option
     }
     
     /// Run a task synchronously
-    let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
+    let sync<'T> (it: Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
     
     /// Get the current instant
-    let getNow () = SystemClock.Instance.GetCurrentInstant ()
+    let getNow () = SystemClock.Instance.GetCurrentInstant()
     
     /// Create a parameter for the expire-at time
     let expireParam =
@@ -49,9 +48,11 @@ type DistributedCache () =
         task {
             let! exists =
                 Custom.scalar
-                    $"SELECT EXISTS
+                    "SELECT EXISTS
                        (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
-                      AS {existsName}" [] Map.toExists
+                     AS it"
+                    []
+                    toExists
             if not exists then
                 do! Custom.nonQuery
                         "CREATE TABLE session (
@@ -69,7 +70,9 @@ type DistributedCache () =
     let getEntry key = backgroundTask {
         let idParam = "@id", Sql.string key
         let! tryEntry =
-            Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
+            Custom.single
+                "SELECT * FROM session WHERE id = @id"
+                [ idParam ]
                 (fun row ->
                       { Id                 = row.string                     "id"
                         Payload            = row.bytea                      "payload"
@@ -88,7 +91,8 @@ type DistributedCache () =
                     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"
+                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
@@ -101,17 +105,17 @@ type DistributedCache () =
     /// Purge expired entries every 30 minutes
     let purge () = backgroundTask {
         let now = getNow ()
-        if lastPurge.Plus (Duration.FromMinutes 30L) < now then
+        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 =
-        Delete.byId "session" key
+        Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
     
     /// Save an entry
-    let saveEntry (opts : DistributedCacheEntryOptions) key payload =
+    let saveEntry (opts: DistributedCacheEntryOptions) key payload =
         let now = getNow ()
         let expireAt, slideExp, absExp =
             if opts.SlidingExpiration.HasValue then
@@ -121,7 +125,7 @@ type DistributedCache () =
                 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)
+                let exp = now.Plus(Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
                 exp, None, Some exp
             else
                 // Default to 1 hour sliding expiration
@@ -146,7 +150,7 @@ type DistributedCache () =
     // ~~~ IMPLEMENTATION FUNCTIONS ~~~
     
     /// Retrieve the data for a cache entry
-    let get key (_ : CancellationToken) = backgroundTask {
+    let get key (_: CancellationToken) = backgroundTask {
         match! getEntry key with
         | Some entry ->
             do! purge ()
@@ -155,29 +159,29 @@ type DistributedCache () =
     }
     
     /// Refresh an entry
-    let refresh key (cancelToken : CancellationToken) = backgroundTask {
+    let refresh key (cancelToken: CancellationToken) = backgroundTask {
         let! _ = get key cancelToken
         ()
     }
     
     /// Remove an entry
-    let remove key (_ : CancellationToken) = backgroundTask {
+    let remove key (_: CancellationToken) = backgroundTask {
         do! removeEntry key
         do! purge ()
     }
     
     /// Set an entry
-    let set key value options (_ : CancellationToken) = backgroundTask {
+    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 _.GetAsync(key, token) = get key token
         member _.Refresh key = refresh key CancellationToken.None |> sync
-        member _.RefreshAsync (key, token) = refresh key token
+        member _.RefreshAsync(key, token) = refresh key token
         member _.Remove key = remove key CancellationToken.None |> sync
-        member _.RemoveAsync (key, token) = remove key token
+        member _.RemoveAsync(key, token) = remove key token
-        member _.Set (key, value, options) = set key value options CancellationToken.None |> sync
+        member _.Set(key, value, options) = set key value options CancellationToken.None |> sync
-        member _.SetAsync (key, value, options, token) = set key value options token
+        member _.SetAsync(key, value, options, token) = set key value options token

src/MyWebLog.Data/Postgres/PostgresCategoryData.fs

@@ -1,13 +1,14 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+type PostgresCategoryData(log: ILogger) =
     
     /// Count all categories for the given web log
     let countAll webLogId =
@@ -17,14 +18,20 @@ type PostgresCategoryData (log : ILogger) =
     /// Count all top-level categories for the given web log
     let countTopLevel webLogId =
         log.LogTrace "Category.countTopLevel"
-        Count.byContains Table.Category {| webLogDoc webLogId with ParentId = None |}
+        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}')"
+            Custom.list
-                        [ webLogContains webLogId ] fromData<Category>
+                $"{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
@@ -33,20 +40,18 @@ type PostgresCategoryData (log : ILogger) =
                 let catIdSql, catIdParams =
                     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)
                     |> List.ofSeq
-                    |> arrayContains (nameof Post.empty.CategoryIds) id
+                    |> arrayContains (nameof Post.Empty.CategoryIds) id
                 let postCount =
                     Custom.scalar
-                        $"""SELECT COUNT(DISTINCT id) AS {countName}
+                        $"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS it
                               FROM {Table.Post}
                              WHERE {Query.whereDataContains "@criteria"}
                                AND {catIdSql}"""
-                        [   "@criteria",
+                        [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catIdParams ]
-                                Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
+                        toCount
-                            catIdParams
-                        ] Map.toCount
                     |> Async.AwaitTask
                     |> Async.RunSynchronously
                 it.Id, postCount)
@@ -58,71 +63,72 @@ type PostgresCategoryData (log : ILogger) =
                     PostCount = counts
                                 |> List.tryFind (fun c -> fst c = cat.Id)
                                 |> Option.map snd
-                                |> Option.defaultValue 0
+                                |> 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 CategoryId.toString webLogId
+        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
     
-    /// Create parameters for a category insert / update
-    let catParameters (cat : Category) =
-        Query.docParameters (CategoryId.toString cat.Id) cat
-    
     /// 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 = CategoryId.toString catId |}
+            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 [
+                    |> Sql.executeTransactionAsync [ childQuery, childParams ]
-                        Query.Update.partialById Table.Category,
-                        children |> List.map (fun child -> [
-                            "@id",   Sql.string (CategoryId.toString child.Id)
-                            "@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
-                        ])
-                    ]
                 ()
             // 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"
+                Custom.list
-                            [ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post>
+                    $"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 [
+                    |> Sql.executeTransactionAsync
-                        Query.Update.partialById Table.Post,
+                        [ Query.Patch.byId Table.Post,
-                        posts |> List.map (fun post -> [
+                          posts
-                            "@id",   Sql.string (PostId.toString post.Id)
+                          |> List.map (fun post ->
-                            "@data", Query.jsonbDocParam
+                              [ idParam post.Id
-                                        {| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
+                                jsonParam
-                        ])
+                                    "@data"
-                    ]
+                                    {| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} ]) ]
                 ()
             // Delete the category itself
-            do! Delete.byId Table.Category (CategoryId.toString catId)
+            do! Delete.byId Table.Category catId
             return if hasChildren then ReassignedChildCategories else CategoryDeleted
         | None -> return CategoryNotFound
     }
     
     /// Save a category
-    let save (cat : Category) = backgroundTask {
+    let save (cat: Category) = backgroundTask {
         log.LogTrace "Category.save"
-        do! save Table.Category (CategoryId.toString cat.Id) cat
+        do! save Table.Category cat
     }
     
     /// Restore categories from a backup
@@ -132,7 +138,7 @@ type PostgresCategoryData (log : ILogger) =
             Configuration.dataSource ()
             |> Sql.fromDataSource
             |> Sql.executeTransactionAsync [
-                Query.insert Table.Category, cats |> List.map catParameters
+                Query.insert Table.Category, cats |> List.map (fun c -> [ jsonParam "@data" c ])
             ]
         ()
     }

src/MyWebLog.Data/Postgres/PostgresHelpers.fs

@@ -61,7 +61,8 @@ module Table =
 
 open System
 open System.Threading.Tasks
-open BitBadger.Npgsql.FSharp.Documents
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
 open MyWebLog
 open MyWebLog.Data
 open NodaTime
@@ -69,29 +70,23 @@ open Npgsql
 open Npgsql.FSharp
 
 /// Create a SQL parameter for the web log ID
-let webLogIdParam webLogId =
+let webLogIdParam (webLogId: WebLogId) =
-    "@webLogId", Sql.string (WebLogId.toString webLogId)
+    "@webLogId", Sql.string (string webLogId)
 
 /// Create an anonymous record with the given web log ID
-let webLogDoc (webLogId : WebLogId) =
+let webLogDoc (webLogId: WebLogId) =
     {| WebLogId = webLogId |}
 
 /// Create a parameter for a web log document-contains query
 let webLogContains webLogId =
-    "@criteria", Query.jsonbDocParam (webLogDoc webLogId)
+    jsonParam "@criteria" (webLogDoc webLogId)
-
-/// The name of the field to select to be able to use Map.toCount
-let countName = "the_count"
-
-/// The name of the field to select to be able to use Map.toExists
-let existsName = "does_exist"
 
 /// 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 (valueFunc: 'T -> string) (items : 'T list) =
+let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
     if List.isEmpty items then "", []
     else
         let mutable idx = 0
@@ -99,87 +94,79 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
         |> List.skip 1
         |> List.fold (fun (itemS, itemP) it ->
             idx <- idx + 1
-            $"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
+            $"{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 (valueFunc 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) =
+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 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) =
+let typedParam<'T> name (it: 'T) =
-    $"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
+    $"@%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 optParam<'T> name (it: 'T option) =
-    let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
+    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 =
     
-    /// Get a count from a row
-    let toCount (row : RowReader) =
-        row.int countName
-    
-    /// Get a true/false value as to whether an item exists
-    let toExists (row : RowReader) =
-        row.bool existsName
-    
     /// Create a permalink from the current row
-    let toPermalink (row : RowReader) =
+    let toPermalink (row: RowReader) =
         Permalink (row.string "permalink")
     
     /// Create a revision from the current row
-    let toRevision (row : RowReader) : Revision =
+    let toRevision (row: RowReader) : Revision =
         { AsOf = row.fieldValue<Instant> "as_of"
-            Text = row.string              "revision_text" |> MarkupText.parse
+          Text = row.string              "revision_text" |> MarkupText.Parse }
-        }
     
     /// Create a theme asset from the current row
-    let toThemeAsset includeData (row : RowReader) : ThemeAsset =
+    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 [||]
+          Data      = if includeData then row.bytea "data" else [||] }
-        }
     
     /// Create an uploaded file from the current row
-    let toUpload includeData (row : RowReader) : Upload =
+    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 [||]
+          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) (keyFunc : 'TKey -> string) webLogId =
+    let existsByWebLog<'TKey> table (key: 'TKey) webLogId =
         Custom.scalar
-            $""" SELECT EXISTS (
+            $"""SELECT EXISTS (
-                          SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
+                    SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}
-                        ) AS {existsName}"""
+                    ) AS it"""
-            [ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
+            [ "@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) (keyFunc : 'TKey -> string) webLogId =
+    let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
-        Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
+        Custom.single
-                      [ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
+            $"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
+            [ "@id", Sql.string (string key); webLogContains webLogId ]
+            fromData<'TDoc>
     
-    /// Find a document by its ID for the given web log
+    /// Find documents for the given web log
     let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
         Find.byContains table (webLogDoc webLogId)
 
@@ -188,25 +175,28 @@ module Document =
 module Revisions =
     
     /// Find all revisions for the given entity
-    let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
+    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"
+        Custom.list
-                    [ "@id", Sql.string (keyFunc key) ] Map.toRevision
+            $"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 =
+    let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId =
         Custom.list
             $"""SELECT pr.*
                   FROM %s{revTable} pr
-                       INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
+                       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)
+            [ webLogContains webLogId ]
+            (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
 
     /// Parameters for a revision INSERT statement
-    let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
+    let revParams<'TKey> (key: 'TKey) rev = [
         typedParam "asOf" rev.AsOf
-        "@id",   Sql.string (keyFunc key)
+        "@id",   Sql.string (string key)
-        "@text", Sql.string (MarkupText.toString rev.Text)
+        "@text", Sql.string (string rev.Text)
     ]
     
     /// The SQL statement to insert a revision
@@ -214,23 +204,20 @@ module Revisions =
         $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
     
     /// Update a page's revisions
-    let update<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask {
+    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 [
+                |> Sql.executeTransactionAsync
-                    if not (List.isEmpty toDelete) then
+                    [ if not (List.isEmpty toDelete) then
                         $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
                         toDelete
-                        |> List.map (fun it -> [
+                        |> List.map (fun it ->
-                            "@id", Sql.string (keyFunc key)
+                            [ "@id", Sql.string (string key)
-                            typedParam "asOf" it.AsOf
+                              typedParam "asOf" it.AsOf ])
-                        ])
                       if not (List.isEmpty toAdd) then
-                        insertSql revTable, toAdd |> List.map (revParams key keyFunc)
+                        insertSql revTable, toAdd |> List.map (revParams key) ]
-                ]
             ()
     }
-

src/MyWebLog.Data/Postgres/PostgresPageData.fs

@@ -1,44 +1,55 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+type PostgresPageData(log: ILogger) =
     
     // SUPPORT FUNCTIONS
     
     /// Append revisions to a page
-    let appendPageRevisions (page : Page) = backgroundTask {
+    let appendPageRevisions (page: Page) = backgroundTask {
         log.LogTrace "Page.appendPageRevisions"
-        let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
+        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) =
+    let pageWithoutText (row: RowReader) =
         { fromData<Page> row with Text = "" }
     
     /// Update a page's revisions
-    let updatePageRevisions pageId oldRevs newRevs =
+    let updatePageRevisions (pageId: PageId) oldRevs newRevs =
         log.LogTrace "Page.updatePageRevisions"
-        Revisions.update Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs
+        Revisions.update Table.PageRevision Table.Page pageId oldRevs newRevs
     
     /// Does the given page exist?
-    let pageExists pageId webLogId =
+    let pageExists (pageId: PageId) webLogId =
         log.LogTrace "Page.pageExists"
-        Document.existsByWebLog Table.Page pageId PageId.toString webLogId
+        Document.existsByWebLog Table.Page pageId webLogId
     
     // IMPLEMENTATION FUNCTIONS
     
-    /// Get all pages for a web log (without text or revisions)
+    /// 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}')"
+        Custom.list
-                    [ webLogContains webLogId ] fromData<Page>
+            $"{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 =
@@ -50,50 +61,61 @@ type PostgresPageData (log : ILogger) =
         log.LogTrace "Page.countListed"
         Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
     
-    /// Find a page by its ID (without revisions)
+    /// Find a page by its ID (without revisions or prior permalinks)
-    let findById pageId webLogId =
+    let findById pageId webLogId = backgroundTask {
         log.LogTrace "Page.findById"
-        Document.findByIdAndWebLog<PageId, Page> Table.Page pageId PageId.toString webLogId
+        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! findById pageId webLogId with
+        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! Delete.byId Table.Page (PageId.toString pageId)
+            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 webLogId =
+    let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
         log.LogTrace "Page.findByPermalink"
-        Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
+        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 webLogId = backgroundTask {
+    let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
         log.LogTrace "Page.findCurrentPermalink"
         if List.isEmpty permalinks then return None
         else
-            let linkSql, linkParam =
+            let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
-                arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
             return!
                 Custom.single
-                    $"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
+                    $"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
                           FROM page
                          WHERE {Query.whereDataContains "@criteria"}
-                           AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
+                           AND {linkSql}"""
+                    [ webLogContains webLogId; linkParam ]
+                    Map.toPermalink
     }
     
     /// Get all complete pages for the given web log
@@ -110,8 +132,9 @@ type PostgresPageData (log : ILogger) =
     /// 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}')"
+        Custom.list
-                    [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
+            $"{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)
@@ -119,49 +142,49 @@ type PostgresPageData (log : ILogger) =
         log.LogTrace "Page.findPageOfPages"
         Custom.list
             $"{selectWithCriteria Table.Page}
-               ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
+               ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
                LIMIT @pageSize OFFSET @toSkip"
             [ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
-            fromData<Page>
+            (fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] })
     
     /// Restore pages from a backup
-    let restore (pages : Page list) = backgroundTask {
+    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 [
+            |> Sql.executeTransactionAsync
-                Query.insert Table.Page,
+                [ Query.insert Table.Page,
-                pages
+                    pages |> List.map (fun page -> [ jsonParam "@data" { page with Revisions = [] } ])
-                |> List.map (fun page -> Query.docParameters (PageId.toString page.Id) { page with Revisions = [] })
                   Revisions.insertSql Table.PageRevision,
-                    revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev)
+                    revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId rev) ]
-            ]
         ()
     }
     
-    /// Save a page
+    /// Update a page
-    let save (page : Page) = backgroundTask {
+    let update (page: Page) = backgroundTask {
-        log.LogTrace "Page.save"
+        log.LogTrace "Page.update"
-        let! oldPage = findFullById page.Id page.WebLogId
+        match! findFullById page.Id page.WebLogId with
-        do! save Table.Page (PageId.toString page.Id) { page with Revisions = [] }
+        | Some oldPage ->
-        do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
+            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 = backgroundTask {
+    let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
         log.LogTrace "Page.updatePriorPermalinks"
         match! pageExists pageId webLogId with
         | true ->
-            do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |}
+            do! Patch.byId Table.Page pageId {| PriorPermalinks = permalinks |}
             return true
         | false -> return false
     }
     
     interface IPageData with
-        member _.Add page = save page
+        member _.Add page = add page
         member _.All webLogId = all webLogId
         member _.CountAll webLogId = countAll webLogId
         member _.CountListed webLogId = countListed webLogId
@@ -174,5 +197,5 @@ type PostgresPageData (log : ILogger) =
         member _.FindListed webLogId = findListed webLogId
         member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
         member _.Restore pages = restore pages
-        member _.Update page = save page
+        member _.Update page = update page
         member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

src/MyWebLog.Data/Postgres/PostgresPostData.fs

@@ -1,62 +1,77 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
 open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
-open NodaTime.Text
+open NodaTime
 open Npgsql.FSharp
 
 /// PostgreSQL myWebLog post data implementation
-type PostgresPostData (log : ILogger) =
+type PostgresPostData(log: ILogger) =
 
     // SUPPORT FUNCTIONS
     
     /// Append revisions to a post
-    let appendPostRevisions (post : Post) = backgroundTask {
+    let appendPostRevisions (post: Post) = backgroundTask {
         log.LogTrace "Post.appendPostRevisions"
-        let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
+        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 =
-        { fromData<Post> row with Text = "" }
+        { postWithoutLinks row with Text = "" }
     
     /// Update a post's revisions
-    let updatePostRevisions postId oldRevs newRevs =
+    let updatePostRevisions (postId: PostId) oldRevs newRevs =
         log.LogTrace "Post.updatePostRevisions"
-        Revisions.update Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs
+        Revisions.update Table.PostRevision Table.Post postId oldRevs newRevs
     
     /// Does the given post exist?
-    let postExists postId webLogId =
+    let postExists (postId: PostId) webLogId =
         log.LogTrace "Post.postExists"
-        Document.existsByWebLog Table.Post postId PostId.toString webLogId
+        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 webLogId =
+    let countByStatus (status: PostStatus) webLogId =
         log.LogTrace "Post.countByStatus"
-        Count.byContains Table.Post {| webLogDoc webLogId with Status = PostStatus.toString status |}
+        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 =
+    let findById postId webLogId = backgroundTask {
         log.LogTrace "Post.findById"
-        Document.findByIdAndWebLog<PostId, Post> Table.Post postId PostId.toString webLogId
+        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 and prior permalinks)
+    /// Find a post by its permalink for the given web log (excluding revisions)
-    let findByPermalink permalink webLogId =
+    let findByPermalink (permalink: Permalink) webLogId =
         log.LogTrace "Post.findByPermalink"
-        Custom.single (selectWithCriteria Table.Post)
+        Custom.single
-                      [ "@criteria",
+            (selectWithCriteria Table.Post)
-                          Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Permalink = permalink |} ]
-                      ] fromData<Post>
+            postWithoutLinks
     
     /// Find a complete post by its ID for the given web log
     let findFullById postId webLogId = backgroundTask {
         log.LogTrace "Post.findFullById"
-        match! findById postId webLogId with
+        match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
         | Some post ->
             let! withRevisions = appendPostRevisions post
             return Some withRevisions
@@ -68,28 +83,29 @@ type PostgresPostData (log : ILogger) =
         log.LogTrace "Post.delete"
         match! postExists postId webLogId with
         | true ->
-            let theId = PostId.toString postId
             do! Custom.nonQuery
                     $"""DELETE FROM {Table.PostComment}  WHERE {Query.whereDataContains "@criteria"};
-                        DELETE FROM {Table.Post}        WHERE id = @id"""
+                        DELETE FROM {Table.PostRevision} WHERE post_id = @id;
-                    [ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
+                        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 webLogId = backgroundTask {
+    let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
         log.LogTrace "Post.findCurrentPermalink"
         if List.isEmpty permalinks then return None
         else
-            let linkSql, linkParam =
+            let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks
-                arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
             return!
                 Custom.single
-                    $"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
+                    $"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
                           FROM {Table.Post}
                          WHERE {Query.whereDataContains "@criteria"}
-                           AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
+                           AND {linkSql}"""
+                    [ webLogContains webLogId; linkParam ]
+                    Map.toPermalink
     }
     
     /// Get all complete posts for the given web log
@@ -104,79 +120,73 @@ type PostgresPostData (log : ILogger) =
     }
     
     /// Get a page of categorized posts for the given web log (excludes revisions)
-    let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
+    let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
         log.LogTrace "Post.findPageOfCategorizedPosts"
-        let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
+        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
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-            [   "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catParam ]
-                catParam
+            postWithoutLinks
-            ] fromData<Post>
     
     /// 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,
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
-                        data ->> '{nameof Post.empty.UpdatedOn}'
+                        data ->> '{nameof Post.Empty.UpdatedOn}'
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-            [ webLogContains webLogId ] postWithoutText
+            [ 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
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-            [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
-            fromData<Post>
+            postWithoutLinks
     
     /// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
-    let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
+    let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
         log.LogTrace "Post.findPageOfTaggedPosts"
         Custom.list
             $"{selectWithCriteria Table.Post}
-                 AND data['{nameof Post.empty.Tags}'] @> @tag
+                 AND data['{nameof Post.Empty.Tags}'] @> @tag
-               ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-            [   "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
-                "@tag",      Query.jsonbDocParam [| tag |]
+            postWithoutLinks
-            ] fromData<Post>
     
     /// Find the next newest and oldest post from a publish date for the given web log
-    let findSurroundingPosts webLogId publishedOn = backgroundTask {
+    let findSurroundingPosts webLogId (publishedOn: Instant) = backgroundTask {
         log.LogTrace "Post.findSurroundingPosts"
-        let queryParams () = [
+        let queryParams () =
-            "@criteria",    Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
+            [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
-            "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
+              "@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
-        ]
+        let query op direction =
-        let pubField  = nameof Post.empty.PublishedOn
-        let! older =
-            Custom.list
             $"{selectWithCriteria Table.Post}
-                     AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
+                 AND (data ->> '{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
-                   ORDER BY data ->> '{pubField}' DESC
+               ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' %s{direction}
-                   LIMIT 1" (queryParams ()) fromData<Post>
+               LIMIT 1"
-        let! newer =
+        let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
-            Custom.list
+        let! newer = Custom.list (query ">" "")     (queryParams ()) postWithoutLinks
-                $"{selectWithCriteria Table.Post}
-                     AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
-                   ORDER BY data ->> '{pubField}'
-                   LIMIT 1" (queryParams ()) fromData<Post>
         return List.tryHead older, List.tryHead newer
     }
     
-    /// Save a post
+    /// Update a post
-    let save (post : Post) = backgroundTask {
+    let update (post : Post) = backgroundTask {
         log.LogTrace "Post.save"
-        let! oldPost = findFullById post.Id post.WebLogId
+        match! findFullById post.Id post.WebLogId with
-        do! save Table.Post (PostId.toString post.Id) { post with Revisions = [] }
+        | Some oldPost ->
-        do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
+            do! Update.byId Table.Post post.Id { post with Revisions = [] }
+            do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
+        | None -> ()
     }
     
     /// Restore posts from a backup
@@ -186,28 +196,26 @@ type PostgresPostData (log : ILogger) =
         let! _ =
             Configuration.dataSource ()
             |> Sql.fromDataSource
-            |> Sql.executeTransactionAsync [
+            |> Sql.executeTransactionAsync
-                Query.insert Table.Post,
+                [ Query.insert Table.Post,
-                posts
+                    posts |> List.map (fun post -> [ jsonParam "@data" { post with Revisions = [] } ])
-                |> List.map (fun post -> Query.docParameters (PostId.toString post.Id) { post with Revisions = [] })
                   Revisions.insertSql Table.PostRevision,
-                    revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev)
+                    revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId rev) ]
-            ]
         ()
     }
     
     /// Update prior permalinks for a post
-    let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
+    let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
         log.LogTrace "Post.updatePriorPermalinks"
         match! postExists postId webLogId with
         | true ->
-            do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |}
+            do! Patch.byId Table.Post postId {| PriorPermalinks = permalinks |}
             return true
         | false -> return false
     }
     
     interface IPostData with
-        member _.Add post = save post
+        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
@@ -224,5 +232,5 @@ type PostgresPostData (log : ILogger) =
             findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
         member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
         member _.Restore posts = restore posts
-        member _.Update post = save post
+        member _.Update post = update post
         member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

src/MyWebLog.Data/Postgres/PostgresTagMapData.fs

@@ -1,62 +1,65 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+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 TagMapId.toString webLogId
+        Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId
     
     /// Delete a tag mapping for the given web log
-    let delete tagMapId webLogId = backgroundTask {
+    let delete (tagMapId: TagMapId) webLogId = backgroundTask {
         log.LogTrace "TagMap.delete"
-        let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
+        let! exists = Document.existsByWebLog Table.TagMap tagMapId webLogId
         if exists then
-            do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
+            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 =
+    let findByUrlValue (urlValue: string) webLogId =
         log.LogTrace "TagMap.findByUrlValue"
-        Custom.single (selectWithCriteria Table.TagMap)
+        Find.firstByContains<TagMap> Table.TagMap {| webLogDoc webLogId with UrlValue = urlValue |}
-                      [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
-                      fromData<TagMap>
 
     /// 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 ]
+        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
+        let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
-        Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
+        Custom.list
+            $"{selectWithCriteria Table.TagMap} AND {tagSql}"
+            [ webLogContains webLogId; tagParam ]
             fromData<TagMap>
     
     /// Save a tag mapping
-    let save (tagMap : TagMap) =
+    let save (tagMap: TagMap) =
-        save Table.TagMap (TagMapId.toString tagMap.Id) tagMap
+        log.LogTrace "TagMap.save"
+        save Table.TagMap tagMap
     
     /// Restore tag mappings from a backup
-    let restore (tagMaps : TagMap list) = backgroundTask {
+    let restore (tagMaps: TagMap list) = backgroundTask {
         let! _ =
             Configuration.dataSource ()
             |> Sql.fromDataSource
-            |> Sql.executeTransactionAsync [
+            |> Sql.executeTransactionAsync
-                Query.insert Table.TagMap,
+                [ Query.insert Table.TagMap,
-                tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)
+                    tagMaps |> List.map (fun tagMap -> [ jsonParam "@data" tagMap ]) ]
-            ]
         ()
     }
     

src/MyWebLog.Data/Postgres/PostgresThemeData.fs

@@ -1,13 +1,13 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+open BitBadger.Documents
+open BitBadger.Documents.Postgres
 open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data
-open Npgsql.FSharp
 
 /// PostreSQL myWebLog theme data implementation
-type PostgresThemeData (log : ILogger) =
+type PostgresThemeData(log: ILogger) =
     
     /// Clear out the template text from a theme
     let withoutTemplateText row =
@@ -17,40 +17,48 @@ type PostgresThemeData (log : ILogger) =
     /// Retrieve all themes (except 'admin'; excludes template text)
     let all () =
         log.LogTrace "Theme.all"
-        Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" []  withoutTemplateText
+        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 =
+    let exists (themeId: ThemeId) =
         log.LogTrace "Theme.exists"
-        Exists.byId Table.Theme (ThemeId.toString themeId)
+        Exists.byId Table.Theme themeId
     
     /// Find a theme by its ID
-    let findById themeId =
+    let findById (themeId: ThemeId) =
         log.LogTrace "Theme.findById"
-        Find.byId<Theme> Table.Theme (ThemeId.toString themeId)
+        Find.byId<ThemeId, Theme> Table.Theme themeId
     
     /// Find a theme by its ID (excludes the text of templates)
-    let findByIdWithoutText themeId =
+    let findByIdWithoutText (themeId: ThemeId) =
         log.LogTrace "Theme.findByIdWithoutText"
-        Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
+        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! Delete.byId Table.Theme (ThemeId.toString themeId)
+            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) =
+    let save (theme: Theme) =
         log.LogTrace "Theme.save"
-        save Table.Theme (ThemeId.toString theme.Id) theme
+        save Table.Theme theme
     
     interface IThemeData with
-        member _.All () = all ()
+        member _.All() = all ()
         member _.Delete themeId = delete themeId
         member _.Exists themeId = exists themeId
         member _.FindById themeId = findById themeId
@@ -59,7 +67,7 @@ type PostgresThemeData (log : ILogger) =
 
 
 /// PostreSQL myWebLog theme data implementation
-type PostgresThemeAssetData (log : ILogger) =
+type PostgresThemeAssetData(log: ILogger) =
     
     /// Get all theme assets (excludes data)
     let all () =
@@ -67,32 +75,34 @@ type PostgresThemeAssetData (log : ILogger) =
         Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
     
     /// Delete all assets for the given theme
-    let deleteByTheme themeId =
+    let deleteByTheme (themeId: ThemeId) =
         log.LogTrace "ThemeAsset.deleteByTheme"
-        Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
+        Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
-                        [ "@themeId", Sql.string (ThemeId.toString 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 = @themeId AND path = @path"
+        Custom.single
-                      [ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
+            $"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 =
+    let findByTheme (themeId: ThemeId) =
         log.LogTrace "ThemeAsset.findByTheme"
-        Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
+        Custom.list
-                    [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
+            $"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 =
+    let findByThemeWithData (themeId: ThemeId) =
         log.LogTrace "ThemeAsset.findByThemeWithData"
-        Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
+        Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] (Map.toThemeAsset true)
-                    [ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
     
     /// Save a theme asset
-    let save (asset : ThemeAsset) =
+    let save (asset: ThemeAsset) =
         log.LogTrace "ThemeAsset.save"
         let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
         Custom.nonQuery
@@ -109,7 +119,7 @@ type PostgresThemeAssetData (log : ILogger) =
               typedParam "updatedOn" asset.UpdatedOn ]
     
     interface IThemeAssetData with
-        member _.All () = all ()
+        member _.All() = all ()
         member _.DeleteByTheme themeId = deleteByTheme themeId
         member _.FindById assetId = findById assetId
         member _.FindByTheme themeId = findByTheme themeId

src/MyWebLog.Data/Postgres/PostgresUploadData.fs

@@ -1,13 +1,13 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+type PostgresUploadData(log: ILogger) =
 
     /// The INSERT statement for an uploaded file
     let upInsert = $"
@@ -18,13 +18,12 @@ type PostgresUploadData (log : ILogger) =
         )"
     
     /// Parameters for adding an uploaded file
-    let upParams (upload : Upload) = [
+    let upParams (upload: Upload) =
-        webLogIdParam upload.WebLogId
+        [ webLogIdParam upload.WebLogId
           typedParam "updatedOn" upload.UpdatedOn
-        "@id",   Sql.string (UploadId.toString upload.Id)
+          idParam upload.Id
-        "@path", Sql.string (Permalink.toString upload.Path)
+          "@path", Sql.string (string upload.Path)
-        "@data", Sql.bytea  upload.Data
+          "@data", Sql.bytea  upload.Data ]
-    ]
     
     /// Save an uploaded file
     let add upload =
@@ -34,32 +33,40 @@ type PostgresUploadData (log : ILogger) =
     /// Delete an uploaded file by its ID
     let delete uploadId webLogId = backgroundTask {
         log.LogTrace "Upload.delete"
-        let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
+        let idParam = [ idParam uploadId ]
         let! path =
-            Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
+            Custom.single
-                          (webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
+                $"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 (Query.Delete.byId Table.Upload) idParam
+            do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" idParam
             return Ok path.Value
-        else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
+        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"
+        Custom.single
-                      [ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true)
+            $"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"
+        Custom.list
-                    [ webLogIdParam webLogId ] (Map.toUpload false)
+            $"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 ]
+        Custom.list
+            $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
+            [ webLogIdParam webLogId ]
             (Map.toUpload true)
     
     /// Restore uploads from a backup

src/MyWebLog.Data/Postgres/PostgresWebLogData.fs

@@ -1,17 +1,18 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+type PostgresWebLogData(log: ILogger) =
     
     /// Add a web log
-    let add (webLog : WebLog) =
+    let add (webLog: WebLog) =
         log.LogTrace "WebLog.add"
-        insert Table.WebLog (WebLogId.toString webLog.Id) webLog
+        insert Table.WebLog webLog
     
     /// Retrieve all web logs
     let all () =
@@ -23,46 +24,60 @@ type PostgresWebLogData (log : ILogger) =
         log.LogTrace "WebLog.delete"
         Custom.nonQuery
             $"""DELETE FROM {Table.PostComment}
-                 WHERE data ->> '{nameof Comment.empty.PostId}' IN
+                 WHERE data ->> '{nameof Comment.Empty.PostId}'
-                           (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
+                         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 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) =
+    let findByHost (url: string) =
         log.LogTrace "WebLog.findByHost"
-        Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
+        Find.firstByContains<WebLog> Table.WebLog {| UrlBase = url |}
-                      fromData<WebLog>
     
     /// Find a web log by its ID
-    let findById webLogId = 
+    let findById (webLogId: WebLogId) = 
         log.LogTrace "WebLog.findById"
-        Find.byId<WebLog> Table.WebLog (WebLogId.toString webLogId)
+        Find.byId<WebLogId, WebLog> Table.WebLog webLogId
     
-    /// Update settings for a web log
+    /// Update redirect rules for a web log
-    let updateSettings (webLog : WebLog) =
+    let updateRedirectRules (webLog: WebLog) = backgroundTask {
-        log.LogTrace "WebLog.updateSettings"
+        log.LogTrace "WebLog.updateRedirectRules"
-        Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog
-    
-    /// Update RSS options for a web log
-    let updateRssOptions (webLog : WebLog) = backgroundTask {
-        log.LogTrace "WebLog.updateRssOptions"
         match! findById webLog.Id with
-        | Some _ -> do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| Rss = webLog.Rss |}
+        | 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 _.All() = all ()
         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/Postgres/PostgresWebLogUserData.fs

@@ -1,18 +1,24 @@
 namespace MyWebLog.Data.Postgres
 
-open BitBadger.Npgsql.FSharp.Documents
+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) =
+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 WebLogUserId.toString webLogId
+        Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId
     
     /// Delete a user if they have no posts or pages
     let delete userId webLogId = backgroundTask {
@@ -22,73 +28,70 @@ type PostgresWebLogUserData (log : ILogger) =
             let  criteria = Query.whereDataContains "@criteria"
             let! isAuthor =
                 Custom.scalar
-                    $" SELECT (   EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
+                    $" SELECT (   EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria})
                                OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
-                              ) AS {existsName}"
+                              ) AS it"
-                    [ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ] Map.toExists
+                    [ jsonParam "@criteria" {| AuthorId = userId |} ]
+                    toExists
             if isAuthor then
                 return Error "User has pages or posts; cannot delete"
             else
-                do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
+                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 =
+    let findByEmail (email: string) webLogId =
         log.LogTrace "WebLogUser.findByEmail"
-        Custom.single (selectWithCriteria Table.WebLogUser)
+        Find.firstByContains<WebLogUser> Table.WebLogUser {| webLogDoc webLogId with Email = email |}
-                      [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
-                      fromData<WebLogUser>
     
     /// 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}')"
+            $"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')"
-            [ webLogContains webLogId ] fromData<WebLogUser>
+            [ webLogContains webLogId ]
+            fromData<WebLogUser>
     
     /// Find the names of users by their IDs for the given web log
-    let findNames webLogId userIds = backgroundTask {
+    let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
         log.LogTrace "WebLogUser.findNames"
-        let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
+        let idSql, idParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" userIds
         let! users =
-            Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
+            Custom.list
+                $"{selectWithCriteria Table.WebLogUser} {idSql}"
+                (webLogContains webLogId :: idParams)
                 fromData<WebLogUser>
-        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 })
     }
     
     /// Restore users from a backup
-    let restore (users : WebLogUser list) = backgroundTask {
+    let restore (users: WebLogUser list) = backgroundTask {
         log.LogTrace "WebLogUser.restore"
         let! _ =
             Configuration.dataSource ()
             |> Sql.fromDataSource
-            |> Sql.executeTransactionAsync [
+            |> Sql.executeTransactionAsync
-                Query.insert Table.WebLogUser,
+                [ Query.insert Table.WebLogUser, users |> List.map (fun user -> [ jsonParam "@data" user ]) ]
-                users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user)
-            ]
         ()
     }
     
     /// Set a user's last seen date/time to now
-    let setLastSeen userId webLogId = backgroundTask {
+    let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
         log.LogTrace "WebLogUser.setLastSeen"
-        match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
+        match! Document.existsByWebLog Table.WebLogUser userId webLogId with
-        | true ->
+        | true -> do! Patch.byId Table.WebLogUser userId {| LastSeenOn = Some (Noda.now ()) |}
-            do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
         | false -> ()
     }
     
-    /// Save a user
+    /// Update a user
-    let save (user : WebLogUser) =
+    let update (user: WebLogUser) =
-        log.LogTrace "WebLogUser.save"
+        log.LogTrace "WebLogUser.update"
-        save Table.WebLogUser (WebLogUserId.toString user.Id) user
+        Update.byId Table.WebLogUser user.Id user
     
     interface IWebLogUserData with
-        member _.Add user = save user
+        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
@@ -96,5 +99,4 @@ type PostgresWebLogUserData (log : ILogger) =
         member _.FindNames webLogId userIds = findNames webLogId userIds
         member _.Restore users = restore users
         member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
-        member _.Update user = save user
+        member _.Update user = update user
-

src/MyWebLog.Data/PostgresData.fs

@@ -1,43 +1,34 @@
 namespace MyWebLog.Data
 
-open BitBadger.Npgsql.Documents
+open BitBadger.Documents
-open BitBadger.Npgsql.FSharp.Documents
+open BitBadger.Documents.Postgres
 open Microsoft.Extensions.Logging
 open MyWebLog
 open MyWebLog.Data.Postgres
 open Newtonsoft.Json
-open Npgsql
 open Npgsql.FSharp
 
 /// Data implementation for PostgreSQL
-type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser : JsonSerializer) =
+type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
     
     /// Create any needed tables
     let ensureTables () = backgroundTask {
         // Set up the PostgreSQL document store
-        Configuration.useDataSource source
+        Configuration.useSerializer (Utils.createDocumentSerializer ser)
-        Configuration.useSerializer
-            { new IDocumentSerializer with
-                member _.Serialize<'T> (it : 'T) : string = Utils.serialize ser it
-                member _.Deserialize<'T> (it : string) : 'T = Utils.deserialize ser it
-            }
         
         let! tables =
-            Sql.fromDataSource source
+            Custom.list
-            |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
+                "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" [] (fun row -> row.string "tablename")
-            |> Sql.executeAsync (fun row -> row.string "tablename")
         let needsTable table = not (List.contains table tables)
-        // Create a document table
-        let mutable isNew = false
         
         let sql = seq {
             // Theme tables
             if needsTable Table.Theme then
-                isNew <- true
+                Query.Definition.ensureTable Table.Theme
-                Definition.createTable Table.Theme
+                Query.Definition.ensureKey   Table.Theme
             if needsTable Table.ThemeAsset then
                 $"CREATE TABLE {Table.ThemeAsset} (
-                    theme_id    TEXT        NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE,
+                    theme_id    TEXT        NOT NULL,
                     path        TEXT        NOT NULL,
                     updated_on  TIMESTAMPTZ NOT NULL,
                     data        BYTEA       NOT NULL,
@@ -45,84 +36,90 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
             
             // Web log table
             if needsTable Table.WebLog then
-                Definition.createTable Table.WebLog
+                Query.Definition.ensureTable         Table.WebLog
-                Definition.createIndex Table.WebLog Optimized
+                Query.Definition.ensureKey           Table.WebLog
+                Query.Definition.ensureDocumentIndex Table.WebLog Optimized
             
             // Category table
             if needsTable Table.Category then
-                Definition.createTable Table.Category
+                Query.Definition.ensureTable         Table.Category
-                Definition.createIndex Table.Category Optimized
+                Query.Definition.ensureKey           Table.Category
+                Query.Definition.ensureDocumentIndex Table.Category Optimized
             
             // Web log user table
             if needsTable Table.WebLogUser then
-                Definition.createTable Table.WebLogUser
+                Query.Definition.ensureTable         Table.WebLogUser
-                Definition.createIndex Table.WebLogUser Optimized
+                Query.Definition.ensureKey           Table.WebLogUser
+                Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
             
             // Page tables
             if needsTable Table.Page then
-                Definition.createTable Table.Page
+                Query.Definition.ensureTable   Table.Page
-                $"CREATE INDEX page_web_log_idx   ON {Table.Page} ((data ->> '{nameof Page.empty.WebLogId}'))"
+                Query.Definition.ensureKey     Table.Page
-                $"CREATE INDEX page_author_idx    ON {Table.Page} ((data ->> '{nameof Page.empty.AuthorId}'))"
+                Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]
-                $"CREATE INDEX page_permalink_idx ON {Table.Page}
+                Query.Definition.ensureIndexOn
-                    ((data ->> '{nameof Page.empty.WebLogId}'), (data ->> '{nameof Page.empty.Permalink}'))"
+                    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 REFERENCES {Table.Page} (id) ON DELETE CASCADE,
+                    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
-                Definition.createTable Table.Post
+                Query.Definition.ensureTable   Table.Post
-                $"CREATE INDEX post_web_log_idx   ON {Table.Post} ((data ->> '{nameof Post.empty.WebLogId}'))"
+                Query.Definition.ensureKey     Table.Post
-                $"CREATE INDEX post_author_idx    ON {Table.Post} ((data ->> '{nameof Post.empty.AuthorId}'))"
+                Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]
-                $"CREATE INDEX post_status_idx    ON {Table.Post}
+                Query.Definition.ensureIndexOn
-                    ((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Status}'),
+                    Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
-                     (data ->> '{nameof Post.empty.UpdatedOn}'))"
+                Query.Definition.ensureIndexOn
-                $"CREATE INDEX post_permalink_idx ON {Table.Post}
+                    Table.Post
-                    ((data ->> '{nameof Post.empty.WebLogId}'), (data ->> '{nameof Post.empty.Permalink}'))"
+                    "status"
-                $"CREATE INDEX post_category_idx  ON {Table.Post} USING GIN ((data['{nameof Post.empty.CategoryIds}']))"
+                    [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
-                $"CREATE INDEX post_tag_idx       ON {Table.Post} USING GIN ((data['{nameof Post.empty.Tags}']))"
+                $"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 REFERENCES {Table.Post} (id) ON DELETE CASCADE,
+                    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
-                Definition.createTable Table.PostComment
+                Query.Definition.ensureTable   Table.PostComment
-                $"CREATE INDEX post_comment_post_idx ON {Table.PostComment}
+                Query.Definition.ensureKey     Table.PostComment
-                    ((data ->> '{nameof Comment.empty.PostId}'))"
+                Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]
             
             // Tag map table
             if needsTable Table.TagMap then
-                Definition.createTable Table.TagMap
+                Query.Definition.ensureTable         Table.TagMap
-                Definition.createIndex Table.TagMap Optimized
+                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 REFERENCES {Table.WebLog} (id),
+                    web_log_id  TEXT        NOT NULL,
                     path        TEXT        NOT NULL,
                     updated_on  TIMESTAMPTZ NOT NULL,
                     data        BYTEA       NOT NULL)"
-                $"CREATE INDEX upload_web_log_idx ON {Table.Upload} (web_log_id)"
+                $"CREATE INDEX idx_upload_web_log ON {Table.Upload} (web_log_id)"
-                $"CREATE INDEX upload_path_idx    ON {Table.Upload} (web_log_id, path)"
+                $"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.currentDbVersion}')"
+                $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
         }
         
-        Sql.fromDataSource source
+        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
+                if parts[1].ToLowerInvariant() = "table" then
                     log.LogInformation $"Creating {parts[2]} table..."
                 s, [ [] ])
              |> List.ofSeq)
@@ -132,45 +129,107 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
     }
     
     /// Set a specific database version
-    let setDbVersion version =
+    let setDbVersion version = backgroundTask {
-        Custom.nonQuery $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')" []
+        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 {
-        Utils.logMigrationStep log "v2-rc2 to v2" "Requires user action"
-        
         let! webLogs =
-            Configuration.dataSource ()
+            Custom.list
-            |> Sql.fromDataSource
+                $"SELECT url_base, slug FROM {Table.WebLog}" [] (fun row -> row.string "url_base", row.string "slug")
-            |> Sql.query $"SELECT url_base, slug FROM {Table.WebLog}"
+        Utils.Migration.backupAndRestoreRequired log "v2-rc2" "v2" webLogs
-            |> Sql.executeAsync (fun row -> row.string "url_base", row.string "slug")
+    }
 
-        [   "** MANUAL DATABASE UPGRADE REQUIRED **"; ""
+    /// Migrate from v2 to v2.1.1
-            "The data structure for PostgreSQL changed significantly between v2-rc2 and v2."
+    let migrateV2ToV2point1point1 () = backgroundTask {
-            "To migrate your data:"
+        let migration = "v2 to v2.1.1"
-            " - Use a v2-rc2 executable to back up each web log"
+        Utils.Migration.logStep log migration "Adding empty redirect rule set to all weblogs"
-            " - Drop all tables from the database"
+        do! Custom.nonQuery $"""UPDATE {Table.WebLog} SET data = data || '{{ "RedirectRules": [] }}'::jsonb""" []
-            " - Use this executable to restore each backup"; ""
-            "Commands to back up all web logs:"
-            yield! webLogs |> List.map (fun (url, slug) -> sprintf "./myWebLog backup %s v2-rc2.%s.json" url slug)
-        ]
-        |> String.concat "\n"
-        |> log.LogWarning
 
-        log.LogCritical "myWebLog will now exit"
+        let tables =
-        exit 1
+            [ 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 {
-        match version with
+        let mutable v = defaultArg version ""
-        | Some "v2" -> ()
+
-        | Some "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+        if v = "v2-rc2" then 
-        // Future versions will be inserted here
+            let! webLogs =
-        | Some _
+                Custom.list
-        | None ->
+                    $"SELECT url_base, slug FROM {Table.WebLog}" []
-            log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
+                    (fun row -> row.string "url_base", row.string "slug")
-            do! setDbVersion Utils.currentDbVersion
+            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
@@ -192,8 +251,5 @@ type PostgresData (source : NpgsqlDataSource, log : ILogger<PostgresData>, ser :
             do! ensureTables ()
             
             let! version = Custom.single "SELECT id FROM db_version" [] (fun row -> row.string "id")
-            match version with
+            do! migrate version
-            | Some v when v = Utils.currentDbVersion -> ()
-            | Some _
-            | None -> do! migrate version 
         }

src/MyWebLog.Data/RethinkDbData.fs

@@ -69,20 +69,20 @@ module private RethinkHelpers =
     let r = RethinkDB.R
 
     /// Verify that the web log ID matches before returning an item
-    let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : Net.IConnection -> Task<'T option>) =
+    let verifyWebLog<'T> webLogId (prop: 'T -> WebLogId) (f: Net.IConnection -> Task<'T option>) =
         fun conn -> backgroundTask {
             match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None
         }
     
     /// Get the first item from a list, or None if the list is empty
-    let tryFirst<'T> (f : Net.IConnection -> Task<'T list>) =
+    let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) =
         fun conn -> backgroundTask {
             let! results = f conn
             return results |> List.tryHead
         }
     
     /// Cast a strongly-typed list to an object list
-    let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj)
+    let objList<'T> (objects: 'T list) = objects |> List.map (fun it -> it :> obj)
 
 
 open System
@@ -92,16 +92,16 @@ open RethinkDb.Driver.FSharp
 open RethinkHelpers
 
 /// RethinkDB implementation of data functions for myWebLog
-type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<RethinkDbData>) =
+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 =
+    let withoutTemplateText (row: Ast.ReqlExpr) : obj =
-        {|  Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |] |}
+        {|  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 {
@@ -112,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 {
@@ -147,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
@@ -155,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
@@ -165,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
@@ -175,14 +175,18 @@ 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
@@ -192,7 +196,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
     }
     
     /// Set a specific database version
-    let setDbVersion (version : string) = backgroundTask {
+    let setDbVersion (version: string) = backgroundTask {
         do! rethink {
             withTable Table.DbVersion
             delete
@@ -207,7 +211,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
     
     /// Migrate from v2-rc1 to v2-rc2
     let migrateV2Rc1ToV2Rc2 () = backgroundTask {
-        let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
+        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."
@@ -217,20 +221,52 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
 
     /// Migrate from v2-rc2 to v2
     let migrateV2Rc2ToV2 () = backgroundTask {
-        Utils.logMigrationStep log "v2-rc2 to v2" "Setting database version; no migration required"
+        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 {
-        match version with
+        let mutable v = defaultArg version ""
-        | Some v when v = "v2" -> ()
+        
-        | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+        if v = "v2-rc1" then
-        | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
+            do! migrateV2Rc1ToV2Rc2 ()
-        | Some _
+            v <- "v2-rc2"
-        | None ->
+
-            log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
+        if v = "v2-rc2" then
-            do! setDbVersion Utils.currentDbVersion
+            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
@@ -249,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
                 }
@@ -265,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 []
@@ -282,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
@@ -298,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
                 }
                 
@@ -309,11 +344,11 @@ 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
                 }
                 
@@ -323,24 +358,26 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                         // Reassign any children to the category's parent category
                         let! children = rethink<int> {
                             withTable Table.Category
-                            filter (nameof Category.empty.ParentId) catId
+                            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
+                                filter (nameof Category.Empty.ParentId) catId
-                                update [ nameof Category.empty.ParentId, cat.ParentId :> obj ]
+                                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
@@ -386,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
                 }
@@ -414,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
                     }
@@ -422,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
                     }
@@ -444,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 =
@@ -460,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
@@ -521,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
@@ -540,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
                 }
@@ -550,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
                     }
@@ -558,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
                     }
@@ -582,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
@@ -619,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
@@ -630,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
@@ -641,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
@@ -655,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
                         }
@@ -666,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
                         }
@@ -686,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
@@ -721,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
                     }
@@ -734,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> {
@@ -747,9 +797,9 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.FindByWebLog webLogId = rethink<TagMap list> {
                     withTable Table.TagMap
-                    between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
+                    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
                 }
                 
@@ -781,16 +831,16 @@ 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)
                     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
+                        filter (nameof Theme.Empty.Id) themeId
                         count
                         result; withRetryDefault conn
                     }
@@ -803,12 +853,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     resultOption; withRetryOptionDefault conn
                 }
                 
-                member _.FindByIdWithoutText themeId = rethink<Theme> {
+                member _.FindByIdWithoutText themeId =
+                    rethink<Theme list> {
                         withTable Table.Theme
-                    get themeId
+                        getAll [ themeId ]
                         merge withoutTemplateText
-                    resultOption; withRetryOptionDefault conn
+                        result; withRetryDefault
                     }
+                    |> tryFirst <| conn
                 
                 member this.Delete themeId = backgroundTask {
                     match! this.FindByIdWithoutText themeId with
@@ -837,7 +889,7 @@ 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
                 }
                 
@@ -852,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
                 }
                 
@@ -886,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 {
@@ -895,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 =
@@ -909,15 +961,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.FindByWebLog webLogId = rethink<Upload> {
                     withTable Table.Upload
-                    between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
+                    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
                 }
                 
                 member _.FindByWebLogWithData webLogId = rethink<Upload> {
                     withTable Table.Upload
-                    between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
+                    between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
                             [ Index Index.WebLogAndPath ]
                     resultCursor; withRetryCursorDefault; toList conn
                 }
@@ -926,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
                         }
@@ -949,24 +1001,24 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                 
                 member _.Delete webLogId = backgroundTask {
                      // Comments should be deleted by post IDs
-                     let! thePostIds = rethink<{| Id : string |} list> {
+                     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
                          }
                      // Tag mappings do not have a straightforward webLogId index
                      do! rethink {
                          withTable Table.TagMap
-                         between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
+                         between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
                                  [ Index Index.WebLogAndTag ]
                          delete
                          write; withRetryOnce; ignoreResult conn
@@ -974,7 +1026,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                      // Uploaded files do not have a straightforward webLogId index
                      do! rethink {
                          withTable Table.Upload
-                         between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
+                         between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |]
                                  [ Index Index.WebLogAndPath ]
                          delete
                          write; withRetryOnce; ignoreResult conn
@@ -982,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
                          }
@@ -997,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
                     }
@@ -1009,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
                 }
                 
@@ -1049,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
                         }
@@ -1092,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
                 }
                 
@@ -1101,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 {
@@ -1124,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, Noda.now () :> obj ]
+                            update [ nameof WebLogUser.Empty.LastSeenOn, Noda.now () :> obj ]
                             write; withRetryOnce; ignoreResult conn
                         }
                     | None -> ()
@@ -1169,21 +1226,19 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
                     write; withRetryOnce; ignoreResult conn
                 }
             
-            do! ensureIndexes Table.Category   [ nameof Category.empty.WebLogId ]
+            do! ensureIndexes Table.Category   [ nameof Category.Empty.WebLogId ]
-            do! ensureIndexes Table.Comment    [ nameof Comment.empty.PostId ]
+            do! ensureIndexes Table.Comment    [ nameof Comment.Empty.PostId ]
-            do! ensureIndexes Table.Page       [ nameof Page.empty.WebLogId; nameof Page.empty.AuthorId ]
+            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.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> {
+            let! version = rethink<{| Id: string |} list> {
                  withTable Table.DbVersion
                  limit 1
                  result; withRetryOnce conn
             }
-            match List.tryHead version with
+            do! migrate (List.tryHead version |> Option.map _.Id)
-            | Some v when v.Id = "v2-rc2" -> ()
-            | it -> do! migrate (it |> Option.map (fun x -> x.Id))
         }

src/MyWebLog.Data/SQLite/Helpers.fs

@@ -1,314 +0,0 @@
-/// Helper functions for the SQLite data implementation
-[<AutoOpen>]
-module MyWebLog.Data.SQLite.Helpers
-
-open System
-open Microsoft.Data.Sqlite
-open MyWebLog
-open MyWebLog.Data
-open NodaTime.Text
-
-/// Run a command that returns a count
-let count (cmd : SqliteCommand) = backgroundTask {
-    let! it = cmd.ExecuteScalarAsync ()
-    return int (it :?> int64)
-}
-
-/// 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 ()
-    ()
-}
-
-/// 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 a Duration
-let durationParam =
-    DurationPattern.Roundtrip.Format
-
-/// Create a value for an Instant
-let instantParam =
-    InstantPattern.General.Format
-
-/// Create an optional value for a Duration
-let maybeDuration =
-    Option.map durationParam >> maybe
-
-/// Create an optional value for an Instant
-let maybeInstant =
-    Option.map instantParam >> maybe
-
-/// 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 a Duration from the given value
-    let parseDuration value =
-        match DurationPattern.Roundtrip.Parse value with
-        | it when it.Success -> it.Value
-        | it -> raise it.Exception
-    
-    /// Get a Duration value from a data reader
-    let getDuration col rdr =
-        getString col rdr |> parseDuration
-    
-    /// 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 Duration value from a data reader
-    let tryDuration col rdr =
-        tryString col rdr |> Option.map parseDuration
-    
-    /// Get a possibly null Instant value from a data reader
-    let tryInstant col rdr =
-        tryString col rdr |> Option.map parseInstant
-    
-    /// 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 ser rdr : CustomFeed =
-        {   Id      = getString "id"      rdr |> CustomFeedId
-            Source  = getString "source"  rdr |> CustomFeedSource.parse
-            Path    = getString "path"    rdr |> Permalink
-            Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
-        }
-    
-    /// 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 ser 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  = getInstant  "published_on"    rdr
-            UpdatedOn    = getInstant  "updated_on"      rdr
-            IsInPageList = getBoolean  "is_in_page_list" rdr
-            Template     = tryString   "template"        rdr
-            Text         = getString   "page_text"       rdr
-            Metadata     = tryString   "meta_items"   rdr
-                           |> Option.map (Utils.deserialize ser)
-                           |> Option.defaultValue []
-        }
-    
-    /// Create a post from the current row in the given data reader
-    let toPost ser 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 = tryInstant  "published_on" rdr
-            UpdatedOn   = getInstant  "updated_on"   rdr
-            Template    = tryString   "template"     rdr
-            Text        = getString   "post_text"    rdr
-            Episode     = tryString   "episode"      rdr |> Option.map (Utils.deserialize ser)
-            Metadata    = tryString   "meta_items"   rdr
-                          |> Option.map (Utils.deserialize ser)
-                          |> Option.defaultValue []
-        }
-    
-    /// 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 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 = getInstant "updated_on" rdr
-            Data      = assetData
-        }
-    
-    /// Create a theme template from the current row in the given data reader
-    let toThemeTemplate includeText rdr : ThemeTemplate =
-        {   Name = getString "name" rdr
-            Text = if includeText then getString "template" rdr else ""
-        }
-    
-    /// 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 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
-            Url           = tryString  "url"            rdr
-            AccessLevel   = getString  "access_level"   rdr |> AccessLevel.parse
-            CreatedOn     = getInstant "created_on"     rdr
-            LastSeenOn    = tryInstant "last_seen_on"   rdr
-        }
-
-/// 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,69 +1,43 @@
 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 {
@@ -71,104 +45,80 @@ type SQLiteCategoryData (conn : SqliteConnection) =
                 let catSql, catParams =
                     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)
                     |> List.ofSeq
-                    |> inClause "AND pc.category_id" "catId" id
+                    |> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
-                cmd.Parameters.Clear ()
+                let query = $"""
-                addWebLogId cmd webLogId
+                    SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}')
-                cmd.Parameters.AddRange catParams
+                      FROM {Table.Post}
-                cmd.CommandText <- $"
+                     WHERE {Document.Query.whereByWebLog}
-                    SELECT COUNT(DISTINCT p.id)
+                       AND {Query.whereByField (Field.EQ (nameof Post.Empty.Status) "") $"'{string Published}'"}
-                      FROM post p
+                       AND {catSql}"""
-                           INNER JOIN post_category pc ON pc.post_id = p.id
+                let! postCount = conn.customScalar query (webLogParam webLogId :: catParams) toCount
-                     WHERE p.web_log_id = @webLogId
+                return it.Id, int postCount
-                       AND p.status     = 'Published'
-                       {catSql}"
-                let! postCount = count cmd
-                return it.Id, 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 cat ->
-            use cmd = conn.CreateCommand ()
             // Reassign any children to the category's parent category
-            cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE parent_id = @parentId"
+            let! children = conn.countByField Table.Category (Field.EQ parentIdField (string catId))
-            cmd.Parameters.AddWithValue ("@parentId", CategoryId.toString catId) |> ignore
+            if children > 0L then
-            let! children = count cmd
+                let parent = Field.EQ parentIdField (string catId)
-            if children > 0 then
+                match cat.ParentId with
-                cmd.CommandText <- "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
+                | Some _ -> do! conn.patchByField Table.Category parent {| ParentId = cat.ParentId |}
-                cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
+                | None -> do! conn.removeFieldsByField Table.Category parent [ parentIdField ]
-                |> ignore
-                do! write cmd
             // Delete the category off all posts where it is assigned, and the category itself
-            cmd.CommandText <-
+            let catIdField = nameof Post.Empty.CategoryIds
-                "DELETE FROM post_category
+            let! posts =
-                  WHERE category_id = @id
+                conn.customList
-                    AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
+                    $"SELECT data ->> '{nameof Post.Empty.Id}', data -> '{catIdField}'
-                 DELETE FROM category WHERE id = @id"
+                        FROM {Table.Post}
-            cmd.Parameters.Clear ()
+                       WHERE {Document.Query.whereByWebLog}
-            let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
+                         AND EXISTS
-            addWebLogId cmd webLogId
+                               (SELECT 1
-            do! write cmd
+                                  FROM json_each({Table.Post}.data -> '{catIdField}')
-            return if children = 0 then CategoryDeleted else ReassignedChildCategories
+                                 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
@@ -176,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,298 +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
-open Newtonsoft.Json
 
 /// SQLite myWebLog page data implementation
-type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
+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",  instantParam page.PublishedOn)
-            cmd.Parameters.AddWithValue ("@updatedOn",    instantParam page.UpdatedOn)
-            cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
-            cmd.Parameters.AddWithValue ("@template",     maybe page.Template)
-            cmd.Parameters.AddWithValue ("@text",         page.Text)
-            cmd.Parameters.AddWithValue ("@metaItems",    maybe (if List.isEmpty page.Metadata then None
-                                                                 else Some (Utils.serialize ser page.Metadata)))
-        ] |> ignore
-    
-    /// Append revisions and permalinks to a page
-    let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        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 }
     }
     
-    /// Shorthand for mapping a data reader to a page
+    /// Create a page with no prior permalinks
-    let toPage =
+    let pageWithoutLinks rdr =
-        Map.toPage ser
+        { fromData<Page> rdr with PriorPermalinks = [] }
-    
-    /// Return a page with no text (or prior permalinks or revisions)
-    let pageWithoutText rdr =
-        { toPage rdr with Text = "" }
-    
-    /// Update a page's prior permalinks
-    let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
-        let toDelete, toAdd = Utils.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 = Utils.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",   instantParam 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, meta_items
-            ) VALUES (
-                @id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
-                @text, @metaItems
-            )"
-        addPageParameters cmd page
-        do! write cmd
-        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 pageWithoutText 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 ()
+        | None -> return None
-        return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
     }
     
     /// 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           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 ])
-        return if rdr.Read () then Some (toPage rdr) else None
+            pageWithoutLinks
-    }
     
     /// 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"
-        let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
+        let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
-        cmd.CommandText <- $"
+        conn.customSingle
-            SELECT p.permalink
+            $"SELECT data ->> '{linkName}' AS permalink
-               FROM page p
+                FROM {Table.Page}
-                    INNER JOIN page_permalink pp ON pp.page_id = p.id
+               WHERE {Document.Query.whereByWebLog} AND {linkSql}"
-              WHERE p.web_log_id = @webLogId
+            (webLogParam webLogId :: linkParams)
-                {linkSql}"
+            Map.toPermalink
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddRange linkParams
-        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 toPage rdr
-            |> List.map (fun page -> backgroundTask { 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 ()
-        return toList pageWithoutText rdr
-    }
     
-    /// 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 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,
-                        meta_items      = @metaItems
-                  WHERE id         = @id
-                    AND web_log_id = @webLogId"
-            addPageParameters cmd page
-            do! write cmd
-            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,465 +1,213 @@
 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
 open NodaTime
 
 /// SQLite myWebLog post data implementation
-type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
+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", maybeInstant post.PublishedOn)
-            cmd.Parameters.AddWithValue ("@updatedOn",   instantParam post.UpdatedOn)
-            cmd.Parameters.AddWithValue ("@template",    maybe post.Template)
-            cmd.Parameters.AddWithValue ("@text",        post.Text)
-            cmd.Parameters.AddWithValue ("@episode",     maybe (if Option.isSome post.Episode then
-                                                                    Some (Utils.serialize ser post.Episode)
-                                                                else None))
-            cmd.Parameters.AddWithValue ("@metaItems",   maybe (if List.isEmpty post.Metadata then None
-                                                                else Some (Utils.serialize ser post.Metadata)))
-        ] |> ignore
-    
-    /// Append category IDs and tags to a post
-    let appendPostCategoryAndTag (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 ()
-        return { post with Tags = toList (Map.getString "tag") 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.* FROM post p"
-    
-    /// Shorthand for mapping a data reader to a post
-    let toPost =
-        Map.toPost ser
-    
-    /// 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) toPost rdr
-    }
     
     /// Return a post with no revisions, prior permalinks, or text
     let postWithoutText rdr =
-        { 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 = Utils.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 = Utils.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 a post's prior permalinks
-    let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
-        let toDelete, toAdd = Utils.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 = Utils.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",   instantParam 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,
-                episode, meta_items
-            ) VALUES (
-                @id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
-                @episode, @metaItems
-            )"
-        addPostParameters cmd post
-        do! write cmd
-        do! updatePostCategories post.Id [] post.CategoryIds
-        do! updatePostTags       post.Id [] post.Tags
-        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 = appendPostCategoryAndTag 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 = appendPostCategoryAndTag (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_tag       WHERE post_id = @id;
+                    [ idParam postId ]
-                 DELETE FROM post_category  WHERE post_id = @id;
-                 DELETE FROM post_comment   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"
-        let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
+        let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
-        cmd.CommandText <- $"
+        conn.customSingle
-            SELECT p.permalink
+            $"SELECT data ->> '{linkName}' AS permalink
-               FROM post p
+                FROM {Table.Post}
-                    INNER JOIN post_permalink pp ON pp.post_id = p.id
+               WHERE {Document.Query.whereByWebLog} AND {linkSql}"
-              WHERE p.web_log_id = @webLogId
+            (webLogParam webLogId :: linkParams)
-                {linkSql}"
+            Map.toPermalink
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddRange linkParams
-        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 toPost rdr
-            |> List.map (fun post -> backgroundTask {
-                let! post = appendPostCategoryAndTag 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"
-        let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
+        let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
-        cmd.CommandText <- $"
+        conn.customList
-            {selectPost}
+            $"{publishedPostByWebLog} AND {catSql}
-                   INNER JOIN post_category pc ON pc.post_id = p.id
+               ORDER BY {publishField} DESC
-             WHERE p.web_log_id = @webLogId
-               AND p.status     = @status
-               {catSql}
-             ORDER BY published_on DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-        addWebLogId cmd webLogId
+            (webLogParam webLogId :: catParams)
-        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
+            postWithoutLinks
-        cmd.Parameters.AddRange catParams
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag 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}"
-        addWebLogId cmd webLogId
+            [ webLogParam webLogId ]
-        use! rdr = cmd.ExecuteReaderAsync ()
+            postWithoutText
-        let! posts =
-            toList postWithoutText rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag 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
-             ORDER BY p.published_on DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-        addWebLogId cmd webLogId
+            [ webLogParam webLogId ]
-        cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
+            postWithoutLinks
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag 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
-               AND pt.tag       = @tag
-             ORDER BY p.published_on DESC
                LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
-        addWebLogId cmd webLogId
+            (webLogParam webLogId :: tagParams)
-        [ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
+            postWithoutLinks
-          cmd.Parameters.AddWithValue ("@tag", tag)
-        ] |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! posts =
-            toList toPost rdr
-            |> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag 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 : 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", instantParam publishedOn)
+                postWithoutLinks
-        ] |> ignore
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let! older = backgroundTask {
-            if rdr.Read () then
-                let! post = appendPostCategoryAndTag (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 = appendPostCategoryAndTag (postWithoutText rdr)
-                return Some post
-            else
-                return None
-        }
         return older, newer
     }
     
+    /// Update a post
+    let update (post: Post) = backgroundTask {
+        log.LogTrace "Post.update"
+        match! findFullById post.Id post.WebLogId with
+        | Some oldPost ->
+            do! conn.updateById 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 {
-        for post in posts do
+        log.LogTrace "Post.restore"
-            do! add post
+        for post in posts do do! add post
-    }
-    
-    /// Update a post
-    let update (post : Post) = backgroundTask {
-        match! findFullById post.Id post.WebLogId with
-        | Some oldPost ->
-            use cmd = conn.CreateCommand ()
-            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,
-                        episode      = @episode,
-                        meta_items   = @metaItems
-                  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! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
-            do! updatePostRevisions  post.Id oldPost.Revisions       post.Revisions
-        | None -> return ()
     }
     
     /// 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,97 +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"
-        let mapSql, mapParams = inClause "AND tag" "tag" id tags
+        let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
-        cmd.CommandText <- $"
+        conn.customList
-            SELECT *
+            $"{Document.Query.selectByWebLog Table.TagMap} {mapSql}"
-               FROM tag_map
+            (webLogParam webLogId :: mapParams)
-              WHERE web_log_id = @webLogId
+            fromData<TagMap>
-                {mapSql}"
-        addWebLogId cmd webLogId
-        cmd.Parameters.AddRange mapParams
-        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,141 +1,69 @@
 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) =
+    
+    /// The JSON field for the theme ID
+    let idField = $"data ->> '{nameof Theme.Empty.Id}'"
+    
+    /// Convert a document to a theme with no template text
+    let withoutTemplateText (rdr: SqliteDataReader) =
+        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 () = backgroundTask {
+    let all () =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Theme.all"
-        cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
+        conn.customList
-        use! rdr = cmd.ExecuteReaderAsync ()
+            $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
-        let themes = toList Map.toTheme rdr
+            []
-        do! rdr.CloseAsync ()
+            withoutTemplateText
-        cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
-        use! rdr = cmd.ExecuteReaderAsync ()
-        let templates =
-            seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
-            |> List.ofSeq
-        return
-            themes
-            |> List.map (fun t ->
-                { t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
-    }
     
     /// Does a given theme exist?
-    let exists themeId = backgroundTask {
+    let exists (themeId: ThemeId) =
-        use cmd = conn.CreateCommand ()
+        log.LogTrace "Theme.exists"
-        cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
+        conn.existsById Table.Theme themeId
-        cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
-        let! count = count cmd
-        return count > 0
-    }
     
     /// 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 true) 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 = "" })
-            }
-        | None -> return None
-    }
     
     /// Delete a theme by its ID
     let delete themeId = backgroundTask {
+        log.LogTrace "Theme.delete"
         match! findByIdWithoutText themeId with
         | Some _ ->
-            use cmd = conn.CreateCommand ()
+            do! conn.customNonQuery
-            cmd.CommandText <-
+                    $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}"
-                "DELETE FROM theme_asset    WHERE theme_id = @id;
+                    [ idParam themeId ]
-                 DELETE FROM theme_template WHERE theme_id = @id;
-                 DELETE FROM theme          WHERE id       = @id"
-            cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
-            do! write cmd
             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 =
-            Utils.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 _.All() = all ()
         member _.Delete themeId = delete themeId
         member _.Exists themeId = exists themeId
         member _.FindById themeId = findById themeId
@@ -146,96 +74,74 @@ 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 {
+    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",  instantParam 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 =
-        let! rowId = sideCmd.ExecuteScalarAsync ()
+            conn.customScalar
-        
+                $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
-        use dataStream = new MemoryStream (asset.Data)
+                (assetIdParams asset.Id)
-        use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
+                _.GetInt64(0)
+        use dataStream = new MemoryStream(asset.Data)
+        use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId)
         do! dataStream.CopyToAsync blobStream
     }
     
     interface IThemeAssetData with
-        member _.All () = all ()
+        member _.All() = all ()
         member _.DeleteByTheme themeId = deleteByTheme themeId
         member _.FindById assetId = findById assetId
         member _.FindByTheme themeId = findByTheme themeId

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",  instantParam 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 =
-        use dataStream = new MemoryStream (upload.Data)
+            conn.customScalar $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" [ idParam upload.Id ] _.GetInt64(0)
-        use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
+        use dataStream = new MemoryStream(upload.Data)
+        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,251 +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
-open Newtonsoft.Json
-
-// 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, ser : JsonSerializer) =
+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)
-            cmd.Parameters.AddWithValue ("@podcast",  maybe (if Option.isSome feed.Podcast then
-                                                                 Some (Utils.serialize ser feed.Podcast)
-                                                             else None))
-        ] |> ignore
-    
-    /// Shorthand to map a data reader to a custom feed
-    let toCustomFeed =
-        Map.toCustomFeed ser
-    
-    /// Get the current custom feeds for a web log
-    let getCustomFeeds (webLog : WebLog) = backgroundTask {
-        use cmd = conn.CreateCommand ()
-        cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
-        addWebLogId cmd webLog.Id
-        use! rdr = cmd.ExecuteReaderAsync ()
-        return toList 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 } }
-    }
-    
-    /// Update the custom feeds for a web log
-    let updateCustomFeeds (webLog : WebLog) = backgroundTask {
-        let! feeds = getCustomFeeds webLog
-        let toDelete, toAdd = Utils.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 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, podcast
-                ) VALUES (
-                    @id, @webLogId, @source, @path, @podcast
-                )"
-            cmd.Parameters.Clear ()
-            addCustomFeedParameters cmd webLog.Id it
-            do! write cmd
-        })
-        |> Task.WhenAll
-        |> ignore
-        toUpdate
-        |> List.map (fun it -> backgroundTask {
-            cmd.CommandText <-
-                "UPDATE web_log_feed
-                    SET source  = @source,
-                        path    = @path,
-                        podcast = @podcast
-                  WHERE id         = @id
-                    AND web_log_id = @webLogId"
-            cmd.Parameters.Clear ()
-            addCustomFeedParameters cmd webLog.Id it
-            do! write cmd
-        })
-        |> 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_tag       WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.Category}     WHERE {webLogMatches};
-            DELETE FROM post_category  WHERE post_id IN {postSubQuery};
+                DELETE FROM {Table.TagMap}       WHERE {webLogMatches};
-            DELETE FROM post           WHERE web_log_id = @webLogId;
+                DELETE FROM {Table.Upload}       WHERE web_log_id = @webLogId;
-            DELETE FROM page_revision  WHERE page_id IN {pageSubQuery};
+                DELETE FROM {Table.WebLogUser}   WHERE {webLogMatches};
-            DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
+                DELETE FROM {Table.WebLog}       WHERE {Query.whereById "@webLogId"}"""
-            DELETE FROM page           WHERE web_log_id = @webLogId;
+            [ webLogParam 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   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
-        cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
-        do! write cmd
-        do! updateCustomFeeds webLog
-    }
     
     interface IWebLogData with
         member _.Add webLog = add webLog
@@ -253,5 +69,6 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
         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,147 +1,86 @@
 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 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 ("@url",           maybe user.Url)
-            cmd.Parameters.AddWithValue ("@accessLevel",   AccessLevel.toString user.AccessLevel)
-            cmd.Parameters.AddWithValue ("@createdOn",     instantParam user.CreatedOn)
-            cmd.Parameters.AddWithValue ("@lastSeenOn",    maybeInstant 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, url, access_level,
-                created_on, last_seen_on
-            ) VALUES (
-                @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @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"
-        let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds 
+        let nameSql, nameParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" string userIds 
-        cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
+        conn.customList
-        addWebLogId cmd webLogId
+            $"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}"
-        cmd.Parameters.AddRange nameParams
+            (webLogParam webLogId :: nameParams)
-        use! rdr = cmd.ExecuteReaderAsync ()
+            (fun rdr ->
-        return
+                let user = fromData<WebLogUser> rdr
-            toList Map.toWebLogUser rdr
+                { Name = string user.Id; Value = user.DisplayName })
-            |> 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", instantParam (Noda.now ()))
-        ] |> 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,
-                    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,5 +1,9 @@
 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
@@ -8,230 +12,121 @@ open Newtonsoft.Json
 open NodaTime
 
 /// SQLite myWebLog data implementation
-type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonSerializer) =
+type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSerializer) =
     
+    /// Create tables (and their associated indexes) if they do not exist
     let ensureTables () = backgroundTask {
         
-        use cmd = conn.CreateCommand ()
+        Configuration.useSerializer (Utils.createDocumentSerializer ser)
+        
+        let! tables = conn.customList "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
         
-        let! tables = backgroundTask {
-            cmd.CommandText <- "SELECT name FROM sqlite_master WHERE type = 'table'"
-            let! rdr = cmd.ExecuteReaderAsync ()
-            let mutable tableList = []
-            while rdr.Read() do
-                tableList <- Map.getString "name" rdr :: tableList
-            do! rdr.CloseAsync ()
-            return tableList
-        }
         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 "theme" then
+                if needsTable Table.Theme then jsonTable Table.Theme
-                "CREATE TABLE theme (
+                if needsTable Table.ThemeAsset then
-                    id       TEXT PRIMARY KEY,
+                    $"CREATE TABLE {Table.ThemeAsset} (
-                    name     TEXT NOT NULL,
+                        theme_id    TEXT NOT NULL,
-                    version  TEXT NOT NULL)"
-            if needsTable "theme_template" then
-                "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))"
-            if needsTable "theme_asset" then
-                "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))"
                 
-            // Web log tables
+                // Web log table
-            if needsTable "web_log" then
+                if needsTable Table.WebLog then jsonTable Table.WebLog
-                "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)"
-            if needsTable "web_log_feed" then
-                "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,
-                    podcast     TEXT);
-                CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
                 
                 // Category table
-            if needsTable "category" then
+                if needsTable Table.Category then
-                "CREATE TABLE category (
+                    $"""{jsonTable Table.Category};
-                    id           TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn Table.Category "web_log" [ nameof Category.Empty.WebLogId ]}"""
-                    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)"
                 
                 // Web log user table
-            if needsTable "web_log_user" then
+                if needsTable Table.WebLogUser then
-                "CREATE TABLE web_log_user (
+                    $"""{jsonTable Table.WebLogUser};
-                    id              TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn
-                    web_log_id      TEXT NOT NULL REFERENCES web_log (id),
+                             Table.WebLogUser
-                    email           TEXT NOT NULL,
+                             "email"
-                    first_name      TEXT NOT NULL,
+                             [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]}"""
-                    last_name       TEXT NOT NULL,
-                    preferred_name  TEXT NOT NULL,
-                    password_hash   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)"
                 
                 // Page tables
-            if needsTable "page" then
+                if needsTable Table.Page then
-                "CREATE TABLE page (
+                    $"""{jsonTable Table.Page};
-                    id               TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]};
-                    web_log_id       TEXT NOT NULL REFERENCES web_log (id),
+                        {Query.Definition.ensureIndexOn
-                    author_id        TEXT NOT NULL REFERENCES web_log_user (id),
+                             Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]}"""
-                    title            TEXT NOT NULL,
+                if needsTable Table.PageRevision then
-                    permalink        TEXT NOT NULL,
+                    $"CREATE TABLE {Table.PageRevision} (
-                    published_on     TEXT NOT NULL,
+                        page_id        TEXT NOT NULL,
-                    updated_on       TEXT NOT NULL,
-                    is_in_page_list  INTEGER NOT NULL DEFAULT 0,
-                    template         TEXT,
-                    page_text        TEXT NOT NULL,
-                    meta_items       TEXT);
-                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)"
-            if needsTable "page_permalink" then
-                "CREATE TABLE page_permalink (
-                    page_id    TEXT NOT NULL REFERENCES page (id),
-                    permalink  TEXT NOT NULL,
-                    PRIMARY KEY (page_id, permalink))"
-            if needsTable "page_revision" then
-                "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))"
                 
                 // Post tables
-            if needsTable "post" then
+                if needsTable Table.Post then
-                "CREATE TABLE post (
+                    $"""{jsonTable Table.Post};
-                    id            TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]};
-                    web_log_id    TEXT NOT NULL REFERENCES web_log (id),
+                        {Query.Definition.ensureIndexOn
-                    author_id     TEXT NOT NULL REFERENCES web_log_user (id),
+                             Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]};
-                    status        TEXT NOT NULL,
+                        {Query.Definition.ensureIndexOn
-                    title         TEXT NOT NULL,
+                             Table.Post
-                    permalink     TEXT NOT NULL,
+                             "status"
-                    published_on  TEXT,
+                             [ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]}"""
-                    updated_on    TEXT NOT NULL,
+                      // TODO: index categories by post?
-                    template      TEXT,
+                if needsTable Table.PostRevision then
-                    post_text     TEXT NOT NULL,
+                    $"CREATE TABLE {Table.PostRevision} (
-                    meta_items    TEXT,
+                        post_id        TEXT NOT NULL,
-                    episode       TEXT);
-                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)"
-            if needsTable "post_category" then
-                "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)"
-            if needsTable "post_tag" then
-                "CREATE TABLE post_tag (
-                    post_id  TEXT NOT NULL REFERENCES post (id),
-                    tag      TEXT NOT NULL,
-                    PRIMARY KEY (post_id, tag))"
-            if needsTable "post_permalink" then
-                "CREATE TABLE post_permalink (
-                    post_id    TEXT NOT NULL REFERENCES post (id),
-                    permalink  TEXT NOT NULL,
-                    PRIMARY KEY (post_id, permalink))"
-            if needsTable "post_revision" then
-                "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))"
-            if needsTable "post_comment" then
+                if needsTable Table.PostComment then
-                "CREATE TABLE post_comment (
+                    $"""{jsonTable Table.PostComment};
-                    id              TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]}"""
-                    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)"
                 
                 // Tag map table
-            if needsTable "tag_map" then
+                if needsTable Table.TagMap then
-                "CREATE TABLE tag_map (
+                    $"""{jsonTable Table.TagMap};
-                    id          TEXT PRIMARY KEY,
+                        {Query.Definition.ensureIndexOn
-                    web_log_id  TEXT NOT NULL REFERENCES web_log (id),
+                             Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]}"""
-                    tag         TEXT NOT NULL,
-                    url_value   TEXT NOT NULL);
-                CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
                 
                 // Uploaded file table
-            if needsTable "upload" then
+                if needsTable Table.Upload then
-                "CREATE TABLE upload (
+                    $"CREATE TABLE {Table.Upload} (
                         id          TEXT PRIMARY KEY,
-                    web_log_id  TEXT NOT NULL REFERENCES web_log (id),
+                        web_log_id  TEXT NOT NULL,
                         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 idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)"
-                CREATE INDEX upload_path_idx    ON upload (web_log_id, path)"
                 
                 // Database version table
-            if needsTable "db_version" then
+                if needsTable Table.DbVersion then
-                "CREATE TABLE db_version (id TEXT PRIMARY KEY);
+                    $"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
-                 INSERT INTO db_version VALUES ('v2-rc1')"
+                      INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
             }
             |> Seq.map (fun sql ->
-            log.LogInformation $"Creating {(sql.Split ' ')[2]} table..."
+                log.LogInformation $"""Creating {(sql.Replace("IF NOT EXISTS ", "").Split ' ')[2]} table..."""
-            cmd.CommandText <- sql
+                conn.customNonQuery sql [])
-            write cmd |> Async.AwaitTask |> Async.RunSynchronously)
+        
-        |> List.ofSeq
+        let! _ = Task.WhenAll tasks
-        |> ignore
+        ()
     }
     
     /// Set the database version to the specified version
-    let setDbVersion version = backgroundTask {
+    let setDbVersion version =
-        use cmd = conn.CreateCommand ()
+        conn.customNonQuery $"DELETE FROM {Table.DbVersion}; INSERT INTO {Table.DbVersion} VALUES ('%s{version}')" []
-        cmd.CommandText <- $"DELETE FROM db_version; INSERT INTO db_version VALUES ('%s{version}')"
-        do! write cmd
-    }
         
     /// Implement the changes between v2-rc1 and v2-rc2
     let migrateV2Rc1ToV2Rc2 () = backgroundTask {
-        let logStep = Utils.logMigrationStep log "v2-rc1 to v2-rc2"
+        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 ()
+        use cmd = conn.CreateCommand()
         logStep "Adding new columns"
         cmd.CommandText <-
             "ALTER TABLE web_log_feed ADD COLUMN podcast    TEXT;
@@ -242,10 +137,10 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
         logStep "Migrating meta items"
         let migrateMeta entity = backgroundTask {
             cmd.CommandText <- $"SELECT * FROM %s{entity}_meta"
-            use! metaRdr = cmd.ExecuteReaderAsync ()
+            use! metaRdr = cmd.ExecuteReaderAsync()
             let allMetas =
                 seq {
-                    while metaRdr.Read () do
+                    while metaRdr.Read() do
                         Map.getString $"{entity}_id" metaRdr,
                         { Name = Map.getString "name" metaRdr; Value = Map.getString "value" metaRdr }
                 } |> List.ofSeq
@@ -261,19 +156,19 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
                     "UPDATE post
                         SET meta_items = @metaItems
                       WHERE id = @postId"
-                [   cmd.Parameters.AddWithValue ("@metaItems", Utils.serialize ser items)
+                [ cmd.Parameters.AddWithValue("@metaItems", Utils.serialize ser items)
-                    cmd.Parameters.AddWithValue ("@id",        entityId) ] |> ignore
+                  cmd.Parameters.AddWithValue("@id",        entityId) ] |> ignore
-                let _ = cmd.ExecuteNonQuery ()
+                let _ = cmd.ExecuteNonQuery()
-                cmd.Parameters.Clear ())
+                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 ()
+        use! podcastRdr = cmd.ExecuteReaderAsync()
         let podcasts =
             seq {
-                while podcastRdr.Read () do
+                while podcastRdr.Read() do
                     CustomFeedId (Map.getString "feed_id" podcastRdr),
                     { Title             = Map.getString "title"              podcastRdr
                       Subtitle          = Map.tryString "subtitle"           podcastRdr
@@ -284,29 +179,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
                       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
+                      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
+                                          |> Option.map PodcastMedium.Parse }
-                    }
             } |> List.ofSeq
-        podcastRdr.Close ()
+        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("@podcast", Utils.serialize ser podcast)
-                cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feedId) ] |> ignore
+              cmd.Parameters.AddWithValue("@id",      string feedId) ] |> ignore
-            let _ = cmd.ExecuteNonQuery ()
+            let _ = cmd.ExecuteNonQuery()
-            cmd.Parameters.Clear ())
+            cmd.Parameters.Clear())
         cmd.CommandText <- "SELECT * FROM post_episode"
-        use! epRdr = cmd.ExecuteReaderAsync ()
+        use! epRdr = cmd.ExecuteReaderAsync()
         let episodes =
             seq {
-                while epRdr.Read () do
+                while epRdr.Read() do
                     PostId (Map.getString "post_id" epRdr),
                     { Media              = Map.getString   "media"               epRdr
                       Length             = Map.getLong     "length"              epRdr
@@ -316,63 +210,63 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
                       ImageUrl           = Map.tryString   "image_url"           epRdr
                       Subtitle           = Map.tryString   "subtitle"            epRdr
                       Explicit           = Map.tryString   "explicit"            epRdr
-                                             |> Option.map ExplicitRating.parse
+                                           |> 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
+                      EpisodeNumber      = Map.tryString   "episode_number"      epRdr |> Option.map Double.Parse
-                                             |> Option.map System.Double.Parse
+                      EpisodeDescription = Map.tryString   "episode_description" epRdr }
-                        EpisodeDescription = Map.tryString   "episode_description" epRdr
-                    }
             } |> List.ofSeq
-        epRdr.Close ()
+        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("@episode", Utils.serialize ser episode)
-                cmd.Parameters.AddWithValue ("@id",      PostId.toString postId) ] |> ignore
+              cmd.Parameters.AddWithValue("@id",      string postId) ] |> ignore
-            let _ = cmd.ExecuteNonQuery ()
+            let _ = cmd.ExecuteNonQuery()
-            cmd.Parameters.Clear ())
+            cmd.Parameters.Clear())
         
         logStep "Migrating dates/times"
-        let inst (dt : System.DateTime) =
+        let inst (dt: DateTime) =
-            System.DateTime (dt.Ticks, System.DateTimeKind.Utc)
+            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 ()
+        use! pageRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while pageRdr.Read () do
+                while pageRdr.Read() do
                     Map.getString "id" pageRdr,
                     inst (Map.getDateTime "updated_on"   pageRdr),
                     inst (Map.getDateTime "published_on" pageRdr)
             } |> List.ofSeq
-        pageRdr.Close ()
+        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("@id",          SqliteType.Text)
-            cmd.Parameters.Add ("@updatedOn",   SqliteType.Text)
+          cmd.Parameters.Add("@updatedOn",   SqliteType.Text)
-            cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
+          cmd.Parameters.Add("@publishedOn", SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         // page_revision.as_of
         cmd.CommandText <- "SELECT * FROM page_revision"
-        use! pageRevRdr = cmd.ExecuteReaderAsync ()
+        use! pageRevRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while pageRevRdr.Read () do
+                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
@@ -380,141 +274,135 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
         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("@pageId",  SqliteType.Text)
-            cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
+          cmd.Parameters.Add("@oldAsOf", SqliteType.Text)
-            cmd.Parameters.Add ("@asOf",    SqliteType.Text)
+          cmd.Parameters.Add("@asOf",    SqliteType.Text)
-            cmd.Parameters.Add ("@text",    SqliteType.Text)
+          cmd.Parameters.Add("@text",    SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         // post.updated_on, post.published_on (opt)
         cmd.CommandText <- "SELECT id, updated_on, published_on FROM post"
-        use! postRdr = cmd.ExecuteReaderAsync ()
+        use! postRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while postRdr.Read () do
+                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 ()
+        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("@id",          SqliteType.Text)
-            cmd.Parameters.Add ("@updatedOn",   SqliteType.Text)
+          cmd.Parameters.Add("@updatedOn",   SqliteType.Text)
-            cmd.Parameters.Add ("@publishedOn", SqliteType.Text)
+          cmd.Parameters.Add("@publishedOn", SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         // post_revision.as_of
         cmd.CommandText <- "SELECT * FROM post_revision"
-        use! postRevRdr = cmd.ExecuteReaderAsync ()
+        use! postRevRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while postRevRdr.Read () do
+                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 ()
+        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("@postId",  SqliteType.Text)
-            cmd.Parameters.Add ("@oldAsOf", SqliteType.Text)
+          cmd.Parameters.Add("@oldAsOf", SqliteType.Text)
-            cmd.Parameters.Add ("@asOf",    SqliteType.Text)
+          cmd.Parameters.Add("@asOf",    SqliteType.Text)
-            cmd.Parameters.Add ("@text",    SqliteType.Text)
+          cmd.Parameters.Add("@text",    SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         // theme_asset.updated_on
         cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
-        use! assetRdr = cmd.ExecuteReaderAsync ()
+        use! assetRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while assetRdr.Read () do
+                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("@updatedOn", SqliteType.Text)
-            cmd.Parameters.Add ("@themeId",   SqliteType.Text)
+          cmd.Parameters.Add("@themeId",   SqliteType.Text)
-            cmd.Parameters.Add ("@path",      SqliteType.Text)
+          cmd.Parameters.Add("@path",      SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         // upload.updated_on
         cmd.CommandText <- "SELECT id, updated_on FROM upload"
-        use! upRdr = cmd.ExecuteReaderAsync ()
+        use! upRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while upRdr.Read () do
+                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("@updatedOn", SqliteType.Text)
-            cmd.Parameters.Add ("@id",        SqliteType.Text)
+          cmd.Parameters.Add("@id",        SqliteType.Text) ] |> ignore
-        ] |> ignore
         toUpdate
         |> List.iter (fun (upId, updatedOn) ->
             cmd.Parameters["@id"       ].Value <- upId
             cmd.Parameters["@updatedOn"].Value <- instantParam updatedOn
-            let _ = cmd.ExecuteNonQuery ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        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 ()
+        use! userRdr = cmd.ExecuteReaderAsync()
         let toUpdate =
             seq {
-                while userRdr.Read () do
+                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 ()
+        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("@id",         SqliteType.Text)
-            cmd.Parameters.Add ("@createdOn",  SqliteType.Text)
+          cmd.Parameters.Add("@createdOn",  SqliteType.Text)
-            cmd.Parameters.Add ("@lastSeenOn", SqliteType.Text)
+          cmd.Parameters.Add("@lastSeenOn", SqliteType.Text) ] |> ignore
-        ] |> 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 ()
+            let _ = cmd.ExecuteNonQuery()
             ())
-        cmd.Parameters.Clear ()
+        cmd.Parameters.Clear()
         
-        conn.Close ()
+        conn.Close()
-        conn.Open ()
+        conn.Open()
         
         logStep "Dropping old tables and columns"
         cmd.CommandText <-
@@ -531,58 +419,67 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
     
     /// Migrate from v2-rc2 to v2
     let migrateV2Rc2ToV2 () = backgroundTask {
-        Utils.logMigrationStep log "v2-rc2 to v2" "Setting database version; no migration required"
+        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 ""
 
-        match version with
+        if v = "v2-rc1" then
-        | Some v when v = "v2" -> ()
+            do! migrateV2Rc1ToV2Rc2 ()
-        | Some v when v = "v2-rc2" -> do! migrateV2Rc2ToV2 ()
+            v <- "v2-rc2"
-        | Some v when v = "v2-rc1" -> do! migrateV2Rc1ToV2Rc2 ()
+        
-        | Some _
+        if v = "v2-rc2" then
-        | None ->
+            do! migrateV2Rc2ToV2 ()
-            log.LogWarning $"Unknown database version; assuming {Utils.currentDbVersion}"
+            v <- "v2"
-            do! setDbVersion Utils.currentDbVersion
+        
+        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, ser)
+        member _.Page       = SQLitePageData       (conn, log)
-        member _.Post       = SQLitePostData       (conn, ser)
+        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, ser)
+        member _.WebLog     = SQLiteWebLogData     (conn, log)
-        member _.WebLogUser = SQLiteWebLogUserData conn
+        member _.WebLogUser = SQLiteWebLogUserData (conn, log)
         
         member _.Serializer = ser
         
         member _.StartUp () = backgroundTask {
             do! ensureTables ()
-            
+            let! version = conn.customSingle<string> $"SELECT id FROM {Table.DbVersion}" [] _.GetString(0)
-            use cmd = conn.CreateCommand ()
+            do! migrate version
-            cmd.CommandText <- "SELECT id FROM db_version"
-            use! rdr = cmd.ExecuteReaderAsync ()
-            let version = if rdr.Read () then Some (Map.getString "id" rdr) else None
-            match version with
-            | Some v when v = "v2-rc2" -> ()
-            | Some _
-            | None -> do! migrate version
         }

src/MyWebLog.Data/Utils.fs

@@ -5,54 +5,76 @@ module internal MyWebLog.Data.Utils
 open MyWebLog
 open MyWebLog.ViewModels
 
-/// The current database version
-let currentDbVersion = "v2"
-
 /// Create a category hierarchy from the given list of categories
-let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
+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 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 =
+let diffRevisions (oldRevs: Revision list) newRevs =
-    diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.ToUnixTimeTicks ()}|{MarkupText.toString rev.Text}")
+    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) =
+let serialize<'T> ser (item: 'T) =
-    JsonConvert.SerializeObject (item, Json.settings ser)
+    JsonConvert.SerializeObject(item, Json.settings ser)
 
 /// Deserialize a JSON string 
-let deserialize<'T> (ser : JsonSerializer) value =
+let deserialize<'T> (ser: JsonSerializer) value =
-    JsonConvert.DeserializeObject<'T> (value, Json.settings ser)
+    JsonConvert.DeserializeObject<'T>(value, Json.settings ser)
 
-open Microsoft.Extensions.Logging
+open BitBadger.Documents
 
-/// Log a migration step
+/// Create a document serializer using the given JsonSerializer
-let logMigrationStep<'T> (log : ILogger<'T>) migration message =
+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,146 +1,134 @@
 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
+    Id: CategoryId
 
     /// The ID of the web log to which the category belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
 
     /// The displayed name
-        Name : string
+    Name: string
 
     /// The slug (used in category URLs)
-        Slug : string
+    Slug: string
 
     /// A longer description of the category
-        Description : string option
+    Description: string option
 
     /// The parent ID of this category (if a subcategory)
-        ParentId : CategoryId option
+    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
+    Id: CommentId
 
     /// The ID of the post to which this comment applies
-        PostId : PostId
+    PostId: PostId
 
     /// The ID of the comment to which this comment is a reply
-        InReplyToId : CommentId option
+    InReplyToId: CommentId option
 
     /// The name of the commentor
-        Name : string
+    Name: string
 
     /// The e-mail address of the commentor
-        Email : string
+    Email: string
 
     /// The URL of the commentor's personal website
-        Url : string option
+    Url: string option
 
     /// The status of the comment
-        Status : CommentStatus
+    Status: CommentStatus
 
     /// When the comment was posted
-        PostedOn : Instant
+    PostedOn: Instant
 
     /// The text of the comment
-        Text : string
+    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    = 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
+    Id: PageId
 
     /// The ID of the web log to which this page belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
 
     /// The ID of the author of this page
-        AuthorId : WebLogUserId
+    AuthorId: WebLogUserId
 
     /// The title of the page
-        Title : string
+    Title: string
 
     /// The link at which this page is displayed
-        Permalink : Permalink
+    Permalink: Permalink
 
     /// When this page was published
-        PublishedOn : Instant
+    PublishedOn: Instant
 
     /// When this page was last updated
-        UpdatedOn : Instant
+    UpdatedOn: Instant
 
     /// Whether this page shows as part of the web log's navigation
-        IsInPageList : bool
+    IsInPageList: bool
 
     /// The template to use when rendering this page
-        Template : string option
+    Template: string option
 
     /// The current text of the page
-        Text : string
+    Text: string
 
     /// Metadata for this page
-        Metadata : MetaItem list
+    Metadata: MetaItem list
     
     /// Permalinks at which this page may have been previously served (useful for migrated content)
-        PriorPermalinks : Permalink list
+    PriorPermalinks: Permalink list
 
     /// Revisions of this page
-        Revisions : Revision list
+    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     = Noda.epoch
           UpdatedOn       = Noda.epoch
           IsInPageList    = false
@@ -148,73 +136,69 @@ module Page =
           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
+    Id: PostId
 
     /// The ID of the web log to which this post belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
 
     /// The ID of the author of this post
-        AuthorId : WebLogUserId
+    AuthorId: WebLogUserId
 
     /// The status
-        Status : PostStatus
+    Status: PostStatus
 
     /// The title
-        Title : string
+    Title: string
 
     /// The link at which the post resides
-        Permalink : Permalink
+    Permalink: Permalink
 
     /// The instant on which the post was originally published
-        PublishedOn : Instant option
+    PublishedOn: Instant option
 
     /// The instant on which the post was last updated
-        UpdatedOn : Instant
+    UpdatedOn: Instant
 
     /// The template to use in displaying the post
-        Template : string option
+    Template: string option
     
     /// The text of the post in HTML (ready to display) format
-        Text : string
+    Text: string
 
     /// The Ids of the categories to which this is assigned
-        CategoryIds : CategoryId list
+    CategoryIds: CategoryId list
 
     /// The tags for the post
-        Tags : string list
+    Tags: string list
 
     /// Podcast episode information for this post
-        Episode : Episode option
+    Episode: Episode option
     
     /// Metadata for the post
-        Metadata : MetaItem list
+    Metadata: MetaItem list
     
     /// Permalinks at which this post may have been previously served (useful for migrated content)
-        PriorPermalinks : Permalink list
+    PriorPermalinks: Permalink list
 
     /// The revisions for this post
-        Revisions : Revision list
+    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       = Noda.epoch
           Text            = ""
@@ -224,165 +208,141 @@ 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 = {
-        Id : TagMapId
+    /// The ID of this tag mapping
+    Id: TagMapId
     
     /// The ID of the web log to which this tag mapping belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
     
     /// The tag which should be mapped to a different value in links
-        Tag : string
+    Tag: string
     
     /// The value by which the tag should be linked
-        UrlValue : string
+    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 = {
-        Id : ThemeId
+    /// The ID / path of the theme
+    Id: ThemeId
     
     /// A long name of the theme
-        Name : string
+    Name: string
     
     /// The version of the theme
-        Version : string
+    Version: string
     
     /// 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
+    Id: ThemeAssetId
     
     /// The updated date (set from the file date from the ZIP archive)
-        UpdatedOn : Instant
+    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 = Noda.epoch
-            Data      = [||]
-        }
 
 
 /// An uploaded file
-type Upload =
+[<CLIMutable; NoComparison; NoEquality>]
-    {   /// The ID of the upload
+type Upload = {
-        Id : UploadId
+    /// The ID of the upload
+    Id: UploadId
     
     /// The ID of the web log to which this upload belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
     
     /// The link at which this upload is served
-        Path : Permalink
+    Path: Permalink
     
     /// The updated date/time for this upload
-        UpdatedOn : Instant
+    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 = Noda.epoch
-            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
+    Id: WebLogId
 
     /// The name of the web log
-        Name : string
+    Name: string
 
     /// The slug of the web log
-        Slug : string
+    Slug: string
     
     /// A subtitle for the web log
-        Subtitle : string option
+    Subtitle: string option
 
     /// The default page ("posts" or a page Id)
-        DefaultPage : string
+    DefaultPage: string
 
     /// The number of posts to display on pages of posts
-        PostsPerPage : int
+    PostsPerPage: int
 
     /// The ID of the theme (also the path within /themes)
-        ThemeId : ThemeId
+    ThemeId: ThemeId
 
     /// The URL base
-        UrlBase : string
+    UrlBase: string
 
     /// The time zone in which dates/times should be displayed
-        TimeZone : string
+    TimeZone: string
     
     /// The RSS options for this web log
-        Rss : RssOptions
+    Rss: RssOptions
     
     /// Whether to automatically load htmx
-        AutoHtmx : bool
+    AutoHtmx: bool
     
     /// Where uploads are placed
-        Uploads : UploadDestination
+    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
@@ -391,77 +351,78 @@ 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 an Instant (UTC reference) to the web log's local date/time
-    let localTime webLog (date : Instant) =
+    member this.LocalTime(date: Instant) =
-        match DateTimeZoneProviders.Tzdb[webLog.TimeZone] with
+        DateTimeZoneProviders.Tzdb.GetZoneOrNull this.TimeZone
-        | null -> date.ToDateTimeUtc ()
+        |> Option.ofObj
-        | tz -> date.InZone(tz).ToDateTimeUnspecified ()
+        |> 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
+    Id: WebLogUserId
 
     /// The ID of the web log to which this user belongs
-        WebLogId : WebLogId
+    WebLogId: WebLogId
 
     /// The user name (e-mail address)
-        Email : string
+    Email: string
 
     /// The user's first name
-        FirstName : string
+    FirstName: string
 
     /// The user's last name
-        LastName : string
+    LastName: string
 
     /// The user's preferred name
-        PreferredName : string
+    PreferredName: string
 
     /// The hash of the user's password
-        PasswordHash : string
+    PasswordHash: string
 
     /// The URL of the user's personal site
-        Url : string option
+    Url: string option
 
     /// The user's access level
-        AccessLevel : AccessLevel
+    AccessLevel: AccessLevel
     
     /// When the user was created
-        CreatedOn : Instant
+    CreatedOn: Instant
     
     /// When the user last logged on
-        LastSeenOn : Instant 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      = ""
@@ -470,16 +431,10 @@ module WebLogUser =
           Url           = None
           AccessLevel   = Author
           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

@@ -7,9 +7,11 @@
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="Markdig" Version="0.30.4" />
+    <PackageReference Include="Markdig" Version="0.36.2" />
-    <PackageReference Include="Markdown.ColorCode" Version="1.0.2" />
+    <PackageReference Include="Markdown.ColorCode" Version="2.2.1" />
-    <PackageReference Include="NodaTime" Version="3.1.6" />
+    <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.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

@@ -13,25 +13,25 @@ module Extensions =
     open Microsoft.Extensions.DependencyInjection
     
     /// Hold variable for the configured generator string
-    let mutable private generatorString : string option = None
+    let mutable private generatorString: string option = None
     
     type HttpContext with
         
         /// The anti-CSRF service
-        member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
+        member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>()
         
         /// The cross-site request forgery token set for this request
         member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
 
         /// The data implementation
-        member this.Data = this.RequestServices.GetRequiredService<IData> ()
+        member this.Data = this.RequestServices.GetRequiredService<IData>()
         
         /// The generator string
         member this.Generator =
             match generatorString with
             | Some gen -> gen
             | None ->
-                let cfg = this.RequestServices.GetRequiredService<IConfiguration> ()
+                let cfg = this.RequestServices.GetRequiredService<IConfiguration>()
                 generatorString <-
                     match Option.ofObj cfg["Generator"] with
                     | Some gen -> Some gen
@@ -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,7 +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
@@ -65,30 +65,56 @@ 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 fill (data: IData) = backgroundTask {
-        let! webLogs = data.WebLog.All ()
+        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)
@@ -100,28 +126,28 @@ module PageListCache =
     open MyWebLog.ViewModels
     
     /// Cache of displayed pages
-    let private _cache = ConcurrentDictionary<WebLogId, DisplayPage[]> ()
+    let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array> ()
     
-    let private fillPages (webLog : WebLog) pages =
+    let private fillPages (webLog: WebLog) pages =
         _cache[webLog.Id] <-
             pages
-            |> List.map (fun pg -> DisplayPage.fromPage webLog { pg with Text = "" })
+            |> 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.Id
+    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.Id]
+    let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
     
     /// Update the pages for the current web log
-    let update (ctx : HttpContext) = backgroundTask {
+    let update (ctx: HttpContext) = backgroundTask {
         let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
         fillPages ctx.WebLog pages
     }
     
     /// Refresh the pages for the given web log
-    let refresh (webLog : WebLog) (data : IData) = backgroundTask {
+    let refresh (webLog: WebLog) (data: IData) = backgroundTask {
         let! pages = data.Page.FindListed webLog.Id
         fillPages webLog pages
     }
@@ -133,22 +159,22 @@ module CategoryCache =
     open MyWebLog.ViewModels
     
     /// The cache itself
-    let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory[]> ()
+    let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array> ()
     
     /// Are there categories cached for this web log?
-    let exists (ctx : HttpContext) = _cache.ContainsKey ctx.WebLog.Id
+    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.Id]
+    let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
     
     /// Update the cache with fresh data
-    let update (ctx : HttpContext) = backgroundTask {
+    let update (ctx: HttpContext) = backgroundTask {
         let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
         _cache[ctx.WebLog.Id] <- cats
     }
     
     /// Refresh the category cache for the given web log
-    let refresh webLogId (data : IData) = backgroundTask {
+    let refresh webLogId (data: IData) = backgroundTask {
         let! cats = data.Category.FindAllForView webLogId
         _cache[webLogId] <- cats
     }
@@ -165,11 +191,11 @@ module TemplateCache =
     let private _cache = ConcurrentDictionary<string, Template> ()
     
     /// Custom include parameter pattern
-    let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
+    let private hasInclude = Regex("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
     
     /// Get a template for the given theme and template name
-    let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
+    let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
-        let templatePath = $"{ThemeId.toString themeId}/{templateName}"
+        let templatePath = $"{themeId}/{templateName}"
         match _cache.ContainsKey templatePath with
         | true -> return Ok _cache[templatePath]
         | false ->
@@ -189,16 +215,16 @@ module TemplateCache =
                                     if childNotFound = "" then child.Groups[1].Value
                                     else $"{childNotFound}; {child.Groups[1].Value}"
                                 ""
-                        text <- text.Replace (child.Value, childText)
+                        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)
+                        _cache[templatePath] <- Template.Parse(text, SyntaxCompatibility.DotLiquid22)
                         return Ok _cache[templatePath]
                 | None ->
-                    return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}"
+                    return Error $"Theme ID {themeId} does not have a template named {templateName}"
-            | None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist"
+            | None -> return Error $"Theme ID {themeId} does not exist"
     }
     
     /// Get all theme/template names currently cached
@@ -206,16 +232,16 @@ module TemplateCache =
         _cache.Keys |> Seq.sort |> Seq.toList
     
     /// Invalidate all template cache entries for the given theme ID
-    let invalidateTheme (themeId : ThemeId) =
+    let invalidateTheme (themeId: ThemeId) =
-        let keyPrefix = ThemeId.toString themeId
+        let keyPrefix = string themeId
         _cache.Keys
-        |> Seq.filter (fun key -> key.StartsWith keyPrefix)
+        |> 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 ()
+        _cache.Clear()
 
 
 /// A cache of asset names by themes
@@ -228,14 +254,14 @@ module ThemeAssetCache =
     let get themeId = _cache[themeId]
     
     /// Refresh the list of assets for the given theme
-    let refreshTheme themeId (data : IData) = backgroundTask {
+    let refreshTheme themeId (data: IData) = backgroundTask {
         let! assets = data.ThemeAsset.FindByTheme themeId
         _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
     }
     
     /// Fill the theme asset cache
-    let fill (data : IData) = backgroundTask {
+    let fill (data: IData) = backgroundTask {
-        let! assets = data.ThemeAsset.All ()
+        let! assets = data.ThemeAsset.All()
         for asset in assets do
             let (ThemeAssetId (themeId, path)) = asset.Id
             if not (_cache.ContainsKey themeId) then _cache[themeId] <- []

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
@@ -17,11 +18,11 @@ type Context with
 
 
 /// Does an asset exist for the current theme?
-let assetExists fileName (webLog : WebLog) =
+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,130 +30,130 @@ 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 () =
+type AbsoluteLinkFilter() =
-    static member AbsoluteLink (ctx : Context, item : obj) =
+    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
-type CategoryLinkFilter () =
+type CategoryLinkFilter() =
-    static member CategoryLink (ctx : Context, catObj : obj) =
+    static member CategoryLink(ctx: Context, catObj: obj) =
         match catObj with
         | :? DisplayCategory as cat   -> Some cat.Slug
         | :? 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}')"
 
 
 /// A filter to generate a link that will edit a page
-type EditPageLinkFilter () =
+type EditPageLinkFilter() =
-    static member EditPageLink (ctx : Context, pageObj : obj) =
+    static member EditPageLink(ctx: Context, pageObj: obj) =
         match pageObj with
         | :? DisplayPage as page  -> Some page.Id
         | :? DropProxy   as proxy -> Option.ofObj proxy["Id"] |> Option.map string
         | :? 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}')"
 
 
 /// A filter to generate a link that will edit a post
-type EditPostLinkFilter () =
+type EditPostLinkFilter() =
-    static member EditPostLink (ctx : Context, postObj : obj) =
+    static member EditPostLink(ctx: Context, postObj: obj) =
         match postObj with
         | :? PostListItem as post  -> Some post.Id
         | :? DropProxy    as proxy -> Option.ofObj proxy["Id"] |> Option.map string
         | :? 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 () =
+type NavLinkFilter() =
-    static member NavLink (ctx : Context, url : string, text : string) =
+    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 ""
 
 
 /// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
-type ThemeAssetFilter () =
+type ThemeAssetFilter() =
-    static member ThemeAsset (ctx : Context, asset : string) =
+    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
-type PageHeadTag () =
+type PageHeadTag() =
-    inherit Tag ()
+    inherit Tag()
     
-    override this.Render (context : Context, result : TextWriter) =
+    override this.Render(context: Context, result: TextWriter) =
         let webLog = context.WebLog
         // spacer
         let s      = "    "
         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(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
-            result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
+            result.WriteLine(feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
             
         if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
             let slug = context.Environments[0].["slug"] :?> string
-            result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
+            result.WriteLine(feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
             
         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
-type PageFootTag () =
+type PageFootTag() =
-    inherit Tag ()
+    inherit Tag()
     
-    override this.Render (context : Context, result : TextWriter) =
+    override this.Render(context: Context, result: TextWriter) =
         let webLog = context.WebLog
         // spacer
         let s = "    "
@@ -161,48 +162,48 @@ type PageFootTag () =
             result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
         
         if assetExists "script.js" webLog then
-            result.WriteLine $"""{s}<script src="{ThemeAssetFilter.ThemeAsset (context, "script.js")}"></script>"""
+            result.WriteLine $"""{s}<script src="{ThemeAssetFilter.ThemeAsset(context, "script.js")}"></script>"""
 
 
 /// A filter to generate a relative link
-type RelativeLinkFilter () =
+type RelativeLinkFilter() =
-    static member RelativeLink (ctx : Context, item : obj) =
+    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
-type TagLinkFilter () =
+type TagLinkFilter() =
-    static member TagLink (ctx : Context, tag : string) =
+    static member TagLink(ctx: Context, tag: string) =
         ctx.Environments[0].["tag_mappings"] :?> TagMap list
         |> List.tryFind (fun it -> it.Tag = tag)
         |> function
         | Some tagMap -> tagMap.UrlValue
-        | None        -> tag.Replace (" ", "+")
+        | 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
-type UserLinksTag () =
+type UserLinksTag() =
-    inherit Tag ()
+    inherit Tag()
     
-    override this.Render (context : Context, result : TextWriter) =
+    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 }}`)
-type ValueFilter () =
+type ValueFilter() =
-    static member Value (_ : Context, items : MetaItem list, name : string) =
+    static member Value(_: Context, items: MetaItem list, name: string) =
         match items |> List.tryFind (fun it -> it.Name = name) with
         | Some item -> item.Value
         | None -> $"-- {name} not found --"
@@ -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<DisplayTheme>;          typeof<DisplayUpload>;        typeof<DisplayUser>
+      typeof<PostListItem>;   typeof<UserMessage>
-      typeof<EditCategoryModel>; 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,16 +3,17 @@ module MyWebLog.Handlers.Admin
 
 open System.Threading.Tasks
 open Giraffe
+open Giraffe.Htmx
 open MyWebLog
 open MyWebLog.ViewModels
 open NodaTime
 
-/// ~~ DASHBOARDS ~~
+/// ~~~ DASHBOARDS ~~~
 module Dashboard =
     
     // GET /admin/dashboard
     let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-        let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
+        let getCount (f: WebLogId -> Task<int>) = f ctx.WebLog.Id
         let  data    = ctx.Data
         let! posts   = getCount (data.Post.CountByStatus Published)
         let! drafts  = getCount (data.Post.CountByStatus Draft)
@@ -20,62 +21,27 @@ module Dashboard =
         let! listed  = getCount data.Page.CountListed
         let! cats    = getCount data.Category.CountAll
         let! topCats = getCount data.Category.CountTopLevel
-        return!
+        let model =
-            hashForPage "Dashboard"
+            { Posts              = posts
-            |> addToHash ViewContext.Model {
-                    Posts              = posts
               Drafts             = drafts
               Pages              = pages
               ListedPages        = listed
               Categories         = cats
-                    TopLevelCategories = topCats
+              TopLevelCategories = topCats }
-                }
+        return! adminPage "Dashboard" false next ctx (Views.WebLog.dashboard model)
-            |> adminView "dashboard" next ctx
     }
 
     // GET /admin/administration
     let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
-        match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
+        let! themes = ctx.Data.Theme.All()
-        | Ok bodyTemplate ->
+        return! adminPage "myWebLog Administration" true next ctx (Views.Admin.dashboard themes)
-            let! themes          = ctx.Data.Theme.All ()
-            let  cachedTemplates = TemplateCache.allNames ()
-            let! hash =
-                hashForPage "myWebLog Administration"
-                |> withAntiCsrf ctx
-                |> addToHash "themes" (
-                    themes
-                    |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse)
-                    |> Array.ofList)
-                |> addToHash "cached_themes" (
-                    themes
-                    |> Seq.ofList
-                    |> Seq.map (fun it -> [|
-                        ThemeId.toString it.Id
-                        it.Name
-                        cachedTemplates
-                        |> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id))
-                        |> List.length
-                        |> string
-                    |])
-                    |> Array.ofSeq)
-                |> addToHash "web_logs" (
-                    WebLogCache.all ()
-                    |> Seq.ofList
-                    |> Seq.sortBy (fun it -> it.Name)
-                    |> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |])
-                    |> Array.ofSeq)
-                |> addViewContext ctx
-            return!
-                addToHash "theme_list" (bodyTemplate.Render hash) hash
-                |> adminView "admin-dashboard" next ctx
-        | Error message -> return! Error.server message next ctx
     }
 
 /// Redirect the user to the admin dashboard
 let toAdminDashboard : HttpHandler = redirectToGet "admin/administration"
 
 
-/// ~~ CACHES ~~
+/// ~~~ CACHES ~~~
 module Cache =
     
     // POST /admin/cache/web-log/{id}/refresh
@@ -87,17 +53,17 @@ module Cache =
                 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" }
+                    { UserMessage.Success with Message = "Successfully refresh web log cache for all web logs" }
         else
-            match! data.WebLog.FindById (WebLogId webLogId) with
+            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}" }
+                        { 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}" }
+                do! addMessage ctx { UserMessage.Error with Message = $"No web log exists with ID {webLogId}" }
         return! toAdminDashboard next ctx
     }
 
@@ -108,55 +74,38 @@ module Cache =
             TemplateCache.empty ()
             do! ThemeAssetCache.fill data
             do! addMessage ctx
-                    { UserMessage.success with
+                    { UserMessage.Success with
-                        Message = "Successfully cleared template cache and refreshed theme asset cache"
+                        Message = "Successfully cleared template cache and refreshed theme asset cache" }
-                    }
         else
-            match! data.Theme.FindById (ThemeId themeId) with
+            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
+                        { UserMessage.Success with
-                            Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}"
+                            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}" }
+                do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" }
         return! toAdminDashboard next ctx
     }
 
 
-/// ~~ CATEGORIES ~~
+/// ~~~ CATEGORIES ~~~
 module Category =
     
     open MyWebLog.Data
 
     // GET /admin/categories
-    let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let all : HttpHandler = fun next ctx ->
-        match! TemplateCache.get adminTheme "category-list-body" ctx.Data with
+        let response = fun next ctx ->
-        | Ok catListTemplate ->
+            adminPage "Categories" true next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
-            let! hash =
+        (withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
-                hashForPage "Categories"
-                |> withAntiCsrf ctx
-                |> addViewContext ctx
-            return!
-                   addToHash "category_list" (catListTemplate.Render hash) hash
-                |> adminView "category-list" next ctx
-        | Error message -> return! Error.server message next ctx
-    }
-
-    // GET /admin/categories/bare
-    let bare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
-        hashForPage "Categories"
-        |> withAntiCsrf ctx
-        |> adminBareView "category-list-body" next ctx
-
 
     // GET /admin/category/{id}/edit
-    let edit 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)
@@ -165,19 +114,17 @@ module Category =
         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 save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let save : HttpHandler = fun next ctx -> task {
         let  data     = ctx.Data
-        let! model    = ctx.BindFormAsync<EditCategoryModel> ()
+        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 ->
@@ -186,16 +133,15 @@ module Category =
                     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! bare next ctx
+            return! all next ctx
         | None -> return! Error.notFound next ctx
     }
 
-    // POST /admin/category/{id}/delete
+    // DELETE /admin/category/{id}
     let delete catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
         let! result = ctx.Data.Category.Delete (CategoryId catId) ctx.WebLog.Id
         match result with
@@ -207,78 +153,142 @@ module Category =
                 | 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 }
+            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" }
+            do! addMessage ctx { UserMessage.Error with Message = "Category not found; cannot delete" }
-        return! bare next ctx
+        return! all next ctx
     }
 
 
-/// ~~ TAG MAPPINGS ~~
+/// ~~~ REDIRECT RULES ~~~
-module TagMapping =
+module RedirectRules =
 
     open Microsoft.AspNetCore.Http
 
-    /// Add tag mappings to the given hash
+    // GET /admin/settings/redirect-rules
-    let withTagMappings (ctx : HttpContext) hash = task {
+    let all : HttpHandler = fun next ctx ->
-        let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
+        adminPage "Redirect Rules" true next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
-        return
+
-               addToHash "mappings"    mappings hash
+    // GET /admin/settings/redirect-rules/[index]
-            |> addToHash "mapping_ids" (
+    let edit idx : HttpHandler = fun next ctx ->
-                mappings
+        let titleAndView =
-                |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
+            if idx = -1 then
+                Some ("Add", Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule -1 RedirectRule.Empty))
+            else        
+                let rules = ctx.WebLog.RedirectRules
+                if rules.Length < idx || idx < 0 then
+                    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 all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let all : HttpHandler = fun next ctx -> task {
-        let! hash =
+        let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
-            hashForPage ""
+        return! adminBarePage "Tag Mapping List" true next ctx (Views.WebLog.tagMapList mappings)
-            |> withAntiCsrf    ctx
-            |> withTagMappings ctx
-        return! adminBareView "tag-mapping-list-body" next ctx hash
     }
 
     // GET /admin/settings/tag-mapping/{id}/edit
-    let edit 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 save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+    let save : HttpHandler = fun next ctx -> task {
         let  data   = ctx.Data
-        let! model  = ctx.BindFormAsync<EditTagMapModel> ()
+        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! 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! all next ctx
         | None -> return! Error.notFound next ctx
     }
 
-    // POST /admin/settings/tag-mapping/{id}/delete
+    // DELETE /admin/settings/tag-mapping/{id}
-    let delete 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! all next ctx
     }
 
 
-/// ~~ THEMES ~~
+/// ~~~ THEMES ~~~
 module Theme =
     
     open System
@@ -291,30 +301,26 @@ module Theme =
     let all : HttpHandler = requireAccess Administrator >=> fun next ctx -> task { 
         let! themes = ctx.Data.Theme.All ()
         return!
-            hashForPage "Themes"
+            Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
-            |> withAntiCsrf ctx
+            |> adminBarePage "Themes" true next ctx
-            |> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
-            |> adminBareView "theme-list-body" next ctx
     }
 
     // GET /admin/theme/new
     let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
-        hashForPage "Upload a Theme File"
+        adminBarePage "Upload a Theme File" true next ctx Views.Admin.themeUpload
-        |> withAntiCsrf ctx
-        |> adminBareView "theme-upload" next ctx
 
     /// Update the name and version for a theme based on the version.txt file, if present
-    let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
+    let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
         let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
         match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
         | Some versionItem ->
-            use  versionFile = new StreamReader(versionItem.Open ())
+            use  versionFile = new StreamReader(versionItem.Open())
-            let! versionText = versionFile.ReadToEndAsync ()
+            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 () }
     }
 
     /// Update the theme with all templates from the ZIP archive
@@ -323,9 +329,9 @@ module Theme =
             zip.Entries
             |> Seq.filter (fun it -> it.Name.EndsWith ".liquid")
             |> Seq.map (fun templateItem -> backgroundTask {
-                use templateFile = new StreamReader (templateItem.Open ())
+                use templateFile = new StreamReader(templateItem.Open())
-                let! template = templateFile.ReadToEndAsync ()
+                let! template = templateFile.ReadToEndAsync()
-                return { Name = templateItem.Name.Replace (".liquid", ""); Text = template }
+                return { Name = templateItem.Name.Replace(".liquid", ""); Text = template }
             })
         let! templates = Task.WhenAll tasks
         return
@@ -336,37 +342,37 @@ module Theme =
     }
 
     /// Update theme assets from the ZIP archive
-    let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundTask {
+    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/", "")
+            let assetName = asset.FullName.Replace("wwwroot/", "")
             if assetName <> "" && not (assetName.EndsWith "/") then
-                use stream = new MemoryStream ()
+                use stream = new MemoryStream()
                 do! asset.Open().CopyToAsync stream
                 do! data.ThemeAsset.Save
-                        {   Id        = ThemeAssetId (themeId, assetName)
+                        {   Id        = ThemeAssetId(themeId, assetName)
                             UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime)
-                                            .InZoneLeniently(DateTimeZone.Utc).ToInstant ()
+                                            .InZoneLeniently(DateTimeZone.Utc).ToInstant()
-                            Data      = stream.ToArray ()
+                            Data      = stream.ToArray()
                         }
     }
 
     /// Derive the theme ID from the file name given
-    let deriveIdFromFileName (fileName : string) =
+    let deriveIdFromFileName (fileName: string) =
-        let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-")
+        let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace(" ", "-")
         if themeName.EndsWith "-theme" then
-            if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then
+            if Regex.IsMatch(themeName, """^[a-z0-9\-]+$""") then
-                Ok (ThemeId (themeName.Substring (0, themeName.Length - 6)))
+                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 loadFromZip themeId file (data : IData) = backgroundTask {
+    let loadFromZip themeId file (data: IData) = backgroundTask {
         let! isNew, theme = backgroundTask {
             match! data.Theme.FindById themeId with
             | Some t -> return false, t
-            | None   -> return true, { Theme.empty with Id = themeId }
+            | None   -> return true, { Theme.Empty with Id = themeId }
         }
-        use  zip   = new ZipArchive (file, ZipArchiveMode.Read)
+        use  zip   = new ZipArchive(file, ZipArchiveMode.Read)
         let! theme = updateNameAndVersion theme zip
         if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id
         let! theme = updateTemplates { theme with Templates = [] } zip
@@ -381,37 +387,35 @@ module Theme =
         if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
             let themeFile = Seq.head ctx.Request.Form.Files
             match deriveIdFromFileName themeFile.FileName with
-            | Ok themeId when themeId <> adminTheme ->
+            | 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> ()
+                let! model  = ctx.BindFormAsync<UploadThemeModel>()
                 if isNew || model.DoOverwrite then 
                     // Load the theme to the database
-                    use stream = new MemoryStream ()
+                    use stream = new MemoryStream()
                     do! themeFile.CopyToAsync stream
                     let! _ = loadFromZip themeId stream data
                     do! ThemeAssetCache.refreshTheme themeId data
                     TemplateCache.invalidateTheme themeId
                     // Save the .zip file
-                    use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
+                    use file = new FileStream($"./themes/{themeId}-theme.zip", FileMode.Create)
                     do! themeFile.CopyToAsync file
                     do! addMessage ctx
-                            { UserMessage.success with
+                            { UserMessage.Success with
-                                Message = $"""Theme {if isNew then "add" else "updat"}ed successfully"""
+                                Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" }
-                            }
                     return! toAdminDashboard next ctx
                 else
                     do! addMessage ctx
-                            { UserMessage.error with
+                            { UserMessage.Error with
-                                Message = "Theme exists and overwriting was not requested; nothing saved"
+                                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! toAdminDashboard next ctx
             | Error message ->
-                do! addMessage ctx { UserMessage.error with Message = message }
+                do! addMessage ctx { UserMessage.Error with Message = message }
                 return! toAdminDashboard next ctx
         else return! RequestErrors.BAD_REQUEST "Bad request" next ctx
     }
@@ -421,87 +425,53 @@ module Theme =
         let data = ctx.Data
         match themeId with
         | "admin" | "default" ->
-            do! addMessage ctx { UserMessage.error with Message = $"You may not delete the {themeId} theme" }
+            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
+                    { UserMessage.Error with
-                        Message = $"You may not delete the {themeId} theme, as it is currently in use"
+                        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 = $"{themeId}-theme.zip"
+                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" }
+                do! addMessage ctx { UserMessage.Success with Message = $"Theme ID {themeId} deleted successfully" }
                 return! all next ctx
             | false -> return! Error.notFound next ctx
     }
 
 
-/// ~~ WEB LOG SETTINGS ~~
+/// ~~~ WEB LOG SETTINGS ~~~
 module WebLog =
     
-    open System.Collections.Generic
     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
-        match! TemplateCache.get adminTheme "user-list-body" data with
-        | Ok userTemplate ->
-            match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
-            | Ok tagMapTemplate ->
         let! allPages = data.Page.All ctx.WebLog.Id
-                let! themes   = data.Theme.All ()
+        let  pages    =
-                let! users    = data.WebLogUser.FindByWebLog ctx.WebLog.Id
+            allPages
-                let! hash     =
+            |> List.sortBy _.Title.ToLower()
-                    hashForPage "Web Log Settings"
+            |> List.append [ { Page.Empty with Id = PageId "posts"; Title = "- First Page of Posts -" } ]
-                    |> withAntiCsrf ctx
+        let! themes   = data.Theme.All()
-                    |> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
+        let  uploads  = [ Database; Disk ]
-                    |> 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")
-                    |]
-                    |> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
-                    |> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)
-                    |> addToHash "custom_feeds" (
-                        ctx.WebLog.Rss.CustomFeeds
-                        |> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
-                        |> Array.ofList)
-                    |> addViewContext ctx
-                let! hash' = TagMapping.withTagMappings ctx hash
         return!
-                       addToHash "user_list"        (userTemplate.Render   hash') hash'
+            Views.WebLog.webLogSettings
-                    |> addToHash "tag_mapping_list" (tagMapTemplate.Render hash')
+                (SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
-                    |> adminView "settings" next ctx
+            |> adminPage "Web Log Settings" true next ctx
-            | Error message -> return! Error.server message next ctx
-        | Error message -> return! Error.server message 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> ()
+        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
@@ -509,11 +479,11 @@ module WebLog =
             
             if oldSlug <> webLog.Slug then
                 // Rename disk directory if it exists
-                let uploadRoot = Path.Combine ("wwwroot", "upload")
+                let uploadRoot = Path.Combine("wwwroot", "upload")
-                let oldDir     = Path.Combine (uploadRoot, oldSlug)
+                let oldDir     = Path.Combine(uploadRoot, oldSlug)
-                if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug))
+                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
@@ -23,7 +22,7 @@ type FeedType =
     | Custom       of CustomFeed * string
 
 /// Derive the type of RSS feed requested
-let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
+let deriveFeedType (ctx: HttpContext) feedPath : (FeedType * int) option =
     let webLog    = ctx.WebLog
     let debug     = debug "Feed" ctx
     let name      = $"/{webLog.Rss.FeedName}"
@@ -33,23 +32,22 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
     match webLog.Rss.IsFeedEnabled && feedPath = name with
     | true  ->
         debug (fun () -> "Found standard feed")
-        Some (StandardFeed feedPath, postCount)
+        Some(StandardFeed feedPath, postCount)
     | 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
@@ -62,7 +60,7 @@ let private getFeedPosts ctx feedType =
         | Tag      tag   -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1
 
 /// Strip HTML from a string
-let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "")
+let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\n)*?>", "")
 
 /// XML namespaces for building RSS feeds
 [<RequireQualifiedAccess>]
@@ -87,108 +85,113 @@ 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) =
+        (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 (
+    let item = SyndicationItem(
-        Id              = WebLog.absoluteUrl webLog post.Permalink,
+        Id              = webLog.AbsoluteUrl post.Permalink,
         Title           = TextSyndicationContent.CreateHtmlContent post.Title,
-        PublishDate     = post.PublishedOn.Value.ToDateTimeOffset (),
+        PublishDate     = post.PublishedOn.Value.ToDateTimeOffset(),
-        LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
+        LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
         Content         = TextSyndicationContent.CreatePlaintextContent plainText)
     item.AddPermalink (Uri item.Id)
     
-    let xmlDoc = XmlDocument ()
+    let xmlDoc = XmlDocument()
     
     let encoded =
         let txt =
             post.Text
                 .Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
-                .Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
+                .Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
-        let it  = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
+        let it  = xmlDoc.CreateElement("content", "encoded", Namespace.content)
-        let _   = it.AppendChild (xmlDoc.CreateCDataSection txt)
+        let _   = it.AppendChild(xmlDoc.CreateCDataSection txt)
         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 xmlDoc    = XmlDocument()
     let enclosure =
         let it = xmlDoc.CreateElement "enclosure"
-        it.SetAttribute ("url", epMediaUrl)
+        it.SetAttribute("url", epMediaUrl)
-        it.SetAttribute ("length", string episode.Length)
+        it.SetAttribute("length", string episode.Length)
-        epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
+        epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ))
         it
     let image =
-        let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
+        let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
-        it.SetAttribute ("href", epImageUrl)
+        it.SetAttribute("href", epImageUrl)
         it
         
     item.ElementExtensions.Add enclosure
     item.ElementExtensions.Add image
-    item.ElementExtensions.Add ("creator",  Namespace.dc,     podcast.DisplayedAuthor)
+    item.ElementExtensions.Add("creator",  Namespace.dc,     podcast.DisplayedAuthor)
-    item.ElementExtensions.Add ("author",   Namespace.iTunes, podcast.DisplayedAuthor)
+    item.ElementExtensions.Add("author",   Namespace.iTunes, podcast.DisplayedAuthor)
-    item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
+    item.ElementExtensions.Add("explicit", Namespace.iTunes, epExplicit)
-    episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
+    episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add("subtitle", Namespace.iTunes, it))
-    Episode.formatDuration episode
+    episode.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
-    |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
     
-    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
-        let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
+            Some (toAbsolute webLog chapters), typ
-        elt.SetAttribute ("url", url)
+        | None, None -> None, None
-        typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
+    
+    match chapterUrl with
+    | Some url ->
+        let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
+        elt.SetAttribute("url", url)
+        chapterMimeType |> Option.iter (fun it -> elt.SetAttribute("type", it))
         item.ElementExtensions.Add elt
     | None -> ()
     
     match episode.TranscriptUrl with
     | Some transcript ->
         let url = toAbsolute webLog transcript
-        let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
+        let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast)
-        elt.SetAttribute ("url", url)
+        elt.SetAttribute("url", url)
-        elt.SetAttribute ("type", Option.get episode.TranscriptType)
+        elt.SetAttribute("type", Option.get episode.TranscriptType)
-        episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
+        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 -> ()
     
@@ -196,38 +199,37 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
     | Some season ->
         match episode.SeasonDescription with
         | Some desc ->
-            let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
+            let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast)
-            elt.SetAttribute ("name", desc)
+            elt.SetAttribute("name", desc)
             elt.InnerText <- string season
             item.ElementExtensions.Add elt
-        | None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
+        | None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
     | None -> ()
     
     match episode.EpisodeNumber with
     | Some epNumber ->
         match episode.EpisodeDescription with
         | Some desc ->
-            let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
+            let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast)
-            elt.SetAttribute ("name", desc)
+            elt.SetAttribute("name", desc)
             elt.InnerText <- string epNumber
             item.ElementExtensions.Add elt
-        | None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
+        | None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber)
     | None -> ()
     
     if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
         try
-            let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
+            let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc)
-            chapters.SetAttribute ("version", "1.2")
+            chapters.SetAttribute("version", "1.2")
             
             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)
+                let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
-                chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
+                chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss")
-                chapter.SetAttribute ("title", snd chap)
+                chapter.SetAttribute("title", snd chap)
                 chapters.AppendChild chapter |> ignore)
             
             item.ElementExtensions.Add chapters
@@ -235,26 +237,26 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
     item
     
 /// Add a namespace to the feed
-let private addNamespace (feed : SyndicationFeed) alias nsUrl =
+let private addNamespace (feed: SyndicationFeed) alias nsUrl =
-    feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), 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 addChild (doc: XmlDocument) ns prefix name value (elt: XmlElement) =
         let child =
-            if ns = "" then doc.CreateElement name else doc.CreateElement (prefix, name, ns)
+            if ns = "" then doc.CreateElement name else doc.CreateElement(prefix, name, ns)
             |> elt.AppendChild
         child.InnerText <- value
         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 ()
+    let xmlDoc = XmlDocument()
     
     [ "dc",       Namespace.dc
       "itunes",   Namespace.iTunes
@@ -265,12 +267,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
     
     let categorization =
-        let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+        let it = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
-        it.SetAttribute ("text", podcast.AppleCategory)
+        it.SetAttribute("text", podcast.AppleCategory)
         podcast.AppleSubcategory
         |> Option.iter (fun subCat ->
-            let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+            let subCatElt = xmlDoc.CreateElement("itunes", "category", Namespace.iTunes)
-            subCatElt.SetAttribute ("text", subCat)
+            subCatElt.SetAttribute("text", subCat)
             it.AppendChild subCatElt |> ignore)
         it
     let image = 
@@ -280,19 +282,19 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
         ]
         |> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
     let iTunesImage =
-        let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
+        let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
-        it.SetAttribute ("href", imageUrl)
+        it.SetAttribute("href", imageUrl)
         it
     let owner =
         [ "name", podcast.DisplayedAuthor
           "email", podcast.Email
         ]
         |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
-                     (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
+                     (xmlDoc.CreateElement("itunes", "owner", Namespace.iTunes))
     let rawVoice =
-        let it = xmlDoc.CreateElement ("rawvoice", "subscribe", Namespace.rawVoice)
+        let it = xmlDoc.CreateElement("rawvoice", "subscribe", Namespace.rawVoice)
-        it.SetAttribute ("feed", feedUrl)
+        it.SetAttribute("feed", feedUrl)
-        it.SetAttribute ("itunes", "")
+        it.SetAttribute("itunes", "")
         it
     
     rssFeed.ElementExtensions.Add image
@@ -300,25 +302,24 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
     rssFeed.ElementExtensions.Add categorization
     rssFeed.ElementExtensions.Add iTunesImage
     rssFeed.ElementExtensions.Add rawVoice
-    rssFeed.ElementExtensions.Add ("summary",   Namespace.iTunes,   podcast.Summary)
+    rssFeed.ElementExtensions.Add("summary",  Namespace.iTunes, podcast.Summary)
-    rssFeed.ElementExtensions.Add ("author",    Namespace.iTunes,   podcast.DisplayedAuthor)
+    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.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add("subtitle", Namespace.iTunes, sub))
     podcast.FundingUrl
     |> Option.iter (fun url ->
-        let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
+        let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
-        funding.SetAttribute ("url", toAbsolute webLog url)
+        funding.SetAttribute("url", toAbsolute webLog url)
         funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
         rssFeed.ElementExtensions.Add funding)
     podcast.PodcastGuid
     |> Option.iter (fun guid ->
-        rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
+        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 =
-    let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", ""))
+    let withoutFeed (it: string) = Permalink(it.Replace($"/{webLog.Rss.FeedName}", ""))
     match feedType with
     | StandardFeed     path
     | CategoryFeed (_, path)
@@ -330,8 +331,8 @@ let private selfAndLink webLog feedType ctx =
         | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" 
 
 /// Set the title and description of the feed based on its source
-let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) =
+let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCategory[]) (feed: SyndicationFeed) =
-    let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def))
+    let cleanText opt def = TextSyndicationContent(stripHtml (defaultArg opt def))
     match feedType with
     | StandardFeed _ ->
         feed.Title       <- cleanText None webLog.Name
@@ -359,7 +360,7 @@ let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCat
                 feed.Description <- cleanText None $"""Posts with the "{tag}" tag"""
     
 /// Create a feed with a known non-zero-length list of posts    
-let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
+let createFeed (feedType: FeedType) posts : HttpHandler = fun next ctx -> backgroundTask {
     let  webLog     = ctx.WebLog
     let  data       = ctx.Data
     let! authors    = getAuthors     webLog posts data
@@ -373,40 +374,40 @@ 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
         
-    let feed = SyndicationFeed ()
+    let feed = SyndicationFeed()
     addNamespace feed "content" Namespace.content
     setTitleAndDescription feedType webLog cats feed
     
-    feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
+    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)
     
-    use mem = new MemoryStream ()
+    use mem = new MemoryStream()
     use xml = XmlWriter.Create mem
     feed.SaveAsRss20 xml
-    xml.Close ()
+    xml.Close()
     
-    let _ = mem.Seek (0L, SeekOrigin.Begin)
+    let _ = mem.Seek(0L, SeekOrigin.Begin)
     let rdr = new StreamReader(mem)
-    let! output = rdr.ReadToEndAsync ()
+    let! output = rdr.ReadToEndAsync()
     
     return! (setHttpHeader "Content-Type" "text/xml" >=> setStatusCode 200 >=> setBodyFromString output) next ctx
 }
 
 // GET {any-prescribed-feed}
-let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
+let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> backgroundTask {
     match! getFeedPosts ctx feedType postCount with
     | posts when List.length posts > 0 -> return! createFeed feedType posts next ctx
     | _ -> return! Error.notFound next ctx
@@ -417,13 +418,13 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac
 // POST /admin/settings/rss
 let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
     let  data  = ctx.Data
-    let! model = ctx.BindFormAsync<EditRssModel> ()
+    let! model = ctx.BindFormAsync<EditRssModel>()
     match! data.WebLog.FindById ctx.WebLog.Id with
     | Some webLog ->
         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-settings" next ctx
     | None -> return! Error.notFound next ctx
 }
@@ -432,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
@@ -457,45 +461,42 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
     let data = ctx.Data
     match! data.WebLog.FindById ctx.WebLog.Id with
     | Some webLog ->
-        let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
+        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-settings" next ctx
     | None -> return! Error.notFound next ctx
 }

src/MyWebLog/Handlers/Helpers.fs

@@ -3,13 +3,14 @@ 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
     
     /// Set an item in the session
-    member this.Set<'T> (key, item : 'T) =
+    member this.Set<'T>(key, item: 'T) =
-        this.SetString (key, JsonSerializer.Serialize item)
+        this.SetString(key, JsonSerializer.Serialize item)
     
     /// Get an item from the session
     member this.TryGet<'T> key =
@@ -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"
@@ -126,28 +131,28 @@ module ViewContext =
 let private sessionLoadedKey = "session-loaded"
 
 /// Load the session if it has not been loaded already; ensures async access but not excessive loading
-let private loadSession (ctx : HttpContext) = task {
+let private loadSession (ctx: HttpContext) = task {
     if not (ctx.Items.ContainsKey sessionLoadedKey) then
-        do! ctx.Session.LoadAsync ()
+        do! ctx.Session.LoadAsync()
-        ctx.Items.Add (sessionLoadedKey, "yes")
+        ctx.Items.Add(sessionLoadedKey, "yes")
 }
 
 /// Ensure that the session is committed
-let private commitSession (ctx : HttpContext) = task {
+let private commitSession (ctx: HttpContext) = task {
-    if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync ()
+    if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync()
 }
 
 open MyWebLog.ViewModels
 
 /// Add a message to the user's session
-let addMessage (ctx : HttpContext) message = task {
+let addMessage (ctx: HttpContext) message = task {
     do! loadSession ctx
     let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> []
-    ctx.Session.Set (ViewContext.Messages, message :: msg)
+    ctx.Session.Set(ViewContext.Messages, message :: msg)
 }
 
 /// Get any messages from the user's session, removing them in the process
-let messages (ctx : HttpContext) = task {
+let messages (ctx: HttpContext) = task {
     do! loadSession ctx
     match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with
     | Some msg ->
@@ -160,23 +165,19 @@ open MyWebLog
 open DotLiquid
 
 /// Shorthand for creating a DotLiquid hash from an anonymous object
-let makeHash (values : obj) =
+let makeHash (values: obj) =
     Hash.FromAnonymousObject values
 
 /// Create a hash with the page title filled
-let hashForPage (title : string) =
+let hashForPage (title: string) =
     makeHash {| page_title = title |}
 
 /// Add a key to the hash, returning the modified hash
 //    (note that the hash itself is mutated; this is only used to make it pipeable)
-let addToHash key (value : obj) (hash : Hash) =
+let addToHash key (value: obj) (hash: Hash) =
-    if hash.ContainsKey key then hash[key] <- value else hash.Add (key, value)
+    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
@@ -185,40 +186,70 @@ 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) =
+let isHtmx (ctx: HttpContext) =
     ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
 
 /// Convert messages to headers (used for htmx responses)
-let messagesToHeaders (messages : UserMessage array) : HttpHandler =
+let messagesToHeaders (messages: UserMessage array) : HttpHandler =
     seq {
         yield!
             messages
@@ -234,9 +265,12 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
 /// 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
 }
 
+/// The MIME type for podcast episode JSON chapters
+let JSON_CHAPTERS = "application/json+chapters"
+
 
 /// Handlers for error conditions
 module Error =
@@ -247,24 +281,24 @@ 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" }
                 |]
                 RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
             else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
@@ -272,13 +306,13 @@ module Error =
     let server message : HttpHandler =
         handleContext (fun ctx ->
             if isHtmx ctx then
-                let messages = [| { UserMessage.error with Message = message } |]
+                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 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;
@@ -296,13 +330,13 @@ let viewForTheme themeId template next ctx (hash : Hash) = task {
 }
 
 /// Render a bare view for the specified theme, using the specified template and hash
-let bareForTheme themeId template next ctx (hash : Hash) = task {
+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)
+            | Ok contentTemplate -> return Ok(addToHash ViewContext.Content (contentTemplate.Render hash) hash)
             | Error message -> return Error message 
     }
     match! withContent with
@@ -311,7 +345,7 @@ let bareForTheme themeId template next ctx (hash : Hash) = task {
         match! TemplateCache.get themeId "layout-bare" ctx.Data with
         | Ok layoutTemplate ->
             return!
-                (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
+                (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array)
                  >=> htmlString (layoutTemplate.Render completeHash))
                     next ctx
         | Error message -> return! Error.server message next ctx
@@ -324,16 +358,22 @@ let themedView template next ctx hash = task {
     return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
 }
 
-/// The ID for the admin theme
+/// Display a page for an admin endpoint
-let adminTheme = ThemeId "admin"
+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 view for the admin theme
+/// Display a bare page for an admin endpoint
-let adminView template =
+let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
-    viewForTheme adminTheme template
+    let! messages = getCurrentMessages ctx
-
+    let  appCtx   = generateViewContext pageTitle messages includeCsrf ctx
-/// Display a bare view for the admin theme
+    return!
-let adminBareView template =
+        (    messagesToHeaders appCtx.Messages
-    bareForTheme adminTheme template
+         >=> 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 {
@@ -348,59 +388,61 @@ 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
 }
 
 /// Determine if a user is authorized to edit a page or post, given the author        
-let canEdit authorId (ctx : HttpContext) =
+let canEdit authorId (ctx: HttpContext) =
     ctx.UserId = authorId || ctx.HasAccessLevel Editor
 
 open System.Threading.Tasks
 
 /// Create a Task with a Some result for the given object
-let someTask<'T> (it : 'T) = Task.FromResult (Some it)
+let someTask<'T> (it: 'T) = Task.FromResult(Some it)
+
+/// 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 System.Collections.Generic
 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 {
+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) =
+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) =
+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
@@ -416,13 +458,12 @@ let getCategoryIds slug ctx =
     |> Seq.map (fun c -> CategoryId c.Id)
     |> List.ofSeq
 
-open System
-open System.Globalization
 open NodaTime
 
 /// Parse a date/time to UTC 
-let parseToUtc (date : string) =
+let parseToUtc (date: string) : Instant =
-    Instant.FromDateTimeUtc (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
@@ -431,25 +472,24 @@ open Microsoft.Extensions.Logging
 let mutable private debugEnabled : bool option = None
 
 /// Is debug enabled for handlers?
-let private isDebugEnabled (ctx : HttpContext) =
+let private isDebugEnabled (ctx: HttpContext) =
     match debugEnabled with
     | Some flag -> flag
     | None ->
-        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
         let log = fac.CreateLogger "MyWebLog.Handlers"
-        debugEnabled <- Some (log.IsEnabled LogLevel.Debug)
+        debugEnabled <- Some(log.IsEnabled LogLevel.Debug)
         debugEnabled.Value
 
 /// Log a debug message
-let debug (name : string) ctx msg =
+let debug (name: string) ctx msg =
     if isDebugEnabled ctx then
-        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+        let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
         let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
-        log.LogDebug (msg ())
+        log.LogDebug(msg ())
 
 /// Log a warning message
-let warn (name : string) (ctx : HttpContext) msg =
+let warn (name: string) (ctx: HttpContext) msg =
-    let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+    let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory>()
     let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
     log.LogWarning msg
-    

src/MyWebLog/Handlers/Page.fs

@@ -9,26 +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
-    return!
+    let displayPages =
-        hashForPage "Pages"
+        pages
-        |> withAntiCsrf ctx
-        |> addToHash "pages"     (pages
         |> Seq.ofList
         |> Seq.truncate 25
-                                  |> Seq.map (DisplayPage.fromPageMinimal ctx.WebLog)
+        |> Seq.map (DisplayPage.FromPageMinimal ctx.WebLog)
-                                  |> List.ofSeq)
+        |> List.ofSeq
-        |> addToHash "page_nbr"  pageNbr
+    return!
-        |> addToHash "prev_page" (if pageNbr = 2 then "" else $"/page/{pageNbr - 1}")
+        Views.Page.pageList displayPages pageNbr (pages.Length > 25)
-        |> addToHash "has_next"  (List.length pages > 25)
+        |> adminPage "Pages" true next ctx
-        |> 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)
@@ -36,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
@@ -66,24 +54,23 @@ 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
 }
 
 // POST /admin/page/permalinks
 let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
+    let! model  = ctx.BindFormAsync<ManagePermalinksModel>()
     let  pageId = PageId model.Id
     match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with
     | Some pg when canEdit pg.AuthorId ctx ->
         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
@@ -95,29 +82,28 @@ 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
 }
 
 open Microsoft.AspNetCore.Http
 
 /// Find the page and the requested revision
-let private findPageRevision pgId revDate (ctx : HttpContext) = task {
+let private findPageRevision pgId revDate (ctx: HttpContext) = task {
     match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with
     | Some pg ->
         let asOf = parseToUtc revDate
@@ -129,19 +115,9 @@ 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 ->
-        let _, extra = WebLog.hostAndPath ctx.WebLog
+        return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
-        return! {|
-            content =
-                [   """<div class="mwl-revision-preview mb-3">"""
-                    (MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
-                    "</div>"
-                ]
-                |> String.concat ""
-        |}
-        |> 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/page/{id}/revision/{revision-date}/restore
@@ -151,22 +127,21 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
         do! ctx.Data.Page.Update
                 { pg with
                     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
@@ -174,26 +149,26 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
 
 // POST /admin/page/save
 let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model   = ctx.BindFormAsync<EditPageModel> ()
+    let! model   = ctx.BindFormAsync<EditPageModel>()
     let  data    = ctx.Data
     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

@@ -6,7 +6,7 @@ open System.Collections.Generic
 open MyWebLog
 
 /// Parse a slug and page number from an "everything else" URL
-let private parseSlugAndPage webLog (slugAndPage : string seq) =
+let private parseSlugAndPage webLog (slugAndPage: string seq) =
     let fullPath = slugAndPage |> Seq.head
     let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head
     let slugs, isFeed =
@@ -24,9 +24,10 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) =
         | idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1])
         | _ -> None
     let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs
-    pageNbr, String.Join ("/", slugParts), isFeed
+    pageNbr, String.Join("/", slugParts), isFeed
 
 /// The type of post list being prepared
+[<Struct>]
 type ListType =
     | AdminList
     | CategoryList
@@ -39,15 +40,15 @@ open MyWebLog.Data
 open MyWebLog.ViewModels
 
 /// Convert a list of posts into items ready to be displayed
-let preparePostList webLog posts listType (url : string) pageNbr perPage (data : IData) = task {
+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
@@ -55,10 +56,10 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
             let post   = List.head posts
             let target = defaultArg post.PublishedOn post.UpdatedOn
             data.Post.FindSurroundingPosts webLog.Id target
-        | _ -> Task.FromResult (None, None)
+        | _ -> 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 {||}
@@ -114,8 +115,8 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
 }
 
 // GET /page/{pageNbr}/
-let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx ->
+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}
@@ -163,7 +164,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
             | None   -> return urlTag
         }
         if isFeed then
-            return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
+            return! Feed.generate (Feed.TagFeed(tag, $"tag/{rawTag}/{webLog.Rss.FeedName}"))
                         (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx
         else
             match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with
@@ -178,13 +179,13 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
                     |> themedView "index" next ctx
             // Other systems use hyphens for spaces; redirect if this is an old tag link
             | _ ->
-                let spacedTag = tag.Replace ("-", " ")
+                let spacedTag = tag.Replace("-", " ")
                 match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with
                 | posts when List.length posts > 0 ->
                     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,24 +297,23 @@ 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
 }
 
 // POST /admin/post/permalinks
 let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model  = ctx.BindFormAsync<ManagePermalinksModel> ()
+    let! model  = ctx.BindFormAsync<ManagePermalinksModel>()
     let  postId = PostId model.Id
     match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
     | Some post when canEdit post.AuthorId ctx ->
         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
 }
@@ -317,7 +347,7 @@ let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx
 open Microsoft.AspNetCore.Http
 
 /// Find the post and the requested revision
-let private findPostRevision postId revDate (ctx : HttpContext) = task {
+let private findPostRevision postId revDate (ctx: HttpContext) = task {
     match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
     | Some post ->
         let asOf = parseToUtc revDate
@@ -329,19 +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 ->
-        let _, extra = WebLog.hostAndPath ctx.WebLog
+        return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
-        return! {|
-            content =
-                [   """<div class="mwl-revision-preview mb-3">"""
-                    (MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
-                    "</div>"
-                ]
-                |> String.concat ""
-        |}
-        |> 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
@@ -351,39 +371,124 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
         do! ctx.Data.Post.Update
                 { post with
                     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! model   = ctx.BindFormAsync<EditPostModel>()
     let  data    = ctx.Data
     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
@@ -397,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
@@ -409,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

@@ -11,27 +11,32 @@ module CatchAll =
     open MyWebLog.ViewModels
     
     /// Sequence where the first returned value is the proper handler for the link
-    let private deriveAction (ctx : HttpContext) : HttpHandler seq =
+    let private deriveAction (ctx: HttpContext) : HttpHandler seq =
         let webLog   = ctx.WebLog
         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")
         }
@@ -88,13 +93,13 @@ module CatchAll =
 module Asset =
     
     // GET /theme/{theme}/{**path}
-    let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
+    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.ToDateTimeUtc ()) path asset.Data next ctx
+            | None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc()) path asset.Data next ctx
         | None -> return! Error.notFound next ctx
     }
 
@@ -107,9 +112,8 @@ let router : HttpHandler = choose [
     subRoute "/admin" (requireUser >=> choose [
         GET_HEAD >=> choose [
             route    "/administration" >=> Admin.Dashboard.admin
-            subRoute "/categor" (choose [
+            subRoute "/categor" (requireAccess WebLogAdmin >=> choose [
                 route  "ies"       >=> Admin.Category.all
-                route  "ies/bare"  >=> Admin.Category.bare
                 routef "y/%s/edit"     Admin.Category.edit
             ])
             route    "/dashboard" >=> Admin.Dashboard.user
@@ -129,18 +133,24 @@ 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.WebLog.settings
                 routef   "/rss/%s/edit"     Feed.editCustomFeed
-                subRoute "/user" (choose [
+                subRoute "/redirect-rules" (choose [
-                    route  "s"        >=> User.all
+                    route  ""    >=> Admin.RedirectRules.all
-                    routef "/%s/edit"     User.edit
+                    routef "/%i"     Admin.RedirectRules.edit
                 ])
                 subRoute "/tag-mapping" (choose [
                     route  "s"        >=> Admin.TagMapping.all
                     routef "/%s/edit"     Admin.TagMapping.edit
                 ])
+                subRoute "/user" (choose [
+                    route  "s"        >=> User.all
+                    routef "/%s/edit"     User.edit
+                ])
             ])
             subRoute "/theme" (choose [
                 route "/list" >=> Admin.Theme.all
@@ -156,7 +166,7 @@ let router : HttpHandler = choose [
                 routef "/theme/%s/refresh"   Admin.Cache.refreshTheme
                 routef "/web-log/%s/refresh" Admin.Cache.refreshWebLog
             ])
-            subRoute "/category" (choose [
+            subRoute "/category" (requireAccess WebLogAdmin >=> choose [
                 route  "/save"      >=> Admin.Category.save
                 routef "/%s/delete"     Admin.Category.delete
             ])
@@ -164,43 +174,56 @@ let router : HttpHandler = choose [
             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.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.TagMapping.save
+                    routef "/%i"      Admin.RedirectRules.save
-                    routef "/%s/delete"     Admin.TagMapping.delete
+                    routef "/%i/up"   Admin.RedirectRules.moveUp
-                ])
+                    routef "/%i/down" Admin.RedirectRules.moveDown
-                subRoute "/user" (choose [
-                    route  "/save"      >=> User.save
-                    routef "/%s/delete"     User.delete
                 ])
+                route "/tag-mapping/save" >=> Admin.TagMapping.save
+                route "/user/save"        >=> User.save
             ])
             subRoute "/theme" (choose [
                 route  "/new"       >=> Admin.Theme.save
                 routef "/%s/delete"     Admin.Theme.delete
             ])
-            subRoute "/upload" (choose [
+            route "/upload/save" >=> Upload.save
-                route   "/save"        >=> Upload.save
+        ]
-                routexp "/delete/(.*)"     Upload.deleteFromDisk
+        DELETE >=> validateCsrf >=> choose [
-                routef  "/%s/delete"       Upload.deleteFromDb
+            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
             ])
         ]
     ])
@@ -229,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

@@ -12,7 +12,7 @@ module private Helpers =
     open Microsoft.AspNetCore.StaticFiles
     
     /// A MIME type mapper instance to use when serving files from the database
-    let mimeMap = FileExtensionContentTypeProvider ()
+    let mimeMap = FileExtensionContentTypeProvider()
 
     /// A cache control header that instructs the browser to cache the result for no more than 30 days
     let cacheForThirtyDays =
@@ -24,7 +24,7 @@ module private Helpers =
     let slash = Path.DirectorySeparatorChar
     
     /// The base directory where uploads are stored, relative to the executable
-    let uploadDir = Path.Combine ("wwwroot", "upload")
+    let uploadDir = Path.Combine("wwwroot", "upload")
 
 
 // ~~ SERVING UPLOADS ~~
@@ -35,10 +35,10 @@ 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 =
+let checkModified since (ctx: HttpContext) : HttpHandler option =
     match ctx.Request.Headers.IfModifiedSince with
     | it when it.Count < 1 -> None
-    | it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
+    | it when since > Instant.FromDateTimeUtc(DateTime.Parse(it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
     | _ -> Some (setStatusCode 304)
 
 
@@ -53,29 +53,29 @@ let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx ->
     let headers = ResponseHeaders ctx.Response.Headers
     headers.ContentType  <- (deriveMimeType >> MediaTypeHeaderValue) path
     headers.CacheControl <- cacheForThirtyDays
-    let stream = new MemoryStream (data)
+    let stream = new MemoryStream(data)
     streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx
 
 
 open MyWebLog
 
 // GET /upload/{web-log-slug}/{**path}
-let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
+let serve (urlParts: string seq) : HttpHandler = fun next ctx -> task {
     let webLog = ctx.WebLog
     let parts  = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
     let slug   = Array.head parts
     if slug = webLog.Slug then
         // Static file middleware will not work in subdirectories; check for an actual file first
-        let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..])
+        let fileName = Path.Combine("wwwroot", (Seq.head urlParts)[1..])
         if File.Exists fileName then
             return! streamFile true fileName None None next ctx
         else
-            let path = String.Join ('/', Array.skip 1 parts)
+            let path = String.Join('/', Array.skip 1 parts)
             match! ctx.Data.Upload.FindByPath path webLog.Id with
             | Some upload ->
                 match checkModified upload.UpdatedOn ctx with
                 | Some threeOhFour -> return! threeOhFour next ctx
-                | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) 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
@@ -87,122 +87,109 @@ 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 {
     let  webLog      = ctx.WebLog
     let! dbUploads   = ctx.Data.Upload.FindByWebLog webLog.Id
     let  diskUploads =
-        let path = Path.Combine (uploadDir, webLog.Slug)
+        let path = Path.Combine(uploadDir, webLog.Slug)
         try
-            Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
+            Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories)
             |> Seq.map (fun file ->
                 let name = Path.GetFileName file
                 let create =
-                    match File.GetCreationTime (Path.Combine (path, file)) with
+                    match File.GetCreationTime(Path.Combine(path, file)) with
                     | dt when dt > DateTime.UnixEpoch -> Some dt
                     | _ -> None
                 {   DisplayUpload.Id = ""
                     Name             = name
-                    Path             = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
+                    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 {
     if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
         let upload    = Seq.head ctx.Request.Form.Files
         let fileName  = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
-                                       Path.GetExtension(upload.FileName).ToLowerInvariant ())
+                                       Path.GetExtension(upload.FileName).ToLowerInvariant())
         let  now      = Noda.now ()
-        let  localNow = WebLog.localTime ctx.WebLog now
+        let  localNow = ctx.WebLog.LocalTime now
         let  year     = localNow.ToString "yyyy"
         let  month    = localNow.ToString "MM"
-        let! form     = ctx.BindFormAsync<UploadFileModel> ()
+        let! form     = ctx.BindFormAsync<UploadFileModel>()
         
-        match UploadDestination.parse form.Destination with
+        match UploadDestination.Parse form.Destination with
         | Database ->
-            use stream = new MemoryStream ()
+            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 = now
-                    Data      = stream.ToArray ()
+                    Data      = stream.ToArray() }
-                }
             do! ctx.Data.Upload.Add file
         | Disk ->
-            let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
+            let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
             let _        = Directory.CreateDirectory fullPath
-            use stream   = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
+            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
 }
 
 /// Remove a directory tree if it is empty
-let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
+let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
     let mutable path     = Path.GetDirectoryName filePath
     let mutable finished = false
     while (not finished) && path > "" do
-        let fullPath = Path.Combine (uploadDir, webLog.Slug, path)
+        let fullPath = Path.Combine(uploadDir, webLog.Slug, path)
         if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
             Directory.Delete fullPath
             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)
+    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

@@ -5,23 +5,22 @@ open System
 open Microsoft.AspNetCore.Http
 open Microsoft.AspNetCore.Identity
 open MyWebLog
-open NodaTime
 
 // ~~ LOG ON / LOG OFF ~~
 
 /// Create a password hash a password for a given user
 let createPasswordHash user password =
-    PasswordHasher<WebLogUser>().HashPassword (user, password)
+    PasswordHasher<WebLogUser>().HashPassword(user, password)
 
 /// Verify whether a password is valid
-let verifyPassword user password (ctx : HttpContext) = backgroundTask {
+let verifyPassword user password (ctx: HttpContext) = backgroundTask {
     match user with
     | Some usr ->
-        let hasher = PasswordHasher<WebLogUser> ()
+        let hasher = PasswordHasher<WebLogUser>()
-        match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
+        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) }
+            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"
@@ -36,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
@@ -48,90 +44,74 @@ open Microsoft.AspNetCore.Authentication.Cookies
 
 // POST /user/log-on
 let doLogOn : HttpHandler = fun next ctx -> task {
-    let! model   = ctx.BindFormAsync<LogOnModel> ()
+    let! model   = ctx.BindFormAsync<LogOnModel>()
     let  data    = ctx.Data
     let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
     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.Name,           $"{user.FirstName} {user.LastName}")
-            Claim (ClaimTypes.GivenName,      user.PreferredName)
+            Claim(ClaimTypes.GivenName,      user.PreferredName)
-            Claim (ClaimTypes.Role,           AccessLevel.toString user.AccessLevel)
+            Claim(ClaimTypes.Role,           string user.AccessLevel)
         }
-        let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
+        let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
 
-        do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
+        do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
-            AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
+            AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
         do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
         do! addMessage ctx
-                { UserMessage.success with
+                { UserMessage.Success with
                     Message = "Log on successful"
-                    Detail  = Some $"Welcome to {ctx.WebLog.Name}!"
+                    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 = msg }
+        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
 
 /// Got no time for URL/form manipulators...
 let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
 
 // GET /admin/settings/users
-let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let all : HttpHandler = fun next ctx -> task {
     let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
-    return!
+    return! adminBarePage "User Administration" true next ctx (Views.User.userList users)
-        hashForPage "User Administration"
-        |> withAntiCsrf ctx
-        |> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
-        |> adminBareView "user-list-body" next ctx
 }
 
 /// Show the edit user page
-let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
+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/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/settings/user/{id}/delete
+// DELETE /admin/settings/user/{id}
-let delete userId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
+let delete userId : HttpHandler = fun next ctx -> task {
     let data = ctx.Data
     match! data.WebLogUser.FindById (WebLogUserId userId) ctx.WebLog.Id with
     | Some user ->
@@ -141,43 +121,31 @@ 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
             | 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
     | None -> return! Error.notFound next ctx
 }
 
-/// Display the user "my info" page, with information possibly filled in
-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 (Instant.FromUnixTimeSeconds 0)))
-                                         
-    |> adminView "my-info" next ctx
-
-
 // GET /admin/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/my-info
 let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
-    let! model = ctx.BindFormAsync<EditMyInfoModel> ()
+    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 ->
@@ -187,15 +155,16 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
                 FirstName     = model.FirstName
                 LastName      = model.LastName
                 PreferredName = model.PreferredName
-                PasswordHash  = pw
+                PasswordHash  = pw }
-            }
         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/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
 }
 
@@ -204,15 +173,15 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
 
 // POST /admin/settings/user/save
 let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
-    let! model   = ctx.BindFormAsync<EditUserModel> ()
+    let! model   = ctx.BindFormAsync<EditUserModel>()
     let  data    = ctx.Data
     let  tryUser =
         if model.IsNew then
-            { WebLogUser.empty with
+            { WebLogUser.Empty with
-                Id        = WebLogUserId.create ()
+                Id        = WebLogUserId.Create()
                 WebLogId  = ctx.WebLog.Id
-                CreatedOn = Noda.now ()
+                CreatedOn = Noda.now () }
-            } |> someTask
+            |> someTask
         else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
     match! tryUser with
     | Some user when model.Password = model.PasswordConfirm ->
@@ -225,12 +194,11 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
                 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
+                    { UserMessage.Success with
-                        Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully"""
+                        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" }
+        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

src/MyWebLog/Maintenance.fs

@@ -7,9 +7,9 @@ open MyWebLog.Data
 open NodaTime
 
 /// Create the web log information
-let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
+let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task {
     
-    let data = sp.GetRequiredService<IData> ()
+    let data = sp.GetRequiredService<IData>()
     
     let timeZone =
         let local = TimeZoneInfo.Local.Id
@@ -21,30 +21,29 @@ 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
     // admin just over their web log
-    let! webLogs     = data.WebLog.All ()
+    let! webLogs     = data.WebLog.All()
     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 now  = Noda.now ()
     let user =
-        { WebLogUser.empty with
+        { WebLogUser.Empty with
             Id            = userId
             WebLogId      = webLogId
             Email         = args[3]
@@ -52,13 +51,12 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
             LastName      = "User"
             PreferredName = "Admin"
             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
@@ -69,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
@@ -91,8 +87,8 @@ let createWebLog args sp = task {
 }
 
 /// Import prior permalinks from a text files with lines in the format "[old] [new]"
-let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
+let private importPriorPermalinks urlBase file (sp: IServiceProvider) = task {
-    let data = sp.GetRequiredService<IData> ()
+    let data = sp.GetRequiredService<IData>()
 
     match! data.WebLog.FindByHost urlBase with
     | Some webLog ->
@@ -110,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}"
 }
@@ -129,7 +125,7 @@ let importLinks args sp = task {
 open Microsoft.Extensions.Logging
 
 /// Load a theme from the given ZIP file
-let loadTheme (args : string[]) (sp : IServiceProvider) = task {
+let loadTheme (args: string[]) (sp: IServiceProvider) = task {
     if args.Length = 2 then
         let fileName =
             match args[1].LastIndexOf Path.DirectorySeparatorChar with
@@ -137,14 +133,14 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
             | it -> args[1][(it + 1)..]
         match Handlers.Admin.Theme.deriveIdFromFileName fileName with
         | Ok themeId ->
-            let data   = sp.GetRequiredService<IData> ()
+            let data   = sp.GetRequiredService<IData>()
-            use stream = File.Open (args[1], FileMode.Open)
+            use stream = File.Open(args[1], FileMode.Open)
-            use copy   = new MemoryStream ()
+            use copy   = new MemoryStream()
             do! stream.CopyToAsync copy
             let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
-            let fac = sp.GetRequiredService<ILoggerFactory> ()
+            let fac = sp.GetRequiredService<ILoggerFactory>()
             let log = fac.CreateLogger "MyWebLog.Themes"
-            log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
+            log.LogInformation $"{theme.Name} v{theme.Version} ({theme.Id}) loaded"
         | Error message -> eprintfn $"{message}"
     else
         eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
@@ -159,103 +155,96 @@ module Backup =
     /// A theme asset, with the data base-64 encoded
     type EncodedAsset =
         {   /// The ID of the theme asset
-            Id : ThemeAssetId
+            Id: ThemeAssetId
             
             /// The updated date for this asset
-            UpdatedOn : Instant
+            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) =
+        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 =
+        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 =
         {   /// The ID of the upload
-            Id : UploadId
+            Id: UploadId
             
             /// The ID of the web log to which the upload belongs
-            WebLogId : WebLogId
+            WebLogId: WebLogId
             
             /// The path at which this upload is served
-            Path : Permalink
+            Path: Permalink
             
             /// The date/time this upload was last updated (file time)
-            UpdatedOn : Instant
+            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 =
+        static member fromUpload (upload: Upload) : EncodedUpload =
             {   Id        = upload.Id
                 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 =
+        static member toUpload (encoded: EncodedUpload) : Upload =
             {   Id        = encoded.Id
                 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 =
         {   /// The web log to which this archive belongs
-            WebLog : WebLog
+            WebLog: WebLog
             
             /// The users for this web log
-            Users : WebLogUser list
+            Users: WebLogUser list
             
             /// The theme used by this web log at the time the archive was made
-            Theme : Theme
+            Theme: Theme
             
             /// Assets for the theme used by this web log at the time the archive was made
-            Assets : EncodedAsset list
+            Assets: EncodedAsset list
             
             /// The categories for this web log
-            Categories : Category list
+            Categories: Category list
             
             /// The tag mappings for this web log
-            TagMappings : TagMap list
+            TagMappings: TagMap list
             
             /// The pages for this web log (containing only the most recent revision)
-            Pages : Page list
+            Pages: Page list
             
             /// The posts for this web log (containing only the most recent revision)
-            Posts : Post list
+            Posts: Post list
             
             /// The uploaded files for this web log
-            Uploads : EncodedUpload list
+            Uploads: EncodedUpload list }
-        }
     
     /// Create a JSON serializer
     let private getSerializer prettyOutput =
-        let serializer = Json.configure (JsonSerializer.CreateDefault ())
+        let serializer = Json.configure (JsonSerializer.CreateDefault())
         if prettyOutput then serializer.Formatting <- Formatting.Indented
         serializer
     
     /// Display statistics for a backup archive
-    let private displayStats (msg : string) (webLog : WebLog) archive =
+    let private displayStats (msg: string) (webLog: WebLog) archive =
 
         let userCount     = List.length archive.Users
         let assetCount    = List.length archive.Assets
@@ -280,7 +269,7 @@ module Backup =
         printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
 
     /// Create a backup archive
-    let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
+    let private createBackup webLog (fileName: string) prettyOutput (data: IData) = task {
         // Create the data structure
         printfn "- Exporting theme..."
         let! theme  = data.Theme.FindById webLog.ThemeId
@@ -312,34 +301,33 @@ 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
         let serializer = getSerializer prettyOutput
-        use writer = new StreamWriter (fileName)
+        use writer = new StreamWriter(fileName)
-        serializer.Serialize (writer, archive)
+        serializer.Serialize(writer, archive)
-        writer.Close ()
+        writer.Close()
         
         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 }
@@ -354,27 +342,22 @@ 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
@@ -383,38 +366,42 @@ module Backup =
         
         // 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..."
         if not (List.isEmpty restore.TagMappings) then do! data.TagMap.Restore   restore.TagMappings
         if not (List.isEmpty restore.Categories)  then do! data.Category.Restore restore.Categories
         
-        printfn "- Restoring pages..."
+        if isInteractive then printfn "- Restoring pages..."
         if not (List.isEmpty restore.Pages) then do! data.Page.Restore restore.Pages
         
-        printfn "- Restoring posts..."
+        if isInteractive then printfn "- Restoring 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)
+        use stream     = new FileStream(fileName, FileMode.Open)
-        use reader     = new StreamReader (stream)
+        use reader     = new StreamReader(stream)
-        use jsonReader = new JsonTextReader (reader)
+        use jsonReader = new JsonTextReader(reader)
         let archive    = serializer.Deserialize<Archive> jsonReader
         
         let mutable doOverwrite = not promptForOverwrite
@@ -424,18 +411,18 @@ 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"
     }
         
     /// Generate a backup archive
-    let generateBackup (args : string[]) (sp : IServiceProvider) = task {
+    let generateBackup (args: string[]) (sp: IServiceProvider) = task {
         if args.Length > 1 && args.Length < 5 then
-            let data = sp.GetRequiredService<IData> ()
+            let data = sp.GetRequiredService<IData>()
             match! data.WebLog.FindByHost args[1] with
             | Some webLog ->
                 let fileName =
@@ -455,11 +442,11 @@ module Backup =
     }
     
     /// Restore a backup archive
-    let restoreFromBackup (args : string[]) (sp : IServiceProvider) = task {
+    let restoreFromBackup (args: string[]) (sp: IServiceProvider) = task {
         if args.Length = 2 || args.Length = 3 then
-            let data       = sp.GetRequiredService<IData> ()
+            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 "         * optional - will restore to original URL base if omitted"
@@ -468,7 +455,7 @@ module Backup =
 
 
 /// Upgrade a WebLogAdmin user to an Administrator user
-let private doUserUpgrade urlBase email (data : IData) = task {
+let private doUserUpgrade urlBase email (data: IData) = task {
     match! data.WebLog.FindByHost urlBase with
     | Some webLog ->
         match! data.WebLogUser.FindByEmail email webLog.Id with
@@ -477,20 +464,20 @@ 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}"
 }
 
 /// Upgrade a WebLogAdmin user to an Administrator user if the command-line arguments are good
-let upgradeUser (args : string[]) (sp : IServiceProvider) = task {
+let upgradeUser (args: string[]) (sp: IServiceProvider) = task {
     match args.Length with
-    | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData> ())
+    | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService<IData>())
     | _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]"
 }
 
 /// Set a user's password
-let doSetPassword urlBase email password (data : IData) = task {
+let doSetPassword urlBase email password (data: IData) = task {
     match! data.WebLog.FindByHost urlBase with
     | Some webLog ->
         match! data.WebLogUser.FindByEmail email webLog.Id with
@@ -502,8 +489,8 @@ let doSetPassword urlBase email password (data : IData) = task {
 }
 
 /// Set a user's password if the command-line arguments are good
-let setPassword (args : string[]) (sp : IServiceProvider) = task {
+let setPassword (args: string[]) (sp: IServiceProvider) = task {
     match args.Length with
-    | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService<IData> ())
+    | 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

@@ -9,6 +9,12 @@
   <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" />
@@ -23,13 +29,15 @@
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="DotLiquid" Version="2.2.682" />
+    <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.5" />
+    <PackageReference Include="Giraffe" Version="6.3.0" />
-    <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" />
+    <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 Include="System.ServiceModel.Syndication" Version="7.0.0" />
+    <PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" />
+    <PackageReference Update="FSharp.Core" Version="8.0.200" />
   </ItemGroup>
 
   <ItemGroup>
@@ -41,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

@@ -5,17 +5,17 @@ open Microsoft.Extensions.Logging
 open MyWebLog
 
 /// Middleware to derive the current web log
-type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>) =
+type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
     
     /// Is the debug level enabled on the logger?
     let isDebug = log.IsEnabled LogLevel.Debug
         
-    member _.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,7 +26,32 @@ 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
@@ -40,41 +65,42 @@ module DataImplementation =
     open RethinkDb.Driver.Net
     
     /// Create an NpgsqlDataSource from the connection string, configuring appropriately
-    let createNpgsqlDataSource (cfg : IConfiguration) =
+    let createNpgsqlDataSource (cfg: IConfiguration) =
-        let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
+        let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL")
-        let _ = builder.UseNodaTime ()
+        let _ = builder.UseNodaTime()
         // let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore))
-        builder.Build ()
+        (builder.Build >> Postgres.Configuration.useDataSource) ()
 
     /// Get the configured data implementation
-    let get (sp : IServiceProvider) : IData =
+    let get (sp: IServiceProvider) : IData =
-        let config   = sp.GetRequiredService<IConfiguration> ()
+        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 : IData =
-            let log  = sp.GetRequiredService<ILogger<SQLiteData>> ()
+            Sqlite.Configuration.useConnectionString connStr
-            let conn = new SqliteConnection (connStr)
+            let log  = sp.GetRequiredService<ILogger<SQLiteData>>()
+            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, Json.configure (JsonSerializer.CreateDefault ()))
         
         if hasConnStr "SQLite" then
             createSQLite (connStr "SQLite")
         elif hasConnStr "RethinkDB" then
-            let log        = sp.GetRequiredService<ILogger<RethinkDbData>> ()
+            let log        = sp.GetRequiredService<ILogger<RethinkDbData>>()
             let _          = Json.configure Converter.Serializer 
             let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
             let conn       = await (rethinkCfg.CreateConnectionAsync log)
-            RethinkDbData (conn, rethinkCfg, log)
+            RethinkDbData(conn, rethinkCfg, log)
         elif hasConnStr "PostgreSQL" then
-            let source = createNpgsqlDataSource config
+            createNpgsqlDataSource config
-            use conn = source.CreateConnection ()
+            use conn = Postgres.Configuration.dataSource().CreateConnection()
-            let log  = sp.GetRequiredService<ILogger<PostgresData>> ()
+            let log  = sp.GetRequiredService<ILogger<PostgresData>>()
             log.LogInformation $"Using PostgreSQL database {conn.Database}"
-            PostgresData (source, log, Json.configure (JsonSerializer.CreateDefault ()))
+            PostgresData(log, Json.configure (JsonSerializer.CreateDefault()))
         else
-            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
@@ -95,21 +121,21 @@ let showHelp () =
     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 ()
+    Task.FromResult()
 
 
-open System.IO
+open BitBadger.AspNetCore.CanonicalDomains
 open Giraffe
 open Giraffe.EndpointRouting
 open Microsoft.AspNetCore.Authentication.Cookies
 open Microsoft.AspNetCore.Builder
 open Microsoft.AspNetCore.HttpOverrides
 open Microsoft.Extensions.Caching.Distributed
-open NeoSmart.Caching.Sqlite
+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) ->
@@ -121,16 +147,16 @@ let rec main args =
                 opts.ExpireTimeSpan    <- TimeSpan.FromMinutes 60.
                 opts.SlidingExpiration <- true
                 opts.AccessDeniedPath  <- "/forbidden")
-    let _ = builder.Services.AddLogging ()
+    let _ = builder.Services.AddLogging()
-    let _ = builder.Services.AddAuthorization ()
+    let _ = builder.Services.AddAuthorization()
-    let _ = builder.Services.AddAntiforgery ()
+    let _ = builder.Services.AddAntiforgery()
     
-    let sp = builder.Services.BuildServiceProvider ()
+    let sp   = builder.Services.BuildServiceProvider()
     let data = DataImplementation.get sp
     let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
     
     task {
-        do! data.StartUp ()
+        do! data.StartUp()
         do! WebLogCache.fill data
         do! ThemeAssetCache.fill data
     } |> Async.AwaitTask |> Async.RunSynchronously
@@ -141,32 +167,26 @@ let rec main args =
         // A RethinkDB connection is designed to work as a singleton
         let _ = builder.Services.AddSingleton<IData> data
         let _ =
-            builder.Services.AddDistributedRethinkDBCache (fun opts ->
+            builder.Services.AddDistributedRethinkDBCache(fun opts ->
                 opts.TableName  <- "Session"
                 opts.Connection <- rethink.Conn)
         ()
-    | :? SQLiteData as sql ->
+    | :? SQLiteData ->
         // ADO.NET connections are designed to work as per-request instantiation
-        let cfg  = sp.GetRequiredService<IConfiguration> ()
+        let cfg  = sp.GetRequiredService<IConfiguration>()
-        let _ =
+        let _ = builder.Services.AddScoped<SqliteConnection>(fun sp -> Sqlite.Configuration.dbConn ())
-            builder.Services.AddScoped<SqliteConnection> (fun sp ->
+        let _ = builder.Services.AddScoped<IData, SQLiteData>()
-                let conn = new SqliteConnection (sql.Conn.ConnectionString)
-                SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
-                conn)
-        let _ = builder.Services.AddScoped<IData, SQLiteData> () |> ignore
         // Use SQLite for caching as well
-        let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./session.db"
+        let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SQLiteCachePath")) "./data/session.db"
-        let _ = builder.Services.AddSqliteCache (fun o -> o.CachePath <- cachePath)
+        let _ = builder.Services.AddSqliteCache(fun o -> o.CachePath <- cachePath)
         ()
     | :? PostgresData as postgres ->
         // ADO.NET Data Sources are designed to work as singletons
-        let _ =
+        let _ = builder.Services.AddSingleton<NpgsqlDataSource>(Postgres.Configuration.dataSource ())
-            builder.Services.AddSingleton<NpgsqlDataSource> (fun sp ->
-                DataImplementation.createNpgsqlDataSource (sp.GetRequiredService<IConfiguration> ()))
         let _ = builder.Services.AddSingleton<IData> postgres
         let _ =
-            builder.Services.AddSingleton<IDistributedCache> (fun _ ->
+            builder.Services.AddSingleton<IDistributedCache>(fun _ ->
-                Postgres.DistributedCache () :> IDistributedCache)
+                Postgres.DistributedCache() :> IDistributedCache)
         ()
     | _ -> ()
     
@@ -174,12 +194,12 @@ let rec main args =
         opts.IdleTimeout        <- TimeSpan.FromMinutes 60
         opts.Cookie.HttpOnly    <- true
         opts.Cookie.IsEssential <- true)
-    let _ = builder.Services.AddGiraffe ()
+    let _ = builder.Services.AddGiraffe()
     
     // Set up DotLiquid
     DotLiquidBespoke.register ()
 
-    let app = builder.Build ()
+    let app = builder.Build()
     
     match args |> Array.tryHead with
     | Some it when it = "init"         -> Maintenance.createWebLog             args app.Services
@@ -195,20 +215,29 @@ let rec main args =
         printfn $"""Unrecognized command "{it}" - valid commands are:"""
         showHelp ()
     | None -> task {
-        // Load all themes in the application directory
+        // Load admin and default themes, and all themes in the /themes directory
-        for themeFile in Directory.EnumerateFiles (".", "*-theme.zip") do
+        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 ()
+        let _ = app.UseForwardedHeaders()
-        let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
+        
-        let _ = app.UseMiddleware<WebLogMiddleware> ()
+        (app.Services.GetRequiredService<IConfiguration>().GetSection "CanonicalDomains").Value
-        let _ = app.UseAuthentication ()
+        |> (isNull >> not)
-        let _ = app.UseStaticFiles ()
+        |> function true -> app.UseCanonicalDomains() |> ignore | false -> ()
-        let _ = app.UseRouting ()
+        
-        let _ = app.UseSession ()
+        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
 
-        app.Run ()
+        app.Run()
     }
     |> Async.AwaitTask |> Async.RunSynchronously
     

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",
+  "Generator": "myWebLog 2.1.1",
   "Logging": {
     "LogLevel": {
       "MyWebLog.Handlers": "Information"
     }
+  },
+  "Kestrel": {
+    "Endpoints": {
+      "Http": {
+        "Url": "http://0.0.0.0:80"
+      }
+    }
   }
 }

src/admin-theme/_edit-common.liquid

@@ -1,32 +0,0 @@
-<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 %}
-    {%- assign entity_url_base = "admin/" | append: entity | append: "/" | append: entity_id -%}
-    <span class="form-text">
-      <a href="{{ entity_url_base | append: "/permalinks" | relative_link }}">Manage Permalinks</a>
-      <span class="text-muted"> &bull; </span>
-      <a href="{{ entity_url_base | 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>

src/admin-theme/_layout.liquid

@@ -1,85 +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/settings" | nav_link: "Settings" }}
-            {%- endif %}
-            {%- if is_administrator %}
-              {{ "admin/administration" | nav_link: "Admin" }}
-            {%- endif %}
-          </ul>
-        {%- endif %}
-        <ul class="navbar-nav flex-grow-1 justify-content-end">
-          {%- if is_logged_on %}
-            {{ "admin/my-info" | nav_link: "My Info" }}
-            <li class="nav-item">
-              <a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
-                 target="_blank">
-                Docs
-              </a>
-            </li>
-            <li class="nav-item">
-              <a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>
-            </li>
-          {%- else -%}
-            <li class="nav-item">
-              <a class="nav-link" href="https://bitbadger.solutions/open-source/myweblog/#how-to-use-myweblog"
-                 target="_blank">
-                Docs
-              </a>
-            </li>
-            {{ "user/log-on" | nav_link: "Log On" }}
-          {%- endif %}
-        </ul>
-      </div>
-    </div>
-  </nav>
-</header>
-<div id="toastHost" class="position-fixed top-0 w-100" aria-live="polite" aria-atomic="true">
-  <div id="toasts" class="toast-container position-absolute p-3 mt-5 top-0 end-0">
-    {% for msg in messages %}
-      <div class="toast" role="alert" aria-live="assertive" aria-atomic="true"
-      {%- unless msg.level == "success" %} data-bs-autohide="false"{% endunless %}>
-        <div class="toast-header bg-{{ msg.level }}{% unless msg.level == "warning" %} text-white{% endunless %}">
-          <strong class="me-auto text-uppercase">
-            {% if msg.level == "danger" %}error{% else %}{{ msg.level}}{% endif %}
-          </strong>
-          <button type="button" class="btn-close" data-bs-dismiss="toast" aria-label="Close"></button>
-        </div>
-        <div class="toast-body bg-{{ msg.level }} bg-opacity-25">
-          {{ msg.message }}
-          {%- if msg.detail %}
-            <hr>
-            {{ msg.detail.value }}
-          {%- endif %}
-        </div>
-      </div>
-    {% endfor %}
-  </div>
-</div>
-<main class="mx-3 mt-3">
-  <div class="load-overlay p-5" id="loadOverlay"><h1 class="p-3">Loading&hellip;</h1></div>
-  {{ content }}
-</main>
-<footer class="position-fixed bottom-0 w-100">
-  <div class="text-end text-white me-2">
-    {%- 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>
-</footer>

src/admin-theme/_theme-list-columns.liquid

@@ -1,3 +0,0 @@
-{%- assign theme_col = "col-12 col-md-6" -%}
-{%- assign slug_col  = "d-none d-md-block col-md-3" -%}
-{%- assign tmpl_col  = "d-none d-md-block col-md-3" -%}

src/admin-theme/_user-list-columns.liquid

@@ -1,4 +0,0 @@
-{%- assign user_col  = "col-12 col-md-4 col-xl-3" -%}
-{%- assign email_col = "col-12 col-md-4 col-xl-4" -%}
-{%- assign cre8_col  = "d-none d-xl-block col-xl-2" -%}
-{%- assign last_col  = "col-12 col-md-4 col-xl-3" -%}

src/admin-theme/admin-dashboard.liquid

@@ -1,108 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <fieldset class="container mb-3 pb-0">
-    <legend>Themes</legend>
-    <a href="{{ "admin/theme/new" | relative_link }}" class="btn btn-primary btn-sm mb-3"
-       hx-target="#theme_new">
-      Upload a New Theme
-    </a>
-    <div class="container g-0">
-      {% include_template "_theme-list-columns" %}
-      <div class="row mwl-table-heading">
-        <div class="{{ theme_col }}">Theme</div>
-        <div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
-        <div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
-      </div>
-    </div>
-    <div class="row mwl-table-detail" id="theme_new"></div>
-    {{ theme_list }}
-  </fieldset>
-  <fieldset class="container mb-3 pb-0">
-    {%- assign cache_base_url = "admin/cache/" -%}
-    <legend>Caches</legend>
-    <div class="row pb-2">
-      <div class="col">
-        <p>
-          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">more information</a>)
-        </p>
-      </div>
-    </div>
-    <div class="row">
-      <div class="col-12 col-lg-6 pb-3">
-        <div class="card">
-          <header class="card-header text-white bg-secondary">Web Logs</header>
-          <div class="card-body pb-0">
-            <h6 class="card-subtitle text-muted pb-3">
-              These caches include the page list and categories for each web log
-            </h6>
-            {%- assign web_log_base_url = cache_base_url | append: "web-log/" -%}
-            <form method="post" class="container g-0" hx-boost="false" hx-target="body"
-                  hx-swap="innerHTML show:window:top">
-              <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-              <button type="submit" class="btn btn-sm btn-primary mb-2"
-                      hx-post="{{ web_log_base_url | append: "all/refresh" | relative_link }}">
-                Refresh All
-              </button>
-              <div class="row mwl-table-heading">
-                <div class="col">Web Log</div>
-              </div>
-              {%- for web_log in web_logs %}
-                <div class="row mwl-table-detail">
-                  <div class="col">
-                    {{ web_log[1] }}<br>
-                    <small>
-                      <span class="text-muted">{{ web_log[2] }}</span><br>
-                      {%- assign refresh_url = web_log_base_url | append: web_log[0] | append: "/refresh" | relative_link -%}
-                      <a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
-                    </small>
-                  </div>
-                </div>
-              {%- endfor %}
-            </form>
-          </div>
-        </div>
-      </div>
-      <div class="col-12 col-lg-6 pb-3">
-        <div class="card">
-          <header class="card-header text-white bg-secondary">Themes</header>
-          <div class="card-body pb-0">
-            <h6 class="card-subtitle text-muted pb-3">
-              The theme template cache is filled on demand as pages are displayed; refreshing a theme with no cached
-              templates will still refresh its asset cache
-            </h6>
-            {%- assign theme_base_url = cache_base_url | append: "theme/" -%}
-            <form method="post" class="container g-0" hx-boost="false" hx-target="body"
-                  hx-swap="innerHTML show:window:top">
-              <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-              <button type="submit" class="btn btn-sm btn-primary mb-2"
-                      hx-post="{{ theme_base_url | append: "all/refresh" | relative_link }}">
-                Refresh All
-              </button>
-              <div class="row mwl-table-heading">
-                <div class="col-8">Theme</div>
-                <div class="col-4">Cached</div>
-              </div>
-              {%- for theme in cached_themes %}
-                {% unless theme[0] == "admin" %}
-                  <div class="row mwl-table-detail">
-                    <div class="col-8">
-                      {{ theme[1] }}<br>
-                      <small>
-                        <span class="text-muted">{{ theme[0] }} &bull; </span>
-                        {%- assign refresh_url = theme_base_url | append: theme[0] | append: "/refresh" | relative_link -%}
-                        <a href="{{ refresh_url }}" hx-post="{{ refresh_url }}">Refresh</a>
-                      </small>
-                    </div>
-                    <div class="col-4">{{ theme[2] }}</div>
-                  </div>
-                {% endunless %}
-              {%- endfor %}
-            </form>
-          </div>
-        </div>
-      </div>
-    </div>
-  </fieldset>
-</article>

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" 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" 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">
-              <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"
-                   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,57 +0,0 @@
-<div id="catList" class="container">
-  <div class="row">
-    <div class="col">
-      {%- 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" -%}
-        <div class="container">
-          <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>
-        <form 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 }}">
-          <div class="row mwl-table-detail" id="cat_new"></div>
-          {% 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 %}
-        </form>
-      {%- else -%}
-        <div id="cat_new">
-          <p class="text-muted fst-italic text-center">This web log has no categores defined</p>
-        </div>
-      {%- endif %}
-    </div>
-  </div>
-</div>

src/admin-theme/category-list.liquid

@@ -1,8 +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>
-  {{ category_list }}
-</article>

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

@@ -1,382 +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-settings" | relative_link }}">&laquo; Back to 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,9 +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" %}
-  </body>
-</html>

src/admin-theme/layout.liquid

@@ -1,19 +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.1.3/dist/css/bootstrap.min.css"
-          integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
-    <link rel="stylesheet" href="{{ "themes/admin/admin.css" | relative_link }}">
-  </head>
-  <body hx-boost="true" hx-indicator="#loadOverlay">
-    {% include_template "_layout" %}
-    <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/js/bootstrap.bundle.min.js"
-            integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p"
-            crossorigin="anonymous"></script>
-    {{ htmx_script }}
-    <script src="{{ "themes/admin/admin.js" | relative_link }}"></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/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,82 +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">
-          {%- assign entity = "page" -%}
-          {%- assign entity_id = model.page_id -%}
-          {% include_template "_edit-common" %}
-        </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 -%}
-  {% if page_count > 0 %}
-    {%- 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 mb-3" 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>
-      {% 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 %}
-    </form>
-    {% if page_nbr > 1 or has_next %}
-      <div class="d-flex justify-content-evenly mb-3">
-        <div>
-          {% if page_nbr > 1 %}
-            <p>
-              <a class="btn btn-secondary" href="{{ "admin/pages" | append: prev_page | relative_link }}">
-                &laquo; Previous
-              </a>
-            </p>
-          {% endif %}
-        </div>
-        <div class="text-right">
-          {% if has_next %}
-            <p>
-              <a class="btn btn-secondary" href="{{ "admin/pages" | append: next_page | relative_link }}">
-                Next &raquo;
-              </a>
-            </p>
-          {% endif %}
-        </div>
-      </div>
-    {% endif %}
-  {% else %}
-    <p class="text-muted fst-italic text-center">This web log has no pages</p>
-  {% 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,315 +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">
-          {%- assign entity = "post" -%}
-          {%- assign entity_id = model.post_id -%}
-          {% include_template "_edit-common" %}
-          <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>
-<script>window.setTimeout(() => Admin.toggleEpisodeFields(), 500)</script>

src/admin-theme/post-list.liquid

@@ -1,98 +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>
-  {%- assign post_count = model.posts | size -%}
-  {%- if post_count > 0 %}
-    <form method="post" class="container mb-3" hx-target="body">
-      <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-      {%- 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>
-      {% 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 %}
-    </form>
-    {% if model.newer_link or model.older_link %}
-      <div class="d-flex justify-content-evenly mb-3">
-        <div>
-          {% if model.newer_link %}
-            <p><a class="btn btn-secondary" 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-secondary" href="{{ model.older_link.value }}">Older Posts &raquo;</a></p>
-          {% endif %}
-        </div>
-      </div>
-    {% endif %}
-  {% else %}
-    <p class="text-muted fst-italic text-center">This web log has no posts</p>
-  {% endif %}
-</article>

src/admin-theme/revisions.liquid

@@ -1,68 +0,0 @@
-<h2 class="my-3">{{ page_title }}</h2>
-<article>
-  <form method="post" hx-target="body">
-    <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-    <input type="hidden" name="id" value="{{ model.id }}">
-    <div class="container mb-3">
-      <div class="row">
-        <div class="col">
-          <p style="line-height:1.2rem;">
-            <strong>{{ model.current_title }}</strong><br>
-            <small class="text-muted">
-              <a href="{{ "admin/" | append: model.entity | append: "/" | append: model.id | append: "/edit" | relative_link }}">
-                &laquo; Back to Edit {{ model.entity | capitalize }}
-              </a>
-            </small>
-          </p>
-        </div>
-      </div>
-      {%- assign revision_count = model.revisions | size -%}
-      {%- assign rev_url_base = "admin/" | append: model.entity | append: "/" | append: model.id | append: "/revision" -%}
-      {%- if revision_count > 1 %}
-        <div class="row mb-3">
-          <div class="col">
-            <button type="button" class="btn btn-sm btn-danger"
-                    hx-post="{{ rev_url_base | append: "s/purge" | relative_link }}"
-                    hx-confirm="This will remove all revisions but the current one; are you sure this is what you wish to do?">
-              Delete All Prior Revisions
-            </button>
-          </div>
-        </div>
-      {%- endif %}
-      <div class="row mwl-table-heading">
-        <div class="col">Revision</div>
-      </div>
-      {% for rev in model.revisions %}
-        {%- assign as_of_string = rev.as_of | date: "o" -%}
-        {%- assign as_of_id = "rev_" | append: as_of_string | replace: "\.", "_" | replace: ":", "-" -%}
-        <div id="{{ as_of_id }}" class="row pb-3 mwl-table-detail">
-          <div class="col-12 mb-1">
-            {{ rev.as_of_local | date: "MMMM d, yyyy" }} at {{ rev.as_of_local | date: "h:mmtt" | downcase }}
-            <span class="badge bg-secondary text-uppercase ms-2">{{ rev.format }}</span>
-            {%- if forloop.first %}
-              <span class="badge bg-primary text-uppercase ms-2">Current Revision</span>
-            {%- endif %}<br>
-            {% unless forloop.first %}
-              {%- assign rev_url_prefix = rev_url_base | append: "/" | append: as_of_string -%}
-              {%- assign rev_restore = rev_url_prefix | append: "/restore" | relative_link -%}
-              {%- assign rev_delete  = rev_url_prefix | append: "/delete"  | relative_link -%}
-              <small>
-                <a href="{{ rev_url_prefix | append: "/preview" | relative_link }}" hx-target="#{{ as_of_id }}_preview">
-                  Preview
-                </a>
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ rev_restore }}" hx-post="{{ rev_restore }}">Restore as Current</a>
-                <span class="text-muted"> &bull; </span>
-                <a href="{{ rev_delete }}" hx-post="{{ rev_delete }}" hx-target="#{{ as_of_id }}" hx-swap="outerHTML"
-                   class="text-danger">
-                  Delete
-                </a>
-              </small>
-            {% endunless %}
-          </div>
-          {% unless forloop.first %}<div id="{{ as_of_id }}_preview" class="col-12"></div>{% endunless %}
-        </div>
-      {% endfor %}
-    </div>
-  </form>
-</article>

src/admin-theme/settings.liquid

@@ -1,246 +0,0 @@
-<h2 class="my-3">{{ web_log.name }} Settings</h2>
-<article>
-  <p class="text-muted">
-    Go to: <a href="#users">Users</a> &bull; <a href="#rss-settings">RSS Settings</a> &bull;
-    <a href="#tag-mappings">Tag Mappings</a>
-  </p>
-  <fieldset class="container mb-3">
-    <legend>Web Log Settings</legend>
-    <form action="{{ "admin/settings" | relative_link }}" method="post">
-      <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-      <div class="container">
-        <div class="row">
-          <div class="col-12 col-md-6 col-xl-4 pb-3">
-            <div class="form-floating">
-              <input type="text" name="Name" id="name" class="form-control" placeholder="Name" required autofocus
-                     value="{{ model.name }}">
-              <label for="name">Name</label>
-            </div>
-          </div>
-          <div class="col-12 col-md-6 col-xl-4 pb-3">
-            <div class="form-floating">
-              <input type="text" name="Slug" id="slug" class="form-control" placeholder="Slug" required
-                     value="{{ model.slug }}">
-              <label for="slug">Slug</label>
-              <span class="form-text">
-                <span class="badge rounded-pill bg-warning text-dark">WARNING</span> changing this value may break
-                links
-                (<a href="https://bitbadger.solutions/open-source/myweblog/configuring.html#blog-settings"
-                    target="_blank">more</a>)
-              </span>
-            </div>
-          </div>
-          <div class="col-12 col-md-6 col-xl-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">Subtitle</label>
-            </div>
-          </div>
-          <div class="col-12 col-md-6 col-xl-4 offset-xl-1 pb-3">
-            <div class="form-floating">
-              <select name="ThemeId" id="themeId" class="form-control" required>
-                {% for theme in themes -%}
-                  <option value="{{ theme[0] }}"{% if model.theme_id == theme[0] %} selected="selected"{% endif %}>
-                    {{ theme[1] }}
-                  </option>
-                {%- endfor %}
-              </select>
-              <label for="themeId">Theme</label>
-            </div>
-          </div>
-          <div class="col-12 col-md-6 offset-md-1 col-xl-4 offset-xl-0 pb-3">
-            <div class="form-floating">
-              <select name="DefaultPage" id="defaultPage" class="form-control" required>
-                {%- for pg in pages %}
-                  <option value="{{ pg[0] }}"{% if pg[0] == model.default_page  %} selected="selected"{% endif %}>
-                    {{ pg[1] }}
-                  </option>
-                {%- endfor %}
-              </select>
-              <label for="defaultPage">Default Page</label>
-            </div>
-          </div>
-          <div class="col-12 col-md-4 col-xl-2 pb-3">
-            <div class="form-floating">
-              <input type="number" name="PostsPerPage" id="postsPerPage" class="form-control" min="0" max="50" required
-                     value="{{ model.posts_per_page }}">
-              <label for="postsPerPage">Posts per Page</label>
-            </div>
-          </div>
-        </div>
-        <div class="row">
-          <div class="col-12 col-md-4 col-xl-3 offset-xl-2 pb-3">
-            <div class="form-floating">
-              <input type="text" name="TimeZone" id="timeZone" class="form-control" placeholder="Time Zone" required
-                     value="{{ model.time_zone }}">
-              <label for="timeZone">Time Zone</label>
-            </div>
-          </div>
-          <div class="col-12 col-md-4 col-xl-2">
-            <div class="form-check form-switch">
-              <input type="checkbox" name="AutoHtmx" id="autoHtmx" class="form-check-input" value="true"
-                     {%- if model.auto_htmx %} checked="checked"{% endif %}>
-              <label for="autoHtmx" class="form-check-label">Auto-Load htmx</label>
-            </div>
-            <span class="form-text fst-italic">
-              <a href="https://htmx.org" target="_blank" rel="noopener">What is this?</a>
-            </span>
-          </div>
-          <div class="col-12 col-md-4 col-xl-3 pb-3">
-            <div class="form-floating">
-              <select name="Uploads" id="uploads" class="form-control">
-                {%- for it in upload_values %}
-                  <option value="{{ it[0] }}"{% if model.uploads == it[0] %} selected{% endif %}>{{ it[1] }}</option>
-                {%- endfor %}
-              </select>
-              <label for="uploads">Default Upload Destination</label>
-            </div>
-          </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>
-  </fieldset>
-  <fieldset id="users" class="container mb-3 pb-0">
-    <legend>Users</legend>
-    {% include_template "_user-list-columns" %}
-    <a href="{{ "admin/settings/user/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
-       hx-target="#user_new">
-      Add a New User
-    </a>
-    <div class="container g-0">
-      <div class="row mwl-table-heading">
-        <div class="{{ user_col }}">User<span class="d-md-none">; Full Name / E-mail; Last Log On</span></div>
-        <div class="{{ email_col }} d-none d-md-inline-block">Full Name / E-mail</div>
-        <div class="{{ cre8_col }}">Created</div>
-        <div class="{{ last_col }} d-none d-md-block">Last Log On</div>
-      </div>
-    </div>
-    {{ user_list }}
-  </fieldset>
-  <fieldset id="rss-settings" class="container mb-3 pb-0">
-    <legend>RSS Settings</legend>
-    <form action="{{ "admin/settings/rss" | relative_link }}" method="post">
-      <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-      <div class="container">
-        <div class="row pb-3">
-          <div class="col col-xl-8 offset-xl-2">
-            <fieldset class="d-flex justify-content-evenly flex-row">
-              <legend>Feeds Enabled</legend>
-              <div class="form-check form-switch pb-2">
-                <input type="checkbox" name="IsFeedEnabled" id="feedEnabled" class="form-check-input" value="true"
-                       {%- if rss_model.is_feed_enabled %} checked="checked"{% endif %}>
-                <label for="feedEnabled" class="form-check-label">All Posts</label>
-              </div>
-              <div class="form-check form-switch pb-2">
-                <input type="checkbox" name="IsCategoryEnabled" id="categoryEnabled" class="form-check-input"
-                       value="true" {%- if rss_model.is_category_enabled %} checked="checked"{% endif %}>
-                <label for="categoryEnabled" class="form-check-label">Posts by Category</label>
-              </div>
-              <div class="form-check form-switch pb-2">
-                <input type="checkbox" name="IsTagEnabled" id="tagEnabled" class="form-check-input" value="true"
-                       {%- if rss_model.tag_enabled %} checked="checked"{% endif %}>
-                <label for="tagEnabled" class="form-check-label">Posts by Tag</label>
-              </div>
-            </fieldset>
-          </div>
-        </div>
-        <div class="row">
-          <div class="col-12 col-sm-6 col-md-3 col-xl-2 offset-xl-2 pb-3">
-            <div class="form-floating">
-              <input type="text" name="FeedName" id="feedName" class="form-control" placeholder="Feed File Name"
-                     value="{{ rss_model.feed_name }}">
-              <label for="feedName">Feed File Name</label>
-              <span class="form-text">Default is <code>feed.xml</code></span>
-            </div>
-          </div>
-          <div class="col-12 col-sm-6 col-md-4 col-xl-2 pb-3">
-            <div class="form-floating">
-              <input type="number" name="ItemsInFeed" id="itemsInFeed" class="form-control" min="0"
-                     placeholder="Items in Feed" required value="{{ rss_model.items_in_feed }}">
-              <label for="itemsInFeed">Items in Feed</label>
-              <span class="form-text">Set to &ldquo;0&rdquo; to use &ldquo;Posts per Page&rdquo; setting ({{ web_log.posts_per_page }})</span>
-            </div>
-          </div>
-          <div class="col-12 col-md-5 col-xl-4 pb-3">
-            <div class="form-floating">
-              <input type="text" name="Copyright" id="copyright" class="form-control" placeholder="Copyright String"
-                     value="{{ rss_model.copyright }}">
-              <label for="copyright">Copyright String</label>
-              <span class="form-text">
-          Can be a
-          <a href="https://creativecommons.org/share-your-work/" target="_blank" rel="noopener">
-            Creative Commons license string
-          </a>
-        </span>
-            </div>
-          </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>
-    <fieldset class="container mb-3 pb-0">
-      <legend>Custom Feeds</legend>
-      <a class="btn btn-sm btn-secondary" href="{{ 'admin/settings/rss/new/edit' | relative_link }}">
-        Add a New Custom Feed
-      </a>
-      {%- assign feed_count = custom_feeds | size -%}
-      {%- if feed_count > 0 %}
-        <form method="post" class="container g-0" hx-target="body">
-          {%- assign source_col = "col-12 col-md-6" -%}
-          {%- assign path_col   = "col-12 col-md-6" -%}
-          <input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
-          <div class="row mwl-table-heading">
-            <div class="{{ source_col }}">
-              <span class="d-md-none">Feed</span><span class="d-none d-md-inline">Source</span>
-            </div>
-            <div class="{{ path_col }} d-none d-md-inline-block">Relative Path</div>
-          </div>
-          {% for feed in custom_feeds %}
-            <div class="row mwl-table-detail">
-              <div class="{{ source_col }}">
-                {{ feed.source }}
-                {%- if feed.is_podcast %} &nbsp; <span class="badge bg-primary">PODCAST</span>{% endif %}<br>
-                <small>
-                  {%- assign feed_url = "admin/settings/rss/" | append: feed.id -%}
-                  <a href="{{ feed.path | relative_link }}" target="_blank">View Feed</a>
-                  <span class="text-muted"> &bull; </span>
-                  <a href="{{ feed_url | append: "/edit" | relative_link }}">Edit</a>
-                  <span class="text-muted"> &bull; </span>
-                  {%- assign feed_del_link = feed_url | append: "/delete" | relative_link -%}
-                  <a href="{{ feed_del_link }}" hx-post="{{ feed_del_link }}" class="text-danger"
-                     hx-confirm="Are you sure you want to delete the custom RSS feed based on {{ feed.source | strip_html | escape }}? This action cannot be undone.">
-                    Delete
-                  </a>
-                </small>
-              </div>
-              <div class="{{ path_col }}">
-                <small class="d-md-none">Served at {{ feed.path }}</small>
-                <span class="d-none d-md-inline">{{ feed.path }}</span>
-              </div>
-            </div>
-          {%- endfor %}
-        </form>
-      {%- else %}
-        <p class="text-muted fst-italic text-center">No custom feeds defined</p>
-      {%- endif %}
-    </fieldset>
-  </fieldset>
-  <fieldset id="tag-mappings" class="container mb-3 pb-0">
-    <legend>Tag Mappings</legend>
-    <a href="{{ "admin/settings/tag-mapping/new/edit" | relative_link }}" class="btn btn-primary btn-sm mb-3"
-       hx-target="#tag_new">
-      Add a New Tag Mapping
-    </a>
-    {{ tag_mapping_list }}
-  </fieldset>
-</article>