bit-badger/myWebLog
1
0
Fork 0
Code Issues 3 Pull Requests Packages Projects Releases 11 Activity

First cut at Postgres JSON implementation

Browse Source
This commit is contained in:
Daniel J. Summers 2022-09-02 22:29:32 -04:00
parent 5f3daa1de9
commit 52e279529a
11 changed files with 588 additions and 1112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -2,33 +2,30 @@
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog category data implementation /// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (conn : NpgsqlConnection) = type PostgresCategoryData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Convert a data row to a category
let toCategory = Map.fromDoc<Category> ser
/// Count all categories for the given web log /// Count all categories for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn Document.countByWebLog conn Table.Category webLogId None
|> 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 /// Count all top-level categories for the given web log
let countTopLevel webLogId = let countTopLevel webLogId =
Sql.existingConnection conn Document.countByWebLog conn Table.Category webLogId
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL" (Some $"AND data -> '{nameof Category.empty.ParentId}' IS NULL")
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeRowAsync Map.toCount
/// Retrieve all categories for the given web log in a DotLiquid-friendly format /// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask { let findAllForView webLogId = backgroundTask {
let! cats = let! cats =
Sql.existingConnection conn Document.findByWebLog conn Table.Category webLogId toCategory
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId ORDER BY LOWER(name)" (Some $"ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')")
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
let ordered = Utils.orderByHierarchy cats None None [] let ordered = Utils.orderByHierarchy cats None None []
let counts = let counts =
ordered ordered
@ -40,16 +37,15 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
|> Seq.map (fun cat -> cat.Id) |> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> List.ofSeq
|> inClause "AND pc.category_id" "id" id |> jsonArrayInClause (nameof Post.empty.CategoryIds) id
let postCount = let postCount =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
SELECT COUNT(DISTINCT p.id) AS {countName} SELECT COUNT(DISTINCT id) AS {countName}
FROM post p FROM {Table.Post}
INNER JOIN post_category pc ON pc.post_id = p.id WHERE {webLogWhere}
WHERE p.web_log_id = @webLogId AND data ->> '{nameof Post.empty.Status}' = '{PostStatus.toString Published}'
AND p.status = 'Published' AND ({catIdSql})"
{catIdSql}"
|> Sql.parameters (webLogIdParam webLogId :: catIdParams) |> Sql.parameters (webLogIdParam webLogId :: catIdParams)
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
@ -69,19 +65,17 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
} }
/// Find a category by its ID for the given web log /// Find a category by its ID for the given web log
let findById catId webLogId = let findById catId webLogId =
Sql.existingConnection conn Document.findByIdAndWebLog conn Table.Category catId CategoryId.toString webLogId toCategory
|> 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 /// Find all categories for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn Document.findByWebLog conn Table.Category webLogId toCategory None
|> Sql.query "SELECT * FROM category WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toCategory
/// Create parameters for a category insert / update
let catParameters (cat : Category) = [
"@id", Sql.string (CategoryId.toString cat.Id)
"@data", Sql.jsonb (Utils.serialize ser cat)
]
/// Delete a category /// Delete a category
let delete catId webLogId = backgroundTask { let delete catId webLogId = backgroundTask {
@ -89,65 +83,50 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
| Some cat -> | Some cat ->
// Reassign any children to the category's parent category // Reassign any children to the category's parent category
let parentParam = "@parentId", Sql.string (CategoryId.toString catId) let parentParam = "@parentId", Sql.string (CategoryId.toString catId)
let! hasChildren = let! children =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM category WHERE parent_id = @parentId) AS {existsName}" |> Sql.query
$"SELECT * FROM {Table.Category} WHERE data ->> '{nameof Category.empty.ParentId}' = @parentId"
|> Sql.parameters [ parentParam ] |> Sql.parameters [ parentParam ]
|> Sql.executeRowAsync Map.toExists |> Sql.executeAsync toCategory
let hasChildren = not (List.isEmpty children)
if hasChildren then if hasChildren then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "UPDATE category SET parent_id = @newParentId WHERE parent_id = @parentId" |> Sql.executeTransactionAsync [
|> Sql.parameters docUpdateSql Table.Category,
[ parentParam children |> List.map (fun child -> catParameters { child with ParentId = cat.ParentId })
"@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 // Delete the category off all posts where it is assigned
let! posts =
Sql.existingConnection conn
|> Sql.query $"SELECT * FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' ? @id"
|> Sql.parameters [ "@id", Sql.jsonb (CategoryId.toString catId) ]
|> Sql.executeAsync (Map.fromDoc<Post> ser)
if not (List.isEmpty posts) then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query |> Sql.executeTransactionAsync [
"DELETE FROM post_category docUpdateSql Table.Post,
WHERE category_id = @id posts |> List.map (fun post -> [
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId); "@id", Sql.string (PostId.toString post.Id)
DELETE FROM category WHERE id = @id" "@data", Sql.jsonb (Utils.serialize ser {
|> Sql.parameters [ "@id", Sql.string (CategoryId.toString catId); webLogIdParam webLogId ] post with
|> Sql.executeNonQueryAsync CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId)
})
])
]
()
// Delete the category itself
do! Document.delete conn Table.Category (CategoryId.toString catId)
return if hasChildren then ReassignedChildCategories else CategoryDeleted return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound | 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 /// Save a category
let save cat = backgroundTask { let save cat = backgroundTask {
let! _ = do! Document.upsert conn Table.Category catParameters cat
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 /// Restore categories from a backup
@ -155,7 +134,7 @@ type PostgresCategoryData (conn : NpgsqlConnection) =
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
catInsert, cats |> List.map catParameters docInsertSql Table.Category, cats |> List.map catParameters
] ]
() ()
} }

