v2 RC2 (#33)

* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)

src/Directory.Build.props

@@ -5,6 +5,6 @@
     <AssemblyVersion>2.0.0.0</AssemblyVersion>
     <FileVersion>2.0.0.0</FileVersion>
     <Version>2.0.0</Version>
-    <VersionSuffix>rc1</VersionSuffix>
+    <VersionSuffix>rc2</VersionSuffix>
   </PropertyGroup>
 </Project>

src/MyWebLog.Data/Converters.fs

@@ -122,12 +122,13 @@ module Json =
             (string >> WebLogUserId) reader.Value
 
     open Microsoft.FSharpLu.Json
-
-    /// All converters to use for data conversion
-    let all () : JsonConverter seq =
-        seq {
-            // Our converters
-            CategoryIdConverter       ()
+    open NodaTime
+    open NodaTime.Serialization.JsonNet
+    
+    /// Configure a serializer to use these converters
+    let configure (ser : JsonSerializer) =
+        // Our converters
+        [   CategoryIdConverter       () :> JsonConverter
             CommentIdConverter        ()
             CustomFeedIdConverter     ()
             CustomFeedSourceConverter ()
@@ -143,6 +144,35 @@ module Json =
             UploadIdConverter         ()
             WebLogIdConverter         ()
             WebLogUserIdConverter     ()
-            // Handles DUs with no associated data, as well as option fields
-            CompactUnionJsonConverter ()
-        }
+        ] |> 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.NullValueHandling     <- NullValueHandling.Ignore
+        ser.MissingMemberHandling <- MissingMemberHandling.Ignore
+        ser
+    
+    /// Serializer settings extracted from a JsonSerializer (a property sure would be nice...)
+    let mutable private serializerSettings : JsonSerializerSettings option = None
+    
+    /// Extract settings from the serializer to be used in JsonConvert calls
+    let settings (ser : JsonSerializer) =
+        if Option.isNone serializerSettings then
+            serializerSettings <- JsonSerializerSettings (
+                ConstructorHandling            = ser.ConstructorHandling,
+                ContractResolver               = ser.ContractResolver,
+                Converters                     = ser.Converters,
+                DefaultValueHandling           = ser.DefaultValueHandling,
+                DateFormatHandling             = ser.DateFormatHandling,
+                MetadataPropertyHandling       = ser.MetadataPropertyHandling,
+                MissingMemberHandling          = ser.MissingMemberHandling,
+                NullValueHandling              = ser.NullValueHandling,
+                ObjectCreationHandling         = ser.ObjectCreationHandling,
+                ReferenceLoopHandling          = ser.ReferenceLoopHandling,
+                SerializationBinder            = ser.SerializationBinder,
+                TraceWriter                    = ser.TraceWriter,
+                TypeNameAssemblyFormatHandling = ser.TypeNameAssemblyFormatHandling,
+                TypeNameHandling               = ser.TypeNameHandling)
+                |> Some
+        serializerSettings.Value

src/MyWebLog.Data/Interfaces.fs

@@ -1,9 +1,10 @@
 namespace MyWebLog.Data
 
-open System
 open System.Threading.Tasks
 open MyWebLog
 open MyWebLog.ViewModels
+open Newtonsoft.Json
+open NodaTime
 
 /// The result of a category deletion attempt
 type CategoryDeleteResult =
@@ -137,7 +138,7 @@ type IPostData =
         WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
     
     /// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
-    abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
+    abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task<Post option * Post option>
     
     /// Restore posts from a backup
     abstract member Restore : Post list -> Task<unit>
@@ -326,6 +327,9 @@ type IData =
     /// Web log user data functions
     abstract member WebLogUser : IWebLogUserData
     
+    /// A JSON serializer for use in persistence
+    abstract member Serializer : JsonSerializer
+    
     /// Do any required start up data checks
     abstract member StartUp : unit -> Task<unit>
     

src/MyWebLog.Data/MyWebLog.Data.fsproj

@@ -5,10 +5,16 @@
 	</ItemGroup>
 
 	<ItemGroup>
-		<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.7" />
+		<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.8" />
+		<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
 		<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
 		<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
 		<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
+		<PackageReference Include="NodaTime" Version="3.1.2" />
+		<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
+		<PackageReference Include="Npgsql" Version="6.0.6" />
+		<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
+		<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
 		<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
 		<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
 		<PackageReference Update="FSharp.Core" Version="6.0.5" />