378
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -2,15 +2,74 @@
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers module MyWebLog.Data.Postgres.PostgresHelpers
/// The table names used in the PostgreSQL implementation
[<RequireQualifiedAccess>]
module Table =
/// Categories
[<Literal>]
let Category = "category"
/// Database Version
[<Literal>]
let DbVersion = "db_version"
/// Pages
[<Literal>]
let Page = "page"
/// Page Revisions
[<Literal>]
let PageRevision = "page_revision"
/// Posts
[<Literal>]
let Post = "post"
/// Post Comments
[<Literal>]
let PostComment = "post_comment"
/// Post Revisions
[<Literal>]
let PostRevision = "post_revision"
/// Tag/URL Mappings
[<Literal>]
let TagMap = "tag_map"
/// Themes
[<Literal>]
let Theme = "theme"
/// Theme Assets
[<Literal>]
let ThemeAsset = "theme_asset"
/// Uploads
[<Literal>]
let Upload = "upload"
/// Web Logs
[<Literal>]
let WebLog = "web_log"
/// Users
[<Literal>]
let WebLogUser = "web_log_user"
open System open System
open System.Threading.Tasks open System.Threading.Tasks
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open NodaTime open NodaTime
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// Create a WHERE clause fragment for the web log ID
let webLogWhere = "data ->> 'WebLogId' = @webLogId"
/// Create a SQL parameter for the web log ID /// Create a SQL parameter for the web log ID
let webLogIdParam webLogId = let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId) "@webLogId", Sql.string (WebLogId.toString webLogId)
@ -37,8 +96,8 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> Seq.head) |> Seq.head)
|> function sql, ps -> $"{sql})", ps |> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for the array equivalent of an IN clause /// Create the SQL and parameters for the array-in-JSON equivalent of an IN clause
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) = let jsonArrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
if List.isEmpty items then "TRUE = FALSE", [] if List.isEmpty items then "TRUE = FALSE", []
else else
let mutable idx = 0 let mutable idx = 0
@ -46,11 +105,11 @@ let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
|> List.skip 1 |> List.skip 1
|> List.fold (fun (itemS, itemP) it -> |> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1 idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]", $"{itemS} OR data -> '%s{name}' ? @{name}{idx}",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP) ($"@{name}{idx}", Sql.jsonb (valueFunc it)) :: itemP)
(Seq.ofList items (Seq.ofList items
|> Seq.map (fun it -> |> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ]) $"data -> '{name}' ? @{name}0", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head) |> Seq.head)
/// Get the first result of the given query /// Get the first result of the given query
@ -68,116 +127,63 @@ 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 p.ParameterName, Sql.parameter p
/// SQL statement to insert into a document table
let docInsertSql table =
$"INSERT INTO %s{table} VALUES (@id, @data)"
/// SQL statement to select a document by its ID
let docSelectSql table =
$"SELECT * FROM %s{table} WHERE id = @id"
/// SQL statement to select documents by their web log IDs
let docSelectForWebLogSql table =
$"SELECT * FROM %s{table} WHERE {webLogWhere}"
/// SQL statement to update a document in a document table
let docUpdateSql table =
$"UPDATE %s{table} SET data = @data WHERE id = @id"
/// SQL statement to insert or update a document in a document table
let docUpsertSql table =
$"{docInsertSql table} ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data"
/// SQL statement to delete a document from a document table by its ID
let docDeleteSql table =
$"DELETE FROM %s{table} WHERE id = @id"
/// SQL statement to count documents for a web log
let docCountForWebLogSql table =
$"SELECT COUNT(id) AS {countName} FROM %s{table} WHERE {webLogWhere}"
/// SQL statement to determine if a document exists for a web log
let docExistsForWebLogSql table =
$"SELECT EXISTS (SELECT 1 FROM %s{table} WHERE id = @id AND {webLogWhere}) AS {existsName}"
/// Mapping functions for SQL queries /// Mapping functions for SQL queries
module Map = module Map =
/// Map an id field to a category ID /// Map an item by deserializing the document
let toCategoryId (row : RowReader) = let fromDoc<'T> ser (row : RowReader) =
CategoryId (row.string "id") Utils.deserialize<'T> ser (row.string "data")
/// 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 /// Get a count from a row
let toCount (row : RowReader) = let toCount (row : RowReader) =
row.int countName 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 /// Get a true/false value as to whether an item exists
let toExists (row : RowReader) = let toExists (row : RowReader) =
row.bool existsName 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 /// Create a permalink from the current row
let toPermalink (row : RowReader) = let toPermalink (row : RowReader) =
Permalink (row.string "permalink") 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 /// Create a revision from the current row
let toRevision (row : RowReader) : Revision = let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of" { AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse 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 /// 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") { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
@ -185,12 +191,6 @@ module Map =
Data = if includeData then row.bytea "data" else [||] 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 /// 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 { Id = row.string "id" |> UploadId
@ -200,41 +200,149 @@ module Map =
Data = if includeData then row.bytea "data" else [||] Data = if includeData then row.bytea "data" else [||]
} }
/// Create a web log from the current row /// Document manipulation functions
let toWebLog (row : RowReader) : WebLog = module Document =
{ Id = row.string "id" |> WebLogId
Name = row.string "name" /// Convert extra SQL to a for that can be appended to a query
Slug = row.string "slug" let private moreSql sql = sql |> Option.map (fun it -> $" %s{it}") |> Option.defaultValue ""
Subtitle = row.stringOrNone "subtitle"
DefaultPage = row.string "default_page" /// Count documents for a web log
PostsPerPage = row.int "posts_per_page" let countByWebLog conn table webLogId extraSql =
ThemeId = row.string "theme_id" |> ThemeId Sql.existingConnection conn
UrlBase = row.string "url_base" |> Sql.query $"{docCountForWebLogSql table}{moreSql extraSql}"
TimeZone = row.string "time_zone" |> Sql.parameters [ webLogIdParam webLogId ]
AutoHtmx = row.bool "auto_htmx" |> Sql.executeRowAsync Map.toCount
Uploads = row.string "uploads" |> UploadDestination.parse
Rss = { /// Delete a document
IsFeedEnabled = row.bool "is_feed_enabled" let delete conn table idParam = backgroundTask {
FeedName = row.string "feed_name" let! _ =
ItemsInFeed = row.intOrNone "items_in_feed" Sql.existingConnection conn
IsCategoryEnabled = row.bool "is_category_enabled" |> Sql.query (docDeleteSql table)
IsTagEnabled = row.bool "is_tag_enabled" |> Sql.parameters [ "@id", Sql.string idParam ]
Copyright = row.stringOrNone "copyright" |> Sql.executeNonQueryAsync
CustomFeeds = [] ()
}
} }
/// Create a web log user from the current row /// Determine if a document with the given ID exists
let toWebLogUser (row : RowReader) : WebLogUser = let exists<'TKey> conn table (key : 'TKey) (keyFunc : 'TKey -> string) =
{ Id = row.string "id" |> WebLogUserId Sql.existingConnection conn
WebLogId = row.string "web_log_id" |> WebLogId |> Sql.query $"SELECT EXISTS (SELECT 1 FROM %s{table} WHERE id = @id) AS {existsName}"
Email = row.string "email" |> Sql.parameters [ "@id", Sql.string (keyFunc key) ]
FirstName = row.string "first_name" |> Sql.executeRowAsync Map.toExists
LastName = row.string "last_name"
PreferredName = row.string "preferred_name" /// Determine whether a document exists with the given key for the given web log
PasswordHash = row.string "password_hash" let existsByWebLog<'TKey> conn table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Url = row.stringOrNone "url" Sql.existingConnection conn
AccessLevel = row.string "access_level" |> AccessLevel.parse |> Sql.query (docExistsForWebLogSql table)
CreatedOn = row.fieldValue<Instant> "created_on" |> Sql.parameters [ "@id", Sql.string (keyFunc key); webLogIdParam webLogId ]
LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on" |> Sql.executeRowAsync Map.toExists
/// Find a document by its ID
let findById<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) (docFunc : RowReader -> 'TDoc) =
Sql.existingConnection conn
|> Sql.query (docSelectSql table)
|> Sql.parameters [ "@id", Sql.string (keyFunc key) ]
|> Sql.executeAsync docFunc
|> tryHead
/// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> conn table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId
(docFunc : RowReader -> 'TDoc) =
Sql.existingConnection conn
|> Sql.query $"{docSelectSql table} AND {webLogWhere}"
|> Sql.parameters [ "@id", Sql.string (keyFunc key); webLogIdParam webLogId ]
|> Sql.executeAsync docFunc
|> tryHead
/// Find all documents for the given web log
let findByWebLog<'TDoc> conn table webLogId (docFunc : RowReader -> 'TDoc) extraSql =
Sql.existingConnection conn
|> Sql.query $"{docSelectForWebLogSql table}{moreSql extraSql}"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync docFunc
/// Insert a new document
let insert<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task {
let! _ =
Sql.existingConnection conn
|> Sql.query (docInsertSql table)
|> Sql.parameters (paramFunc doc)
|> Sql.executeNonQueryAsync
()
} }
/// Update an existing document
let update<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task {
let! _ =
Sql.existingConnection conn
|> Sql.query (docUpdateSql table)
|> Sql.parameters (paramFunc doc)
|> Sql.executeNonQueryAsync
()
}
/// Insert or update a document
let upsert<'T> conn table (paramFunc : 'T -> (string * SqlValue) list) (doc : 'T) = task {
let! _ =
Sql.existingConnection conn
|> Sql.query (docUpsertSql table)
|> Sql.parameters (paramFunc doc)
|> Sql.executeNonQueryAsync
()
}
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> conn revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Sql.existingConnection conn
|> Sql.query $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
|> Sql.parameters [ "@id", Sql.string (keyFunc key) ]
|> Sql.executeAsync Map.toRevision
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> conn revTable entityTable (keyFunc : string -> 'TKey) webLogId =
Sql.existingConnection conn
|> Sql.query $"
SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
WHERE p.{webLogWhere}
ORDER BY as_of DESC"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (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 = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// The SQL statement to insert a revision
let insertSql table =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions
let update<'TKey>
conn revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) 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 %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@id", Sql.string (keyFunc key)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
()
}