@@ -29,6 +35,17 @@
 		<Compile Include="SQLite\SQLiteWebLogData.fs" />
 		<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
 		<Compile Include="SQLiteData.fs" />
+		<Compile Include="Postgres\PostgresHelpers.fs" />
+		<Compile Include="Postgres\PostgresCache.fs" />
+		<Compile Include="Postgres\PostgresCategoryData.fs" />
+		<Compile Include="Postgres\PostgresPageData.fs" />
+		<Compile Include="Postgres\PostgresPostData.fs" />
+		<Compile Include="Postgres\PostgresTagMapData.fs" />
+		<Compile Include="Postgres\PostgresThemeData.fs" />
+		<Compile Include="Postgres\PostgresUploadData.fs" />
+		<Compile Include="Postgres\PostgresWebLogData.fs" />
+		<Compile Include="Postgres\PostgresWebLogUserData.fs" />
+        <Compile Include="PostgresData.fs" />
 	</ItemGroup>
 
 </Project>

src/MyWebLog.Data/Postgres/PostgresCache.fs

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

src/MyWebLog.Data/Postgres/PostgresCategoryData.fs

@@ -0,0 +1,172 @@
+namespace MyWebLog.Data.Postgres
+
+open MyWebLog
+open MyWebLog.Data
+open Npgsql
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog category data implementation
+type PostgresCategoryData (conn : NpgsqlConnection) =
+    
+    /// Count all categories for the given web log
+    let countAll webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toCount
+    
+    /// Count all top-level categories for the given web log
+    let countTopLevel webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toCount
+    
+    /// Retrieve all categories for the given web log in a DotLiquid-friendly format
+    let findAllForView webLogId = backgroundTask {
+        let! cats =
+            Sql.existingConnection conn
+            |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)"
+            |> Sql.parameters [ webLogIdParam webLogId ]
+            |> Sql.executeAsync Map.toCategory
+        let ordered = Utils.orderByHierarchy cats None None []
+        let counts  =
+            ordered
+            |> Seq.map (fun it ->
+                // Parent category post counts include posts in subcategories
+                let catIdSql, catIdParams =
+                    ordered
+                    |> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
+                    |> Seq.map (fun cat -> cat.Id)
+                    |> Seq.append (Seq.singleton it.Id)
+                    |> List.ofSeq
+                    |> inClause "AND pc.category_id" "id" id
+                let postCount =
+                    Sql.existingConnection conn
+                    |> Sql.query $"
+                        SELECT COUNT(DISTINCT p.id) AS {countName}
+                          FROM post p
+                               INNER JOIN post_category pc ON pc.post_id = p.id
+                         WHERE p.web_log_id = @webLogId
+                           AND p.status     = 'Published'
+                           {catIdSql}"
+                    |> Sql.parameters (webLogIdParam webLogId :: catIdParams)
+                    |> Sql.executeRowAsync Map.toCount
+                    |> Async.AwaitTask
+                    |> Async.RunSynchronously
+                it.Id, postCount)
+            |> List.ofSeq
+        return
+            ordered
+            |> Seq.map (fun cat ->
+                { cat with
+                    PostCount = counts
+                                |> List.tryFind (fun c -> fst c = cat.Id)
+                                |> Option.map snd
+                                |> Option.defaultValue 0
+                })
+            |> Array.ofSeq
+    }
+    /// Find a category by its ID for the given web log
+    let findById catId webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM category WHERE id = @id AND web_log_id = @webLogId"
+        |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
+        |> Sql.executeAsync Map.toCategory
+        |> tryHead
+    
+    /// Find all categories for the given web log
+    let findByWebLog webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeAsync Map.toCategory
+    
+    
+    /// Delete a category
+    let delete catId webLogId = backgroundTask {
+        match! findById catId webLogId with
+        | Some cat ->
+            // Reassign any children to the category's parent category
+            let  parentParam = "@parentId", Sql.string (CategoryId.toString catId)
+            let! hasChildren =
+                Sql.existingConnection conn
+                |> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}"
+                |> Sql.parameters [ parentParam ]
+                |> Sql.executeRowAsync Map.toExists
+            if hasChildren then
+                let! _ =
+                    Sql.existingConnection conn
+                    |> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId"
+                    |> Sql.parameters
+                        [   parentParam
+                            "@newParentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ]
+                    |> Sql.executeNonQueryAsync
+                ()
+            // Delete the category off all posts where it is assigned, and the category itself
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.query
+                    "DELETE FROM post_category
+                      WHERE category_id = @id
+                        AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
+                     DELETE FROM category WHERE id = @id"
+                |> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ]
+                |> Sql.executeNonQueryAsync
+            return if hasChildren then ReassignedChildCategories else CategoryDeleted
+        | None -> return CategoryNotFound
+    }
+    
+    /// The INSERT statement for a category
+    let catInsert =
+        "INSERT INTO category (
+            id, web_log_id, name, slug, description, parent_id
+        ) VALUES (
+            @id, @webLogId, @name, @slug, @description, @parentId
+        )"
+    
+    /// Create parameters for a category insert / update
+    let catParameters (cat : Category) = [
+        webLogIdParam cat.WebLogId
+        "@id",          Sql.string       (CategoryId.toString cat.Id)
+        "@name",        Sql.string       cat.Name
+        "@slug",        Sql.string       cat.Slug
+        "@description", Sql.stringOrNone cat.Description
+        "@parentId",    Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
+    ]
+
+    /// Save a category
+    let save cat = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.query $"
+                {catInsert} ON CONFLICT (id) DO UPDATE
+                SET name        = EXCLUDED.name,
+                    slug        = EXCLUDED.slug,
+                    description = EXCLUDED.description,
+                    parent_id   = EXCLUDED.parent_id"
+            |> Sql.parameters (catParameters cat)
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
+    /// Restore categories from a backup
+    let restore cats = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.executeTransactionAsync [
+                catInsert, cats |> List.map catParameters
+            ]
+        ()
+    }
+    
+    interface ICategoryData with
+        member _.Add cat = save cat
+        member _.CountAll webLogId = countAll webLogId
+        member _.CountTopLevel webLogId = countTopLevel webLogId
+        member _.FindAllForView webLogId = findAllForView webLogId
+        member _.FindById catId webLogId = findById catId webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.Delete catId webLogId = delete catId webLogId
+        member _.Restore cats = restore cats
+        member _.Update cat = save cat