180
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -11,94 +11,45 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// Append revisions and permalinks to a page /// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask { let appendPageRevisions (page : Page) = backgroundTask {
let! revisions = let! revisions = Revisions.findByEntityId conn Table.PageRevision Table.Page page.Id PageId.toString
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 } return { page with Revisions = revisions }
} }
/// Shorthand to map to a page /// Shorthand to map to a page
let toPage = Map.toPage ser let toPage = Map.fromDoc<Page> ser
/// Return a page with no text or revisions /// Return a page with no text or revisions
let pageWithoutText row = let pageWithoutText row =
{ toPage row with Text = "" } { 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 /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask { let updatePageRevisions pageId oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs Revisions.update conn Table.PageRevision Table.Page pageId PageId.toString 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? /// Does the given page exist?
let pageExists pageId webLogId = let pageExists pageId webLogId =
Sql.existingConnection conn Document.existsByWebLog conn Table.Page pageId PageId.toString webLogId
|> 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 // IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata) /// Get all pages for a web log (without text or revisions)
let all webLogId = let all webLogId =
Sql.existingConnection conn Document.findByWebLog conn Table.Page webLogId pageWithoutText
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)" (Some $"ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')")
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync pageWithoutText
/// Count all pages for the given web log /// Count all pages for the given web log
let countAll webLogId = let countAll webLogId =
Sql.existingConnection conn Document.countByWebLog conn Table.Page webLogId None
|> 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 /// Count all pages shown in the page list for the given web log
let countListed webLogId = let countListed webLogId =
Sql.existingConnection conn Document.countByWebLog conn Table.Page webLogId (Some $"AND data -> '{nameof Page.empty.IsInPageList}' = TRUE")
|> 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) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById pageId webLogId =
Sql.existingConnection conn Document.findByIdAndWebLog conn Table.Page pageId PageId.toString webLogId toPage
|> 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 /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
@ -113,13 +64,7 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
let delete pageId webLogId = backgroundTask { let delete pageId webLogId = backgroundTask {
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
let! _ = do! Document.delete conn Table.Page (PageId.toString pageId)
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 return true
| false -> return false | false -> return false
} }
@ -127,7 +72,7 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" |> Sql.query $"{docSelectForWebLogSql Table.Page} AND data ->> '{nameof Page.empty.Permalink}' = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPage |> Sql.executeAsync toPage
|> tryHead |> tryHead
@ -136,10 +81,15 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks let linkSql, linkParams =
jsonArrayInClause (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM page WHERE web_log_id = @webLogId AND ({linkSql})" |> Sql.query $"
SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
FROM page
WHERE {webLogWhere}
AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
|> tryHead |> tryHead
@ -147,21 +97,8 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get all complete pages for the given web log /// Get all complete pages for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! pages = let! pages = Document.findByWebLog conn Table.Page webLogId toPage None
Sql.existingConnection conn let! revisions = Revisions.findByWebLog conn Table.PageRevision Table.Page PageId webLogId
|> 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 return
pages pages
|> List.map (fun it -> |> List.map (fun it ->
@ -171,46 +108,27 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get all listed pages for the given web log (without revisions or text) /// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId = let findListed webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM page WHERE web_log_id = @webLogId AND is_in_page_list = TRUE ORDER BY LOWER(title)" |> Sql.query $"
{docSelectForWebLogSql Table.Page}
AND data -> '{nameof Page.empty.IsInPageList}' = TRUE
ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync pageWithoutText |> Sql.executeAsync pageWithoutText
/// Get a page of pages for the given web log (without revisions) /// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr = let findPageOfPages webLogId pageNbr =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query |> Sql.query $"
"SELECT * {docSelectForWebLogSql Table.Page}
FROM page ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip" LIMIT @pageSize OFFSET @toSkip"
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ] |> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync toPage |> 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 /// The parameters for saving a page
let pageParams (page : Page) = [ let pageParams (page : Page) = [
webLogIdParam page.WebLogId
"@id", Sql.string (PageId.toString page.Id) "@id", Sql.string (PageId.toString page.Id)
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId) "@data", Sql.jsonb (Utils.serialize ser page)
"@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 /// Restore pages from a backup
@ -219,8 +137,9 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
pageInsert, pages |> List.map pageParams docInsertSql Table.Page, pages |> List.map pageParams
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev) Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev)
] ]
() ()
} }
@ -228,39 +147,18 @@ type PostgresPageData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Save a page /// Save a page
let save (page : Page) = backgroundTask { let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId let! oldPage = findFullById page.Id page.WebLogId
let! _ = do! Document.upsert conn Table.Page pageParams page
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 do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
() ()
} }
/// Update a page's prior permalinks /// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask { let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! pageExists pageId webLogId with match! findById pageId webLogId with
| true -> | Some page ->
let! _ = do! Document.update conn Table.Page pageParams { page with PriorPermalinks = permalinks }
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 return true
| false -> return false | None -> return false
} }
interface IPageData with interface IPageData with

236
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -14,109 +14,46 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Append revisions to a post /// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask { let appendPostRevisions (post : Post) = backgroundTask {
let! revisions = let! revisions = Revisions.findByEntityId conn Table.PostRevision Table.Post post.Id PostId.toString
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 } 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 /// Shorthand for mapping to a post
let toPost = Map.toPost ser let toPost = Map.fromDoc<Post> ser
/// Return a post with no revisions, prior permalinks, or text /// Return a post with no revisions, prior permalinks, or text
let postWithoutText row = let postWithoutText row =
{ toPost row with Text = "" } { 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 /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask { let updatePostRevisions postId oldRevs newRevs =
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs Revisions.update conn Table.PostRevision Table.Post postId PostId.toString 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? /// Does the given post exist?
let postExists postId webLogId = let postExists postId webLogId =
Sql.existingConnection conn Document.existsByWebLog conn Table.Post postId PostId.toString webLogId
|> 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 ] /// Query to select posts by web log ID and status
|> Sql.executeRowAsync Map.toExists let postsByWebLogAndStatus =
$"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status"
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus status webLogId = let countByStatus status webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT COUNT(id) AS {countName} FROM post WHERE web_log_id = @webLogId AND status = @status" |> Sql.query $"{docCountForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Status}' = @status"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ] |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString status) ]
|> Sql.executeRowAsync Map.toCount |> Sql.executeRowAsync Map.toCount
/// Find a post by its ID for the given web log (excluding revisions) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = let findById postId webLogId =
Sql.existingConnection conn Document.findByIdAndWebLog conn Table.Post postId PostId.toString webLogId toPost
|> 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) /// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = let findByPermalink permalink webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"{selectPost} WHERE web_log_id = @webLogId AND permalink = @link" |> Sql.query $"{docSelectForWebLogSql Table.Post} AND data ->> '{nameof Post.empty.Permalink}' = @link"
|> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ] |> Sql.parameters [ webLogIdParam webLogId; "@link", Sql.string (Permalink.toString permalink) ]
|> Sql.executeAsync toPost |> Sql.executeAsync toPost
|> tryHead |> tryHead
@ -136,10 +73,9 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
| true -> | true ->
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query |> Sql.query $"
"DELETE FROM post_revision WHERE post_id = @id; DELETE FROM {Table.PostComment} WHERE data ->> '{nameof Comment.empty.PostId}' = @id;
DELETE FROM post_category WHERE post_id = @id; DELETE FROM {Table.Post} WHERE id = @id"
DELETE FROM post WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ] |> Sql.parameters [ "@id", Sql.string (PostId.toString postId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return true return true
@ -150,10 +86,15 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParams = arrayInClause "prior_permalinks" Permalink.toString permalinks let linkSql, linkParams =
jsonArrayInClause (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
return! return!
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT permalink FROM post WHERE web_log_id = @webLogId AND ({linkSql})" |> Sql.query $"
SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
FROM {Table.Post}
WHERE {webLogWhere}
AND ({linkSql})"
|> Sql.parameters (webLogIdParam webLogId :: linkParams) |> Sql.parameters (webLogIdParam webLogId :: linkParams)
|> Sql.executeAsync Map.toPermalink |> Sql.executeAsync Map.toPermalink
|> tryHead |> tryHead
@ -161,21 +102,8 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get all complete posts for the given web log /// Get all complete posts for the given web log
let findFullByWebLog webLogId = backgroundTask { let findFullByWebLog webLogId = backgroundTask {
let! posts = let! posts = Document.findByWebLog conn Table.Post webLogId toPost None
Sql.existingConnection conn let! revisions = Revisions.findByWebLog conn Table.PostRevision Table.Post PostId webLogId
|> 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 return
posts posts
|> List.map (fun it -> |> List.map (fun it ->
@ -184,14 +112,11 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Get a page of categorized posts for the given web log (excludes revisions) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds let catSql, catParams = jsonArrayInClause (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {postsByWebLogAndStatus}
INNER JOIN post_category pc ON pc.post_id = p.id AND ({catSql})
WHERE p.web_log_id = @webLogId
AND p.status = @status
{catSql}
ORDER BY published_on DESC ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters
@ -204,9 +129,9 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let findPageOfPosts webLogId pageNbr postsPerPage = let findPageOfPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {docSelectForWebLogSql Table.Post}
WHERE web_log_id = @webLogId ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST,
ORDER BY published_on DESC NULLS FIRST, updated_on data ->> '{nameof Post.empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync postWithoutText |> Sql.executeAsync postWithoutText
@ -215,10 +140,8 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {postsByWebLogAndStatus}
WHERE web_log_id = @webLogId ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND status = @status
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ] |> Sql.parameters [ webLogIdParam webLogId; "@status", Sql.string (PostStatus.toString Published) ]
|> Sql.executeAsync toPost |> Sql.executeAsync toPost
@ -227,16 +150,14 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {postsByWebLogAndStatus}
WHERE web_log_id = @webLogId AND data -> '{nameof Post.empty.Tags}' ? @tag
AND status = @status ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND tags && ARRAY[@tag]
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|> Sql.parameters |> Sql.parameters
[ webLogIdParam webLogId [ webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published) "@status", Sql.string (PostStatus.toString Published)
"@tag", Sql.string tag "@tag", Sql.jsonb tag
] ]
|> Sql.executeAsync toPost |> Sql.executeAsync toPost
@ -250,110 +171,59 @@ type PostgresPostData (conn : NpgsqlConnection, ser : JsonSerializer) =
let! older = let! older =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {postsByWebLogAndStatus}
WHERE web_log_id = @webLogId AND data ->> '{nameof Post.empty.PublishedOn}' < @publishedOn
AND status = @status ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND published_on < @publishedOn
ORDER BY published_on DESC
LIMIT 1" LIMIT 1"
|> queryParams () |> queryParams ()
|> Sql.executeAsync toPost |> Sql.executeAsync toPost
let! newer = let! newer =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
{selectPost} {postsByWebLogAndStatus}
WHERE web_log_id = @webLogId AND data ->> '{nameof Post.empty.PublishedOn}' > @publishedOn
AND status = @status ORDER BY data ->> '{nameof Post.empty.PublishedOn}'
AND published_on > @publishedOn
ORDER BY published_on
LIMIT 1" LIMIT 1"
|> queryParams () |> queryParams ()
|> Sql.executeAsync toPost |> Sql.executeAsync toPost
return List.tryHead older, List.tryHead newer return List.tryHead older, List.tryHead newer
} }
/// The INSERT statement for a post
let postInsert =
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
template, post_text, tags, meta_items, episode
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
@template, @text, @tags, @metaItems, @episode
)"
/// The parameters for saving a post /// The parameters for saving a post
let postParams (post : Post) = [ let postParams (post : Post) = [
webLogIdParam post.WebLogId
"@id", Sql.string (PostId.toString post.Id) "@id", Sql.string (PostId.toString post.Id)
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId) "@data", Sql.jsonb (Utils.serialize ser post)
"@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map (Utils.serialize ser))
"@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
"@metaItems",
if List.isEmpty post.Metadata then None else Some (Utils.serialize ser post.Metadata)
|> Sql.jsonbOrNone
optParam "publishedOn" post.PublishedOn
typedParam "updatedOn" post.UpdatedOn
] ]
/// Save a post /// Save a post
let save (post : Post) = backgroundTask { let save (post : Post) = backgroundTask {
let! oldPost = findFullById post.Id post.WebLogId let! oldPost = findFullById post.Id post.WebLogId
let! _ = do! Document.upsert conn Table.Post postParams post
Sql.existingConnection conn
|> Sql.query $"
{postInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
status = EXCLUDED.status,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
prior_permalinks = EXCLUDED.prior_permalinks,
published_on = EXCLUDED.published_on,
updated_on = EXCLUDED.updated_on,
template = EXCLUDED.template,
post_text = EXCLUDED.post_text,
tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode"
|> Sql.parameters (postParams post)
|> Sql.executeNonQueryAsync
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
} }
/// Restore posts from a backup /// Restore posts from a backup
let restore posts = backgroundTask { let restore posts = backgroundTask {
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c))
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r)) let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
postInsert, posts |> List.map postParams docInsertSql Table.Post, posts |> List.map postParams
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId) Revisions.insertSql Table.PostRevision,
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev) revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev)
] ]
() ()
} }
/// Update prior permalinks for a post /// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask { let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! postExists postId webLogId with use! txn = conn.BeginTransactionAsync ()
| true -> match! findById postId webLogId with
let! _ = | Some post ->
Sql.existingConnection conn do! Document.update conn Table.Post postParams { post with PriorPermalinks = permalinks }
|> Sql.query "UPDATE post SET prior_permalinks = @prior WHERE id = @id" do! txn.CommitAsync ()
|> Sql.parameters
[ "@id", Sql.string (PostId.toString postId)
"@prior", Sql.stringArray (permalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.executeNonQueryAsync
return true return true
| false -> return false | None -> return false
} }
interface IPostData with interface IPostData with