src/MyWebLog.Data/Postgres/PostgresHelpers.fs

@@ -0,0 +1,240 @@
+/// Helper functions for the PostgreSQL data implementation
+[<AutoOpen>]
+module MyWebLog.Data.Postgres.PostgresHelpers
+
+open System
+open System.Threading.Tasks
+open MyWebLog
+open MyWebLog.Data
+open Newtonsoft.Json
+open NodaTime
+open Npgsql
+open Npgsql.FSharp
+
+/// Create a SQL parameter for the web log ID
+let webLogIdParam webLogId =
+    "@webLogId", Sql.string (WebLogId.toString 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"
+
+/// 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}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
+            (Seq.ofList items
+             |> Seq.map (fun it ->
+                 $"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
+             |> Seq.head)
+        |> function sql, ps -> $"{sql})", ps
+
+/// Create the SQL and parameters for the array equivalent of an IN clause
+let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
+    if List.isEmpty items then "TRUE = FALSE", []
+    else
+        let mutable idx = 0
+        items
+        |> List.skip 1
+        |> List.fold (fun (itemS, itemP) it ->
+            idx <- idx + 1
+            $"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
+            ($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
+            (Seq.ofList items
+             |> Seq.map (fun it ->
+                 $"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
+             |> Seq.head)
+    
+/// Get the first result of the given query
+let tryHead<'T> (query : Task<'T list>) = backgroundTask {
+    let! results = query
+    return List.tryHead results
+}
+
+/// Create a parameter for a non-standard type
+let typedParam<'T> name (it : 'T) =
+    $"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
+
+/// Create a parameter for a possibly-missing non-standard type
+let optParam<'T> name (it : 'T option) =
+    let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
+    p.ParameterName, Sql.parameter p
+
+/// Mapping functions for SQL queries
+module Map =
+    
+    /// Map an id field to a category ID
+    let toCategoryId (row : RowReader) =
+        CategoryId (row.string "id")
+    
+    /// Create a category from the current row
+    let toCategory (row : RowReader) : Category =
+        {   Id          = toCategoryId row
+            WebLogId    = row.string       "web_log_id" |> WebLogId
+            Name        = row.string       "name"
+            Slug        = row.string       "slug"
+            Description = row.stringOrNone "description"
+            ParentId    = row.stringOrNone "parent_id"  |> Option.map CategoryId
+        }
+
+    /// Get a count from a row
+    let toCount (row : RowReader) =
+        row.int countName
+    
+    /// Create a custom feed from the current row
+    let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed =
+        {   Id      = row.string       "id"      |> CustomFeedId
+            Source  = row.string       "source"  |> CustomFeedSource.parse
+            Path    = row.string       "path"    |> Permalink
+            Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser)
+        }
+    
+    /// Get a true/false value as to whether an item exists
+    let toExists (row : RowReader) =
+        row.bool existsName
+    
+    /// Create a meta item from the current row
+    let toMetaItem (row : RowReader) : MetaItem =
+        {   Name  = row.string "name"
+            Value = row.string "value"
+        }
+    
+    /// Create a permalink from the current row
+    let toPermalink (row : RowReader) =
+        Permalink (row.string "permalink")
+    
+    /// Create a page from the current row
+    let toPage (ser : JsonSerializer) (row : RowReader) : Page =
+        { Page.empty with
+            Id              = row.string              "id"         |> PageId
+            WebLogId        = row.string              "web_log_id" |> WebLogId
+            AuthorId        = row.string              "author_id"  |> WebLogUserId
+            Title           = row.string              "title"
+            Permalink       = toPermalink row
+            PriorPermalinks = row.stringArray         "prior_permalinks" |> Array.map Permalink |> List.ofArray
+            PublishedOn     = row.fieldValue<Instant> "published_on"
+            UpdatedOn       = row.fieldValue<Instant> "updated_on"
+            IsInPageList    = row.bool                "is_in_page_list"
+            Template        = row.stringOrNone        "template"
+            Text            = row.string              "page_text"
+            Metadata        = row.stringOrNone        "meta_items"
+                              |> Option.map (Utils.deserialize ser)
+                              |> Option.defaultValue []
+        }
+    
+    /// Create a post from the current row
+    let toPost (ser : JsonSerializer) (row : RowReader) : Post =
+        { Post.empty with
+            Id              = row.string                    "id"         |> PostId
+            WebLogId        = row.string                    "web_log_id" |> WebLogId
+            AuthorId        = row.string                    "author_id"  |> WebLogUserId
+            Status          = row.string                    "status"     |> PostStatus.parse
+            Title           = row.string                    "title"
+            Permalink       = toPermalink row
+            PriorPermalinks = row.stringArray               "prior_permalinks" |> Array.map Permalink |> List.ofArray
+            PublishedOn     = row.fieldValueOrNone<Instant> "published_on"
+            UpdatedOn       = row.fieldValue<Instant>       "updated_on"
+            Template        = row.stringOrNone              "template"
+            Text            = row.string                    "post_text"
+            Episode         = row.stringOrNone              "episode"          |> Option.map (Utils.deserialize ser)
+            CategoryIds     = row.stringArrayOrNone         "category_ids"
+                              |> Option.map (Array.map CategoryId >> List.ofArray)
+                              |> Option.defaultValue []
+            Tags            = row.stringArrayOrNone         "tags"
+                              |> Option.map List.ofArray
+                              |> Option.defaultValue []
+            Metadata        = row.stringOrNone              "meta_items"
+                              |> Option.map (Utils.deserialize ser)
+                              |> Option.defaultValue []
+        }
+    
+    /// Create a revision from the current row
+    let toRevision (row : RowReader) : Revision =
+        {   AsOf = row.fieldValue<Instant> "as_of"
+            Text = row.string              "revision_text" |> MarkupText.parse
+        }
+    
+    /// Create a tag mapping from the current row
+    let toTagMap (row : RowReader) : TagMap =
+        {   Id       = row.string "id"         |> TagMapId
+            WebLogId = row.string "web_log_id" |> WebLogId
+            Tag      = row.string "tag"
+            UrlValue = row.string "url_value"
+        }
+    
+    /// Create a theme from the current row (excludes templates)
+    let toTheme (row : RowReader) : Theme =
+        { Theme.empty with
+            Id      = row.string "id" |> ThemeId
+            Name    = row.string "name"
+            Version = row.string "version"
+        }
+    
+    /// Create a theme asset from the current row
+    let toThemeAsset includeData (row : RowReader) : ThemeAsset =
+        {   Id        = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
+            UpdatedOn = row.fieldValue<Instant> "updated_on"
+            Data      = if includeData then row.bytea "data" else [||]
+        }
+    
+    /// Create a theme template from the current row
+    let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
+        {   Name = row.string "name"
+            Text = if includeText then row.string "template" else ""
+        }
+
+    /// Create an uploaded file from the current row
+    let toUpload includeData (row : RowReader) : Upload =
+        {   Id        = row.string              "id"         |> UploadId
+            WebLogId  = row.string              "web_log_id" |> WebLogId
+            Path      = row.string              "path"       |> Permalink
+            UpdatedOn = row.fieldValue<Instant> "updated_on"
+            Data      = if includeData then row.bytea "data" else [||]
+        }
+    
+    /// Create a web log from the current row
+    let toWebLog (row : RowReader) : WebLog =
+        {   Id           = row.string       "id"             |> WebLogId
+            Name         = row.string       "name"
+            Slug         = row.string       "slug"
+            Subtitle     = row.stringOrNone "subtitle"
+            DefaultPage  = row.string       "default_page"
+            PostsPerPage = row.int          "posts_per_page"
+            ThemeId      = row.string       "theme_id"       |> ThemeId
+            UrlBase      = row.string       "url_base"
+            TimeZone     = row.string       "time_zone"
+            AutoHtmx     = row.bool         "auto_htmx"
+            Uploads      = row.string       "uploads"        |> UploadDestination.parse
+            Rss          = {
+                IsFeedEnabled     = row.bool         "is_feed_enabled"
+                FeedName          = row.string       "feed_name"
+                ItemsInFeed       = row.intOrNone    "items_in_feed"
+                IsCategoryEnabled = row.bool         "is_category_enabled"
+                IsTagEnabled      = row.bool         "is_tag_enabled"
+                Copyright         = row.stringOrNone "copyright"
+                CustomFeeds       = []
+            }
+        }
+    
+    /// Create a web log user from the current row
+    let toWebLogUser (row : RowReader) : WebLogUser =
+        {   Id            = row.string                    "id"             |> WebLogUserId
+            WebLogId      = row.string                    "web_log_id"     |> WebLogId
+            Email         = row.string                    "email"
+            FirstName     = row.string                    "first_name"
+            LastName      = row.string                    "last_name"
+            PreferredName = row.string                    "preferred_name"
+            PasswordHash  = row.string                    "password_hash"
+            Url           = row.stringOrNone              "url"
+            AccessLevel   = row.string                    "access_level"   |> AccessLevel.parse
+            CreatedOn     = row.fieldValue<Instant>       "created_on"
+            LastSeenOn    = row.fieldValueOrNone<Instant> "last_seen_on"
+        }

src/MyWebLog.Data/Postgres/PostgresPageData.fs

@@ -0,0 +1,281 @@
+namespace MyWebLog.Data.Postgres
+
+open MyWebLog
+open MyWebLog.Data
+open Newtonsoft.Json
+open Npgsql
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog page data implementation        
+type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
+    
+    // SUPPORT FUNCTIONS
+    
+    /// Append revisions and permalinks to a page
+    let appendPageRevisions (page : Page) = backgroundTask {
+        let! revisions =
+            Sql.existingConnection conn
+            |> Sql.query "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
+            |> Sql.parameters [ "@pageId", Sql.string (PageId.toString page.Id) ]
+            |> Sql.executeAsync Map.toRevision
+        return { page with Revisions = revisions }
+    }
+    
+    /// Shorthand to map to a page
+    let toPage = Map.toPage ser
+    
+    /// Return a page with no text or revisions
+    let pageWithoutText row =
+        { toPage row with Text = "" }
+    
+    /// The INSERT statement for a page revision
+    let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
+    
+    /// Parameters for a revision INSERT statement
+    let revParams pageId rev = [
+        typedParam "asOf" rev.AsOf
+        "@pageId", Sql.string (PageId.toString pageId)
+        "@text",   Sql.string (MarkupText.toString rev.Text)
+    ]
+    
+    /// Update a page's revisions
+    let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
+        let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
+        if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.executeTransactionAsync [
+                    if not (List.isEmpty toDelete) then
+                        "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf",
+                        toDelete
+                        |> List.map (fun it -> [
+                            "@pageId", Sql.string (PageId.toString pageId)
+                            typedParam "asOf" it.AsOf
+                        ])
+                    if not (List.isEmpty toAdd) then
+                        revInsert, toAdd |> List.map (revParams pageId)
+                ]
+            ()
+    }
+    
+    /// Does the given page exist?
+    let pageExists pageId webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT EXISTS (SELECT 1 FROM page WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
+        |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toExists
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
+    let all webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeAsync pageWithoutText
+    
+    /// Count all pages for the given web log
+    let countAll webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT COUNT(id) AS {countName} FROM page WHERE web_log_id = @webLogId"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toCount
+    
+    /// Count all pages shown in the page list for the given web log
+    let countListed webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"
+            SELECT COUNT(id) AS {countName}
+              FROM page
+             WHERE web_log_id      = @webLogId
+               AND is_in_page_list = TRUE"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toCount
+    
+    /// Find a page by its ID (without revisions)
+    let findById pageId webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM page WHERE id = @id AND web_log_id = @webLogId"
+        |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId); webLogIdParam webLogId ]
+        |> Sql.executeAsync toPage
+        |> tryHead
+    
+    /// Find a complete page by its ID
+    let findFullById pageId webLogId = backgroundTask {
+        match! findById pageId webLogId with
+        | Some page ->
+            let! withMore = appendPageRevisions page
+            return Some withMore
+        | None -> return None
+    }
+    
+    /// Delete a page by its ID
+    let delete pageId webLogId = backgroundTask {
+        match! pageExists pageId webLogId with
+        | true ->
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.query
+                    "DELETE FROM page_revision WHERE page_id = @id;
+                     DELETE FROM page          WHERE id      = @id"
+                |> Sql.parameters [ "@id", Sql.string (PageId.toString pageId) ]
+                |> Sql.executeNonQueryAsync
+            return true
+        | false -> return false
+    }
+    
+    /// Find a page by its permalink for the given web log
+    let findByPermalink permalink webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
+        |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
+        |> Sql.executeAsync toPage
+        |> tryHead
+    
+    /// Find the current permalink within a set of potential prior permalinks for the given web log
+    let findCurrentPermalink permalinks webLogId = backgroundTask {
+        if List.isEmpty permalinks then return None
+        else
+            let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
+            return!
+                Sql.existingConnection conn
+                |> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})"
+                |> Sql.parameters (webLogIdParam webLogId :: linkParams)
+                |> Sql.executeAsync Map.toPermalink
+                |> tryHead
+    }
+    
+    /// Get all complete pages for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        let! pages =
+            Sql.existingConnection conn
+            |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId"
+            |> Sql.parameters [ webLogIdParam webLogId ]
+            |> Sql.executeAsync toPage
+        let! revisions =
+            Sql.existingConnection conn
+            |> Sql.query
+                "SELECT *
+                   FROM page_revision pr
+                        INNER JOIN page p ON p.id = pr.page_id
+                  WHERE p.web_log_id = @webLogId
+                  ORDER BY pr.as_of DESC"
+            |> Sql.parameters [ webLogIdParam webLogId ]
+            |> Sql.executeAsync (fun row -> PageId (row.string "page_id"), Map.toRevision row)
+        return
+            pages
+            |> List.map (fun it ->
+                { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
+    }
+    
+    /// Get all listed pages for the given web log (without revisions or text)
+    let findListed webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeAsync pageWithoutText
+    
+    /// Get a page of pages for the given web log (without revisions)
+    let findPageOfPages webLogId pageNbr =
+        Sql.existingConnection conn
+        |> Sql.query
+            "SELECT *
+               FROM page
+              WHERE web_log_id = @webLogId
+              ORDER BY LOWER(title)
+              LIMIT @pageSize OFFSET @toSkip"
+        |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
+        |> Sql.executeAsync toPage
+    
+    /// The INSERT statement for a page
+    let pageInsert =
+        "INSERT INTO page (
+            id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
+            template, page_text, meta_items
+        ) VALUES (
+            @id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
+            @template, @text, @metaItems
+        )"
+    
+    /// The parameters for saving a page
+    let pageParams (page : Page) = [
+        webLogIdParam page.WebLogId
+        "@id",              Sql.string       (PageId.toString page.Id)
+        "@authorId",        Sql.string       (WebLogUserId.toString page.AuthorId)
+        "@title",           Sql.string       page.Title
+        "@permalink",       Sql.string       (Permalink.toString page.Permalink)
+        "@isInPageList",    Sql.bool         page.IsInPageList
+        "@template",        Sql.stringOrNone page.Template
+        "@text",            Sql.string       page.Text
+        "@metaItems",       Sql.jsonb        (Utils.serialize ser page.Metadata)
+        "@priorPermalinks", Sql.stringArray  (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
+        typedParam "publishedOn" page.PublishedOn
+        typedParam "updatedOn"   page.UpdatedOn
+    ]
+
+    /// Restore pages from a backup
+    let restore (pages : Page list) = backgroundTask {
+        let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.executeTransactionAsync [
+                pageInsert, pages     |> List.map pageParams
+                revInsert,  revisions |> List.map (fun (pageId, rev) -> revParams pageId rev)
+            ]
+        ()
+    }
+    
+    /// Save a page
+    let save (page : Page) = backgroundTask {
+        let! oldPage = findFullById page.Id page.WebLogId
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.query $"
+                {pageInsert} ON CONFLICT (id) DO UPDATE
+                SET author_id        = EXCLUDED.author_id,
+                    title            = EXCLUDED.title,
+                    permalink        = EXCLUDED.permalink,
+                    prior_permalinks = EXCLUDED.prior_permalinks,
+                    published_on     = EXCLUDED.published_on,
+                    updated_on       = EXCLUDED.updated_on,
+                    is_in_page_list  = EXCLUDED.is_in_page_list,
+                    template         = EXCLUDED.template,
+                    page_text        = EXCLUDED.page_text,
+                    meta_items       = EXCLUDED.meta_items"
+            |> Sql.parameters (pageParams page)
+            |> Sql.executeNonQueryAsync
+        do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
+        ()
+    }
+    
+    /// Update a page's prior permalinks
+    let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
+        match! pageExists pageId webLogId with
+        | true ->
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.query "UPDATE page SET prior_permalinks = @prior WHERE id = @id"
+                |> Sql.parameters
+                    [   "@id",    Sql.string      (PageId.toString pageId)
+                        "@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
+                |> Sql.executeNonQueryAsync
+            return true
+        | false -> return false
+    }
+    
+    interface IPageData with
+        member _.Add page = save page
+        member _.All webLogId = all webLogId
+        member _.CountAll webLogId = countAll webLogId
+        member _.CountListed webLogId = countListed webLogId
+        member _.Delete pageId webLogId = delete pageId webLogId
+        member _.FindById pageId webLogId = findById pageId webLogId
+        member _.FindByPermalink permalink webLogId = findByPermalink permalink webLogId
+        member _.FindCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
+        member _.FindFullById pageId webLogId = findFullById pageId webLogId
+        member _.FindFullByWebLog webLogId = findFullByWebLog webLogId
+        member _.FindListed webLogId = findListed webLogId
+        member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
+        member _.Restore pages = restore pages
+        member _.Update page = save page
+        member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

src/MyWebLog.Data/Postgres/PostgresPostData.fs

@@ -0,0 +1,378 @@
+namespace MyWebLog.Data.Postgres
+
+open MyWebLog
+open MyWebLog.Data
+open Newtonsoft.Json
+open NodaTime
+open Npgsql
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog post data implementation        
+type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
+
+    // SUPPORT FUNCTIONS
+    
+    /// Append revisions to a post
+    let appendPostRevisions (post : Post) = backgroundTask {
+        let! revisions =
+            Sql.existingConnection conn
+            |> Sql.query "SELECT as_of, revision_text FROM post_revision WHERE post_id = @id ORDER BY as_of DESC"
+            |> Sql.parameters [ "@id", Sql.string (PostId.toString post.Id) ]
+            |> Sql.executeAsync Map.toRevision
+        return { post with Revisions = revisions }
+    }
+    
+    /// The SELECT statement for a post that will include category IDs
+    let selectPost =
+        "SELECT *, ARRAY(SELECT cat.category_id FROM post_category cat WHERE cat.post_id = p.id) AS category_ids
+           FROM post p"
+    
+    /// Shorthand for mapping to a post
+    let toPost = Map.toPost ser
+    
+    /// Return a post with no revisions, prior permalinks, or text
+    let postWithoutText row =
+        { toPost row with Text = "" }
+    
+    /// The INSERT statement for a post/category cross-reference
+    let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
+    
+    /// Parameters for adding or updating a post/category cross-reference
+    let catParams postId cat = [
+        "@postId",    Sql.string (PostId.toString postId)
+        "categoryId", Sql.string (CategoryId.toString cat)
+    ]
+    
+    /// Update a post's assigned categories
+    let updatePostCategories postId oldCats newCats = backgroundTask {
+        let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
+        if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.executeTransactionAsync [
+                    if not (List.isEmpty toDelete) then
+                        "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
+                        toDelete |> List.map (catParams postId)
+                    if not (List.isEmpty toAdd) then
+                        catInsert, toAdd |> List.map (catParams postId)
+                ]
+            ()
+    }
+    
+    /// The INSERT statement for a post revision
+    let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
+    
+    /// The parameters for adding a post revision
+    let revParams postId rev = [
+        typedParam "asOf" rev.AsOf
+        "@postId", Sql.string (PostId.toString postId)
+        "@text",   Sql.string (MarkupText.toString rev.Text)
+    ]
+    
+    /// Update a post's revisions
+    let updatePostRevisions postId oldRevs newRevs = backgroundTask {
+        let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
+        if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.executeTransactionAsync [
+                    if not (List.isEmpty toDelete) then
+                        "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf",
+                        toDelete
+                        |> List.map (fun it -> [
+                            "@postId", Sql.string (PostId.toString postId)
+                            typedParam "asOf" it.AsOf
+                        ])
+                    if not (List.isEmpty toAdd) then
+                        revInsert, toAdd |> List.map (revParams postId)
+                ]
+            ()
+    }
+    
+    /// Does the given post exist?
+    let postExists postId webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT EXISTS (SELECT 1 FROM post WHERE id = @id AND web_log_id = @webLogId) AS {existsName}"
+        |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
+        |> Sql.executeRowAsync Map.toExists
+    
+    // IMPLEMENTATION FUNCTIONS
+    
+    /// Count posts in a status for the given web log
+    let countByStatus status webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status"
+        |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ]
+        |> Sql.executeRowAsync Map.toCount
+    
+    /// Find a post by its ID for the given web log (excluding revisions)
+    let findById postId webLogId = 
+        Sql.existingConnection conn
+        |> Sql.query $"{selectPost} WHERE id = @id AND web_log_id = @webLogId"
+        |> Sql.parameters [ "@id", Sql.string (PostId.toString postId); webLogIdParam webLogId ]
+        |> Sql.executeAsync toPost
+        |> tryHead
+    
+    /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
+    let findByPermalink permalink webLogId =
+        Sql.existingConnection conn
+        |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link"
+        |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
+        |> Sql.executeAsync toPost
+        |> tryHead
+    
+    /// Find a complete post by its ID for the given web log
+    let findFullById postId webLogId = backgroundTask {
+        match! findById postId webLogId with
+        | Some post ->
+            let! withRevisions = appendPostRevisions post
+            return Some withRevisions
+        | None -> return None
+    }
+    
+    /// Delete a post by its ID for the given web log
+    let delete postId webLogId = backgroundTask {
+        match! postExists postId webLogId with
+        | true ->
+            let! _ =
+                Sql.existingConnection conn
+                |> Sql.query
+                    "DELETE FROM post_revision WHERE post_id = @id;
+                     DELETE FROM post_category WHERE post_id = @id;
+                     DELETE FROM post          WHERE id      = @id"
+                |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
+                |> Sql.executeNonQueryAsync
+            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 {
+        if List.isEmpty permalinks then return None
+        else
+            let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks
+            return!
+                Sql.existingConnection conn
+                |> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})"
+                |> Sql.parameters (webLogIdParam webLogId :: linkParams)
+                |> Sql.executeAsync Map.toPermalink
+                |> tryHead
+    }
+    
+    /// Get all complete posts for the given web log
+    let findFullByWebLog webLogId = backgroundTask {
+        let! posts =
+            Sql.existingConnection conn
+            |> Sql.query $"{selectPost} WHERE web_log_id = @webLogId"
+            |> Sql.parameters [ webLogIdParam webLogId ]
+            |> Sql.executeAsync toPost
+        let! revisions =
+            Sql.existingConnection conn
+            |> Sql.query
+                "SELECT *
+                   FROM post_revision pr
+                        INNER JOIN post p ON p.id = pr.post_id
+                  WHERE p.web_log_id = @webLogId
+                  ORDER BY as_of DESC"
+            |> Sql.parameters [ webLogIdParam webLogId ]
+            |> Sql.executeAsync (fun row -> PostId (row.string "post_id"), Map.toRevision row)
+        return
+            posts
+            |> List.map (fun it ->
+                { it with Revisions = revisions |> List.filter (fun r -> fst r = it.Id) |> List.map snd })
+    }
+    
+    /// Get a page of categorized posts for the given web log (excludes revisions)
+    let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
+        let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
+        Sql.existingConnection conn
+        |> Sql.query $"
+            {selectPost}
+                   INNER JOIN post_category pc ON pc.post_id = p.id
+             WHERE p.web_log_id = @webLogId
+               AND p.status     = @status
+               {catSql}
+             ORDER BY published_on DESC
+             LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
+        |> Sql.parameters
+            [   webLogIdParam w