67
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -2,37 +2,25 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation /// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (conn : NpgsqlConnection) = type PostgresTagMapData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Map a data row to a tag mapping
let toTagMap = Map.fromDoc<TagMap> ser
/// Find a tag mapping by its ID for the given web log /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById tagMapId webLogId =
Sql.existingConnection conn Document.findByIdAndWebLog conn Table.TagMap tagMapId TagMapId.toString webLogId toTagMap
|> Sql.query "SELECT * FROM tag_map WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (TagMapId.toString tagMapId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toTagMap
|> tryHead
/// Delete a tag mapping for the given web log /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
let idParams = [ "@id", Sql.string (TagMapId.toString tagMapId) ] let! exists = Document.existsByWebLog conn Table.TagMap tagMapId TagMapId.toString webLogId
let! exists =
Sql.existingConnection conn
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM tag_map WHERE id = @id AND web_log_id = @webLogId)
AS {existsName}"
|> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeRowAsync Map.toExists
if exists then if exists then
let! _ = do! Document.delete conn Table.TagMap (TagMapId.toString tagMapId)
Sql.existingConnection conn
|> Sql.query "DELETE FROM tag_map WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true return true
else return false else return false
} }
@ -40,53 +28,32 @@ type PostgresTagMapData (conn : NpgsqlConnection) =
/// Find a tag mapping by its URL value for the given web log /// Find a tag mapping by its URL value for the given web log
let findByUrlValue urlValue webLogId = let findByUrlValue urlValue webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue" |> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND data ->> '{nameof TagMap.empty.UrlValue}' = @urlValue"
|> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ] |> Sql.parameters [ webLogIdParam webLogId; "@urlValue", Sql.string urlValue ]
|> Sql.executeAsync Map.toTagMap |> Sql.executeAsync toTagMap
|> tryHead |> tryHead
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn Document.findByWebLog conn Table.TagMap webLogId toTagMap (Some "ORDER BY tag")
|> Sql.query "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toTagMap
/// Find any tag mappings in a list of tags for the given web log /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId = let findMappingForTags tags webLogId =
let tagSql, tagParams = inClause "AND tag" "tag" id tags let tagSql, tagParams = jsonArrayInClause (nameof TagMap.empty.Tag) id tags
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT * FROM tag_map WHERE web_log_id = @webLogId {tagSql}" |> Sql.query $"{docSelectForWebLogSql Table.TagMap} AND ({tagSql})"
|> Sql.parameters (webLogIdParam webLogId :: tagParams) |> Sql.parameters (webLogIdParam webLogId :: tagParams)
|> Sql.executeAsync Map.toTagMap |> Sql.executeAsync toTagMap
/// The INSERT statement for a tag mapping
let tagMapInsert =
"INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"
/// The parameters for saving a tag mapping /// The parameters for saving a tag mapping
let tagMapParams (tagMap : TagMap) = [ let tagMapParams (tagMap : TagMap) = [
webLogIdParam tagMap.WebLogId
"@id", Sql.string (TagMapId.toString tagMap.Id) "@id", Sql.string (TagMapId.toString tagMap.Id)
"@tag", Sql.string tagMap.Tag "@data", Sql.jsonb (Utils.serialize ser tagMap)
"@urlValue", Sql.string tagMap.UrlValue
] ]
/// Save a tag mapping /// Save a tag mapping
let save tagMap = backgroundTask { let save tagMap = backgroundTask {
let! _ = do! Document.upsert conn Table.TagMap tagMapParams tagMap
Sql.existingConnection conn
|> Sql.query $"
{tagMapInsert} ON CONFLICT (id) DO UPDATE
SET tag = EXCLUDED.tag,
url_value = EXCLUDED.url_value"
|> Sql.parameters (tagMapParams tagMap)
|> Sql.executeNonQueryAsync
()
} }
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
@ -94,7 +61,7 @@ type PostgresTagMapData (conn : NpgsqlConnection) =
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
tagMapInsert, tagMaps |> List.map tagMapParams docInsertSql Table.TagMap, tagMaps |> List.map tagMapParams
] ]
() ()
} }

142
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@ -2,127 +2,57 @@
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation /// PostreSQL myWebLog theme data implementation
type PostgresThemeData (conn : NpgsqlConnection) = type PostgresThemeData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// Map a data row to a theme
let toTheme = Map.fromDoc<Theme> ser
/// Clear out the template text from a theme
let withoutTemplateText row =
let theme = toTheme row
{ theme with Templates = theme.Templates |> List.map (fun template -> { template with Text = "" }) }
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask { let all () =
let! themes =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id" |> Sql.query $"SELECT * FROM {Table.Theme} WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync Map.toTheme |> Sql.executeAsync withoutTemplateText
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row)
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
}
/// Does a given theme exist? /// Does a given theme exist?
let exists themeId = let exists themeId =
Sql.existingConnection conn Document.exists conn Table.Theme themeId ThemeId.toString
|> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist"
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeRowAsync Map.toExists
/// Find a theme by its ID /// Find a theme by its ID
let findById themeId = backgroundTask { let findById themeId =
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ] Document.findById conn Table.Theme themeId ThemeId.toString toTheme
let! theme =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync Map.toTheme
|> tryHead
if Option.isSome theme then
let! templates =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync (Map.toThemeTemplate true)
return Some { theme.Value with Templates = templates }
else return None
}
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask { let findByIdWithoutText themeId =
match! findById themeId with Document.findById conn Table.Theme themeId ThemeId.toString withoutTemplateText
| Some theme ->
return Some {
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
}
| None -> return None
}
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
let idParams = [ "@id", Sql.string (ThemeId.toString themeId) ] match! exists themeId with
let! exists = | true ->
Sql.existingConnection conn do! Document.delete conn Table.Theme (ThemeId.toString themeId)
|> Sql.query $"SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS {existsName}"
|> Sql.parameters idParams
|> Sql.executeRowAsync Map.toExists
if exists then
let! _ =
Sql.existingConnection conn
|> Sql.query
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
|> Sql.parameters idParams
|> Sql.executeNonQueryAsync
return true return true
else return false | false -> return false
} }
/// Create theme save parameters
let themeParams (theme : Theme) = [
"@id", Sql.string (ThemeId.toString theme.Id)
"@data", Sql.jsonb (Utils.serialize ser theme)
]
/// Save a theme /// Save a theme
let save (theme : Theme) = backgroundTask { let save (theme : Theme) = backgroundTask {
let! oldTheme = findById theme.Id do! Document.upsert conn Table.Theme themeParams theme
let themeIdParam = Sql.string (ThemeId.toString theme.Id)
let! _ =
Sql.existingConnection conn
|> Sql.query
"INSERT INTO theme VALUES (@id, @name, @version)
ON CONFLICT (id) DO UPDATE
SET name = EXCLUDED.name,
version = EXCLUDED.version"
|> Sql.parameters
[ "@id", themeIdParam
"@name", Sql.string theme.Name
"@version", Sql.string theme.Version ]
|> Sql.executeNonQueryAsync
let toDelete, _ =
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toAddOrUpdate =
theme.Templates
|> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name)))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO theme_template VALUES (@themeId, @name, @template)
ON CONFLICT (theme_id, name) DO UPDATE
SET template = EXCLUDED.template",
toAddOrUpdate |> List.map (fun tmpl -> [
"@themeId", themeIdParam
"@name", Sql.string tmpl.Name
"@template", Sql.string tmpl.Text
])
]
()
} }
interface IThemeData with interface IThemeData with
@ -140,14 +70,14 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = let all () =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset" |> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}"
|> Sql.executeAsync (Map.toThemeAsset false) |> Sql.executeAsync (Map.toThemeAsset false)
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask { let deleteByTheme themeId = backgroundTask {
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId" |> Sql.query $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
@ -157,7 +87,7 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
let findById assetId = let findById assetId =
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path" |> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ] |> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true) |> Sql.executeAsync (Map.toThemeAsset true)
|> tryHead |> tryHead
@ -165,14 +95,14 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme themeId = let findByTheme themeId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" |> Sql.query $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset false) |> Sql.executeAsync (Map.toThemeAsset false)
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData themeId = let findByThemeWithData themeId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId" |> Sql.query $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ] |> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset true) |> Sql.executeAsync (Map.toThemeAsset true)
@ -181,8 +111,8 @@ type PostgresThemeAssetData (conn : NpgsqlConnection) =
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query |> Sql.query $"
"INSERT INTO theme_asset ( INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, @data @themeId, @path, @updatedOn, @data

20
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -9,8 +9,8 @@ open Npgsql.FSharp
type PostgresUploadData (conn : NpgsqlConnection) = type PostgresUploadData (conn : NpgsqlConnection) =
/// The INSERT statement for an uploaded file /// The INSERT statement for an uploaded file
let upInsert = let upInsert = $"
"INSERT INTO upload ( INSERT INTO {Table.Upload} (
id, web_log_id, path, updated_on, data id, web_log_id, path, updated_on, data
) VALUES ( ) VALUES (
@id, @webLogId, @path, @updatedOn, @data @id, @webLogId, @path, @updatedOn, @data
@ -37,18 +37,18 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete uploadId webLogId = backgroundTask {
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ] let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let! path = let! path =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.query $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams |> Sql.parameters (webLogIdParam webLogId :: idParam)
|> Sql.executeAsync (fun row -> row.string "path") |> Sql.executeAsync (fun row -> row.string "path")
|> tryHead |> tryHead
if Option.isSome path then if Option.isSome path then
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" |> Sql.query (docDeleteSql Table.Upload)
|> Sql.parameters theParams |> Sql.parameters idParam
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
return Ok path.Value return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found""" else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
@ -57,7 +57,7 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath path webLogId = let findByPath path webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path" |> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ] |> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toUpload true) |> Sql.executeAsync (Map.toUpload true)
|> tryHead |> tryHead
@ -65,14 +65,14 @@ type PostgresUploadData (conn : NpgsqlConnection) =
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId" |> Sql.query $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload false) |> Sql.executeAsync (Map.toUpload false)
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = let findByWebLogWithData webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId" |> Sql.query $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload true) |> Sql.executeAsync (Map.toUpload true)

205
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -11,221 +11,72 @@ type PostgresWebLogData (conn : NpgsqlConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
/// The parameters for web log INSERT or web log/RSS options UPDATE statements /// Map a data row to a web log
let rssParams (webLog : WebLog) = [ let toWebLog = Map.fromDoc<WebLog> ser
"@isFeedEnabled", Sql.bool webLog.Rss.IsFeedEnabled
"@feedName", Sql.string webLog.Rss.FeedName
"@itemsInFeed", Sql.intOrNone webLog.Rss.ItemsInFeed
"@isCategoryEnabled", Sql.bool webLog.Rss.IsCategoryEnabled
"@isTagEnabled", Sql.bool webLog.Rss.IsTagEnabled
"@copyright", Sql.stringOrNone webLog.Rss.Copyright
]
/// The parameters for web log INSERT or UPDATE statements /// The parameters for web log INSERT or UPDATE statements
let webLogParams (webLog : WebLog) = [ let webLogParams (webLog : WebLog) = [
"@id", Sql.string (WebLogId.toString webLog.Id) "@id", Sql.string (WebLogId.toString webLog.Id)
"@name", Sql.string webLog.Name "@data", Sql.jsonb (Utils.serialize ser webLog)
"@slug", Sql.string webLog.Slug
"@subtitle", Sql.stringOrNone webLog.Subtitle
"@defaultPage", Sql.string webLog.DefaultPage
"@postsPerPage", Sql.int webLog.PostsPerPage
"@themeId", Sql.string (ThemeId.toString webLog.ThemeId)
"@urlBase", Sql.string webLog.UrlBase
"@timeZone", Sql.string webLog.TimeZone
"@autoHtmx", Sql.bool webLog.AutoHtmx
"@uploads", Sql.string (UploadDestination.toString webLog.Uploads)
yield! rssParams webLog
] ]
/// Shorthand to map a result to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync toCustomFeed
/// 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 } }
}
/// The parameters to save a custom feed
let feedParams webLogId (feed : CustomFeed) = [
webLogIdParam webLogId
"@id", Sql.string (CustomFeedId.toString feed.Id)
"@source", Sql.string (CustomFeedSource.toString feed.Source)
"@path", Sql.string (Permalink.toString feed.Path)
"@podcast", Sql.jsonbOrNone (feed.Podcast |> Option.map (Utils.serialize ser))
]
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, _ = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toAddOrUpdate =
webLog.Rss.CustomFeeds |> List.filter (fun f -> not (toDelete |> List.map toId |> List.contains f.Id))
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM web_log_feed WHERE id = @id",
toDelete |> List.map (fun it -> [ "@id", Sql.string (CustomFeedId.toString it.Id) ])
if not (List.isEmpty toAddOrUpdate) then
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path, @podcast
) ON CONFLICT (id) DO UPDATE
SET source = EXCLUDED.source,
path = EXCLUDED.path,
podcast = EXCLUDED.podcast",
toAddOrUpdate |> List.map (feedParams webLog.Id)
]
()
}
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog = backgroundTask {
let! _ = do! Document.insert conn Table.WebLog webLogParams webLog
Sql.existingConnection conn
|> Sql.query
"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
)"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
} }
/// Retrieve all web logs /// Retrieve all web logs
let all () = backgroundTask { let all () =
let! webLogs =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log" |> Sql.query $"SELECT * FROM {Table.WebLog}"
|> Sql.executeAsync Map.toWebLog |> Sql.executeAsync toWebLog
let! feeds =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_feed"
|> Sql.executeAsync (fun row -> WebLogId (row.string "web_log_id"), toCustomFeed row)
return
webLogs
|> List.map (fun it ->
{ it with
Rss =
{ it.Rss with
CustomFeeds = feeds |> List.filter (fun (wlId, _) -> wlId = it.Id) |> List.map snd } })
}
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId = backgroundTask {
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $" |> Sql.query $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery}; DELETE FROM {Table.PostComment}
DELETE FROM post_revision WHERE post_id IN {postSubQuery}; WHERE data ->> '{nameof Comment.empty.PostId}' IN (SELECT id FROM {Table.Post} WHERE {webLogWhere});
DELETE FROM post_category WHERE post_id IN {postSubQuery}; DELETE FROM {Table.Post} WHERE {webLogWhere};
DELETE FROM post WHERE web_log_id = @webLogId; DELETE FROM {Table.Page} WHERE {webLogWhere};
DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; DELETE FROM {Table.Category} WHERE {webLogWhere};
DELETE FROM page WHERE web_log_id = @webLogId; DELETE FROM {Table.TagMap} WHERE {webLogWhere};
DELETE FROM category WHERE web_log_id = @webLogId; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLogUser} WHERE {webLogWhere};
DELETE FROM upload WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLog} WHERE 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"
|> Sql.parameters [ webLogIdParam webLogId ] |> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
} }
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost url = backgroundTask { let findByHost url =
let! webLog =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log WHERE url_base = @urlBase" |> Sql.query $"SELECT * FROM {Table.WebLog} WHERE data ->> '{nameof WebLog.empty.UrlBase}' = @urlBase"
|> Sql.parameters [ "@urlBase", Sql.string url ] |> Sql.parameters [ "@urlBase", Sql.string url ]
|> Sql.executeAsync Map.toWebLog |> Sql.executeAsync toWebLog
|> tryHead |> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = backgroundTask { let findById webLogId =
let! webLog = Document.findById conn Table.WebLog webLogId WebLogId.toString toWebLog
Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log WHERE id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLog
|> tryHead
if Option.isSome webLog then
let! withFeeds = appendCustomFeeds webLog.Value
return Some withFeeds
else return None
}
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings webLog = backgroundTask {
let! _ = do! Document.update conn Table.WebLog webLogParams webLog
Sql.existingConnection conn
|> Sql.query
"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"
|> Sql.parameters (webLogParams webLog)
|> Sql.executeNonQueryAsync
()
} }
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask { let updateRssOptions (webLog : WebLog) = backgroundTask {
let! _ = use! txn = conn.BeginTransactionAsync ()
Sql.existingConnection conn match! findById webLog.Id with
|> Sql.query | Some blog ->
"UPDATE web_log do! Document.update conn Table.WebLog webLogParams { blog with Rss = webLog.Rss }
SET is_feed_enabled = @isFeedEnabled, do! txn.CommitAsync ()
feed_name = @feedName, | None -> ()
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @webLogId"
|> Sql.parameters (webLogIdParam webLog.Id :: rssParams webLog)
|> Sql.executeNonQueryAsync
do! updateCustomFeeds webLog
} }
interface IWebLogData with interface IWebLogData with

95
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@ -2,65 +2,42 @@ namespace MyWebLog.Data.Postgres
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
open Npgsql open Npgsql
open Npgsql.FSharp open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation /// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (conn : NpgsqlConnection) = type PostgresWebLogUserData (conn : NpgsqlConnection, ser : JsonSerializer) =
/// The INSERT statement for a user /// Map a data row to a user
let userInsert = let toWebLogUser = Map.fromDoc<WebLogUser> ser
"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
)"
/// Parameters for saving web log users /// Parameters for saving web log users
let userParams (user : WebLogUser) = [ let userParams (user : WebLogUser) = [
"@id", Sql.string (WebLogUserId.toString user.Id) "@id", Sql.string (WebLogUserId.toString user.Id)
"@webLogId", Sql.string (WebLogId.toString user.WebLogId) "@data", Sql.jsonb (Utils.serialize ser user)
"@email", Sql.string user.Email
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@preferredName", Sql.string user.PreferredName
"@passwordHash", Sql.string user.PasswordHash
"@url", Sql.stringOrNone user.Url
"@accessLevel", Sql.string (AccessLevel.toString user.AccessLevel)
typedParam "createdOn" user.CreatedOn
optParam "lastSeenOn" user.LastSeenOn
] ]
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = let findById userId webLogId =
Sql.existingConnection conn Document.findByIdAndWebLog conn Table.WebLogUser userId WebLogUserId.toString webLogId toWebLogUser
|> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
|> tryHead
/// Delete a user if they have no posts or pages /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ]
let! isAuthor = let! isAuthor =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query |> Sql.query $"
"SELECT ( EXISTS (SELECT 1 FROM page WHERE author_id = @userId SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE data ->> '{nameof Page.empty.AuthorId}' = @id
OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist" OR EXISTS (SELECT 1 FROM {Table.Post} WHERE data ->> '{nameof Post.empty.AuthorId}' = @id))
|> Sql.parameters userParam AS {existsName}"
|> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeRowAsync Map.toExists |> Sql.executeRowAsync Map.toExists
if isAuthor then if isAuthor then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
let! _ = do! Document.delete conn Table.WebLogUser (WebLogUserId.toString userId)
Sql.existingConnection conn
|> Sql.query "DELETE FROM web_log_user WHERE id = @userId"
|> Sql.parameters userParam
|> Sql.executeNonQueryAsync
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
@ -68,26 +45,24 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail email webLogId = let findByEmail email webLogId =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email" |> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} AND data ->> '{nameof WebLogUser.empty.Email}' = @email"
|> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ] |> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ]
|> Sql.executeAsync Map.toWebLogUser |> Sql.executeAsync toWebLogUser
|> tryHead |> tryHead
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
Sql.existingConnection conn Document.findByWebLog conn Table.WebLogUser webLogId toWebLogUser
|> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)" (Some $"ORDER BY LOWER(data ->> '{nameof WebLogUser.empty.PreferredName}')")
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync Map.toWebLogUser
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask { let findNames webLogId userIds = backgroundTask {
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let! users = let! users =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}" |> Sql.query $"{docSelectForWebLogSql Table.WebLogUser} {idSql}"
|> Sql.parameters (webLogIdParam webLogId :: idParams) |> Sql.parameters (webLogIdParam webLogId :: idParams)
|> Sql.executeAsync Map.toWebLogUser |> Sql.executeAsync toWebLogUser
return return
users users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u }) |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
@ -98,42 +73,24 @@ type PostgresWebLogUserData (conn : NpgsqlConnection) =
let! _ = let! _ =
Sql.existingConnection conn Sql.existingConnection conn
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
userInsert, users |> List.map userParams docInsertSql Table.WebLogUser, users |> List.map userParams
] ]
() ()
} }
/// Set a user's last seen date/time to now /// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask { let setLastSeen userId webLogId = backgroundTask {
let! _ = use! txn = conn.BeginTransactionAsync ()
Sql.existingConnection conn match! findById userId webLogId with
|> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId" | Some user ->
|> Sql.parameters do! Document.update conn Table.WebLogUser userParams { user with LastSeenOn = Some (Noda.now ()) }
[ webLogIdParam webLogId do! txn.CommitAsync ()
typedParam "lastSeenOn" (Noda.now ()) | None -> ()
"@id", Sql.string (WebLogUserId.toString userId) ]
|> Sql.executeNonQueryAsync
()
} }
/// Save a user /// Save a user
let save user = backgroundTask { let save user = backgroundTask {
let! _ = do! Document.upsert conn Table.WebLogUser userParams user
Sql.existingConnection conn
|> Sql.query $"
{userInsert} ON CONFLICT (id) DO UPDATE
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"
|> Sql.parameters (userParams user)
|> Sql.executeNonQueryAsync
()
} }
interface IWebLogUserData with interface IWebLogUserData with

210
src/MyWebLog.Data/PostgresData.fs
View File

@ -1,6 +1,7 @@
namespace MyWebLog.Data namespace MyWebLog.Data
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data.Postgres open MyWebLog.Data.Postgres
open Newtonsoft.Json open Newtonsoft.Json
open Npgsql open Npgsql
@ -18,183 +19,98 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
|> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'" |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'public'"
|> Sql.executeAsync (fun row -> row.string "tablename") |> Sql.executeAsync (fun row -> row.string "tablename")
let needsTable table = not (List.contains table tables) let needsTable table = not (List.contains table tables)
// Create a document table
let docTable table = $"CREATE TABLE %s{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
let mutable isNew = false let mutable isNew = false
let sql = seq { let sql = seq {
// Theme tables // Theme tables
if needsTable "theme" then if needsTable Table.Theme then
isNew <- true isNew <- true
"CREATE TABLE theme ( docTable Table.Theme
id TEXT NOT NULL PRIMARY KEY, if needsTable Table.ThemeAsset then
name TEXT NOT NULL, $"CREATE TABLE {Table.ThemeAsset} (
version TEXT NOT NULL)" theme_id TEXT NOT NULL REFERENCES {Table.Theme} (id) ON DELETE CASCADE,
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, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL, data BYTEA NOT NULL,
PRIMARY KEY (theme_id, path))" PRIMARY KEY (theme_id, path))"
// Web log tables // Web log table
if needsTable "web_log" then if needsTable Table.WebLog then
"CREATE TABLE web_log ( docTable Table.WebLog
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX web_log_theme_idx ON {Table.WebLog} (data ->> '{nameof WebLog.empty.ThemeId}')"
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 BOOLEAN NOT NULL DEFAULT FALSE,
uploads TEXT NOT NULL,
is_feed_enabled BOOLEAN NOT NULL DEFAULT FALSE,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
is_category_enabled BOOLEAN NOT NULL DEFAULT FALSE,
is_tag_enabled BOOLEAN NOT NULL DEFAULT FALSE,
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 NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL,
podcast JSONB)"
"CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"
// Category table // Category table
if needsTable "category" then if needsTable Table.Category then
"CREATE TABLE category ( docTable Table.Category
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX category_web_log_idx ON {Table.Category} (data ->> '{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 // Web log user table
if needsTable "web_log_user" then if needsTable Table.WebLogUser then
"CREATE TABLE web_log_user ( docTable Table.WebLogUser
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX web_log_user_web_log_idx ON {Table.WebLogUser}
web_log_id TEXT NOT NULL REFERENCES web_log (id), (data ->> '{nameof WebLogUser.empty.WebLogId}')"
email TEXT NOT NULL, $"CREATE INDEX web_log_user_email_idx ON {Table.WebLogUser}
first_name TEXT NOT NULL, (data ->> '{nameof WebLogUser.empty.WebLogId}', data ->> '{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 TIMESTAMPTZ NOT NULL,
last_seen_on TIMESTAMPTZ)"
"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 // Page tables
if needsTable "page" then if needsTable Table.Page then
"CREATE TABLE page ( docTable Table.Page
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX page_web_log_idx ON {Table.Page} (data ->> '{nameof Page.empty.WebLogId}')"
web_log_id TEXT NOT NULL REFERENCES web_log (id), $"CREATE INDEX page_author_idx ON {Table.Page} (data ->> '{nameof Page.empty.AuthorId}')"
author_id TEXT NOT NULL REFERENCES web_log_user (id), $"CREATE INDEX page_permalink_idx ON {Table.Page}
title TEXT NOT NULL, (data ->> '{nameof Page.empty.WebLogId}', data ->> '{nameof Page.empty.Permalink}')"
permalink TEXT NOT NULL, if needsTable Table.PageRevision then
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', $"CREATE TABLE {Table.PageRevision} (
published_on TIMESTAMPTZ NOT NULL, page_id TEXT NOT NULL REFERENCES {Table.Page} (id) ON DELETE CASCADE,
updated_on TIMESTAMPTZ NOT NULL,
is_in_page_list BOOLEAN NOT NULL DEFAULT FALSE,
template TEXT,
page_text TEXT NOT NULL,
meta_items JSONB)"
"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_revision" then
"CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (page_id, as_of))" PRIMARY KEY (page_id, as_of))"
// Post tables // Post tables
if needsTable "post" then if needsTable Table.Post then
"CREATE TABLE post ( docTable Table.Post
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX post_web_log_idx ON {Table.Post} (data ->> '{nameof Post.empty.WebLogId}')"
web_log_id TEXT NOT NULL REFERENCES web_log (id), $"CREATE INDEX post_author_idx ON {Table.Post} (data ->> '{nameof Post.empty.AuthorId}')"
author_id TEXT NOT NULL REFERENCES web_log_user (id), $"CREATE INDEX post_status_idx ON {Table.Post}
status TEXT NOT NULL, (data ->> '{nameof Post.empty.WebLogId}', data ->> '{nameof Post.empty.Status}',
title TEXT NOT NULL, data ->> '{nameof Post.empty.UpdatedOn}')"
permalink TEXT NOT NULL, $"CREATE INDEX post_permalink_idx ON {Table.Post}
prior_permalinks TEXT[] NOT NULL DEFAULT '{}', (data ->> '{nameof Post.empty.WebLogId}', data ->> '{nameof Post.empty.Permalink}')"
published_on TIMESTAMPTZ, $"CREATE INDEX post_category_idx ON {Table.Post} USING GIN
updated_on TIMESTAMPTZ NOT NULL, (data ->> '{nameof Post.empty.CategoryIds}')"
template TEXT, $"CREATE INDEX post_tag_idx ON {Table.Post} USING GIN (data ->> '{nameof Post.empty.Tags}')"
post_text TEXT NOT NULL, if needsTable Table.PostRevision then
tags TEXT[], $"CREATE TABLE {Table.PostRevision} (
meta_items JSONB, post_id TEXT NOT NULL REFERENCES {Table.Post} (id) ON DELETE CASCADE,
episode JSONB)"
"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_revision" then
"CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TIMESTAMPTZ NOT NULL, as_of TIMESTAMPTZ NOT NULL,
revision_text TEXT NOT NULL, revision_text TEXT NOT NULL,
PRIMARY KEY (post_id, as_of))" PRIMARY KEY (post_id, as_of))"
if needsTable "post_comment" then if needsTable Table.PostComment then
"CREATE TABLE post_comment ( docTable Table.PostComment
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX post_comment_post_idx ON {Table.PostComment} (data ->> '{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 TIMESTAMPTZ NOT NULL,
comment_text TEXT NOT NULL)"
"CREATE INDEX post_comment_post_idx ON post_comment (post_id)"
// Tag map table // Tag map table
if needsTable "tag_map" then if needsTable Table.TagMap then
"CREATE TABLE tag_map ( docTable Table.TagMap
id TEXT NOT NULL PRIMARY KEY, $"CREATE INDEX tag_map_web_log_idx ON {Table.TagMap} (data ->> '{nameof TagMap.empty.WebLogId}')"
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL)"
"CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"
// Uploaded file table // Uploaded file table
if needsTable "upload" then if needsTable Table.Upload then
"CREATE TABLE upload ( $"CREATE TABLE {Table.Upload} (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id), web_log_id TEXT NOT NULL REFERENCES {Table.WebLog} (id),
path TEXT NOT NULL, path TEXT NOT NULL,
updated_on TIMESTAMPTZ NOT NULL, updated_on TIMESTAMPTZ NOT NULL,
data BYTEA NOT NULL)" data BYTEA NOT NULL)"
"CREATE INDEX upload_web_log_idx ON upload (web_log_id)" $"CREATE INDEX upload_web_log_idx ON {Table.Upload} (web_log_id)"
"CREATE INDEX upload_path_idx ON upload (web_log_id, path)" $"CREATE INDEX upload_path_idx ON {Table.Upload} (web_log_id, path)"
// Database version table // Database version table
if needsTable "db_version" then if needsTable Table.DbVersion then
"CREATE TABLE db_version (id TEXT NOT NULL PRIMARY KEY)" $"CREATE TABLE {Table.DbVersion} (id TEXT NOT NULL PRIMARY KEY)"
$"INSERT INTO db_version VALUES ('{Utils.currentDbVersion}')" $"INSERT INTO {Table.DbVersion} VALUES ('{Utils.currentDbVersion}')"
} }
Sql.existingConnection conn Sql.existingConnection conn
@ -233,15 +149,15 @@ type PostgresData (conn : NpgsqlConnection, log : ILogger<PostgresData>, ser : J
interface IData with interface IData with
member _.Category = PostgresCategoryData conn member _.Category = PostgresCategoryData (conn, ser)
member _.Page = PostgresPageData (conn, ser) member _.Page = PostgresPageData (conn, ser)
member _.Post = PostgresPostData (conn, ser) member _.Post = PostgresPostData (conn, ser)
member _.TagMap = PostgresTagMapData conn member _.TagMap = PostgresTagMapData (conn, ser)
member _.Theme = PostgresThemeData conn member _.Theme = PostgresThemeData (conn, ser)
member _.ThemeAsset = PostgresThemeAssetData conn member _.ThemeAsset = PostgresThemeAssetData conn
member _.Upload = PostgresUploadData conn member _.Upload = PostgresUploadData conn
member _.WebLog = PostgresWebLogData (conn, ser) member _.WebLog = PostgresWebLogData (conn, ser)
member _.WebLogUser = PostgresWebLogUserData conn member _.WebLogUser = PostgresWebLogUserData (conn, ser)
member _.Serializer = ser member _.Serializer = ser

2
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -5,7 +5,6 @@ open MyWebLog
open RethinkDb.Driver open RethinkDb.Driver
/// Functions to assist with retrieving data /// Functions to assist with retrieving data
[<AutoOpen>]
module private RethinkHelpers = module private RethinkHelpers =
/// Table names /// Table names
@ -90,6 +89,7 @@ open System
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog.ViewModels open MyWebLog.ViewModels
open RethinkDb.Driver.FSharp open RethinkDb.Driver.FSharp
open RethinkHelpers
/// RethinkDB implementation of data functions for myWebLog /// 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>) =