* Use PostgreSQL JSON-based data implementation
* Fix back link on RSS settings page (#34)
* Show theme upload messages (#28)
* Fix admin page list paging (#35)
* Add db migrations for all stores
* Support both .NET 6 and 7
This commit was merged in pull request #36.
This commit is contained in:
2023-02-26 13:01:21 -05:00
committed by GitHub
parent 5f3daa1de9
commit 7b325dc19e
36 changed files with 1174 additions and 1963 deletions

View File

@@ -2,11 +2,68 @@
[<AutoOpen>]
module MyWebLog.Data.Postgres.PostgresHelpers
/// The table names used in the PostgreSQL implementation
[<RequireQualifiedAccess>]
module Table =
/// Categories
[<Literal>]
let Category = "category"
/// Database Version
[<Literal>]
let DbVersion = "db_version"
/// Pages
[<Literal>]
let Page = "page"
/// Page Revisions
[<Literal>]
let PageRevision = "page_revision"
/// Posts
[<Literal>]
let Post = "post"
/// Post Comments
[<Literal>]
let PostComment = "post_comment"
/// Post Revisions
[<Literal>]
let PostRevision = "post_revision"
/// Tag/URL Mappings
[<Literal>]
let TagMap = "tag_map"
/// Themes
[<Literal>]
let Theme = "theme"
/// Theme Assets
[<Literal>]
let ThemeAsset = "theme_asset"
/// Uploads
[<Literal>]
let Upload = "upload"
/// Web Logs
[<Literal>]
let WebLog = "web_log"
/// Users
[<Literal>]
let WebLogUser = "web_log_user"
open System
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
open Npgsql.FSharp
@@ -15,12 +72,24 @@ open Npgsql.FSharp
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
/// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) =
{| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query
let webLogContains webLogId =
"@criteria", Query.jsonbDocParam (webLogDoc webLogId)
/// The name of the field to select to be able to use Map.toCount
let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist"
/// A SQL string to select data from a table with the given JSON document contains criteria
let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", []
@@ -37,22 +106,11 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for the array equivalent of an IN clause
let arrayInClause<'T> name (valueFunc : 'T -> string) (items : 'T list) =
if List.isEmpty items then "TRUE = FALSE", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS} OR %s{name} && ARRAY[@{name}{idx}]",
($"@{name}{idx}", Sql.string (valueFunc it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"{name} && ARRAY[@{name}0]", [ $"@{name}0", Sql.string (valueFunc it) ])
|> Seq.head)
/// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) =
$"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
@@ -71,113 +129,24 @@ let optParam<'T> name (it : 'T option) =
/// Mapping functions for SQL queries
module Map =
/// Map an id field to a category ID
let toCategoryId (row : RowReader) =
CategoryId (row.string "id")
/// Create a category from the current row
let toCategory (row : RowReader) : Category =
{ Id = toCategoryId row
WebLogId = row.string "web_log_id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Description = row.stringOrNone "description"
ParentId = row.stringOrNone "parent_id" |> Option.map CategoryId
}
/// Get a count from a row
let toCount (row : RowReader) =
row.int countName
/// Create a custom feed from the current row
let toCustomFeed (ser : JsonSerializer) (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast = row.stringOrNone "podcast" |> Option.map (Utils.deserialize ser)
}
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool existsName
/// Create a meta item from the current row
let toMetaItem (row : RowReader) : MetaItem =
{ Name = row.string "name"
Value = row.string "value"
}
/// Create a permalink from the current row
let toPermalink (row : RowReader) =
Permalink (row.string "permalink")
/// Create a page from the current row
let toPage (ser : JsonSerializer) (row : RowReader) : Page =
{ Page.empty with
Id = row.string "id" |> PageId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValue<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
IsInPageList = row.bool "is_in_page_list"
Template = row.stringOrNone "template"
Text = row.string "page_text"
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row
let toPost (ser : JsonSerializer) (row : RowReader) : Post =
{ Post.empty with
Id = row.string "id" |> PostId
WebLogId = row.string "web_log_id" |> WebLogId
AuthorId = row.string "author_id" |> WebLogUserId
Status = row.string "status" |> PostStatus.parse
Title = row.string "title"
Permalink = toPermalink row
PriorPermalinks = row.stringArray "prior_permalinks" |> Array.map Permalink |> List.ofArray
PublishedOn = row.fieldValueOrNone<Instant> "published_on"
UpdatedOn = row.fieldValue<Instant> "updated_on"
Template = row.stringOrNone "template"
Text = row.string "post_text"
Episode = row.stringOrNone "episode" |> Option.map (Utils.deserialize ser)
CategoryIds = row.stringArrayOrNone "category_ids"
|> Option.map (Array.map CategoryId >> List.ofArray)
|> Option.defaultValue []
Tags = row.stringArrayOrNone "tags"
|> Option.map List.ofArray
|> Option.defaultValue []
Metadata = row.stringOrNone "meta_items"
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
}
/// Create a tag mapping from the current row
let toTagMap (row : RowReader) : TagMap =
{ Id = row.string "id" |> TagMapId
WebLogId = row.string "web_log_id" |> WebLogId
Tag = row.string "tag"
UrlValue = row.string "url_value"
}
/// Create a theme from the current row (excludes templates)
let toTheme (row : RowReader) : Theme =
{ Theme.empty with
Id = row.string "id" |> ThemeId
Name = row.string "name"
Version = row.string "version"
}
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
@@ -185,12 +154,6 @@ module Map =
Data = if includeData then row.bytea "data" else [||]
}
/// Create a theme template from the current row
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
{ Name = row.string "name"
Text = if includeText then row.string "template" else ""
}
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
@@ -199,42 +162,75 @@ module Map =
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Document manipulation functions
module Document =
/// Create a web log from the current row
let toWebLog (row : RowReader) : WebLog =
{ Id = row.string "id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Subtitle = row.stringOrNone "subtitle"
DefaultPage = row.string "default_page"
PostsPerPage = row.int "posts_per_page"
ThemeId = row.string "theme_id" |> ThemeId
UrlBase = row.string "url_base"
TimeZone = row.string "time_zone"
AutoHtmx = row.bool "auto_htmx"
Uploads = row.string "uploads" |> UploadDestination.parse
Rss = {
IsFeedEnabled = row.bool "is_feed_enabled"
FeedName = row.string "feed_name"
ItemsInFeed = row.intOrNone "items_in_feed"
IsCategoryEnabled = row.bool "is_category_enabled"
IsTagEnabled = row.bool "is_tag_enabled"
Copyright = row.stringOrNone "copyright"
CustomFeeds = []
}
}
/// Determine whether a document exists with the given key for the given web log
let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.scalar
$""" SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
) AS {existsName}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
/// Create a web log user from the current row
let toWebLogUser (row : RowReader) : WebLogUser =
{ Id = row.string "id" |> WebLogUserId
WebLogId = row.string "web_log_id" |> WebLogId
Email = row.string "email"
FirstName = row.string "first_name"
LastName = row.string "last_name"
PreferredName = row.string "preferred_name"
PasswordHash = row.string "password_hash"
Url = row.stringOrNone "url"
AccessLevel = row.string "access_level" |> AccessLevel.parse
CreatedOn = row.fieldValue<Instant> "created_on"
LastSeenOn = row.fieldValueOrNone<Instant> "last_seen_on"
}
/// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
/// Find a document by its ID for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId)
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Custom.list $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (keyFunc key) ] Map.toRevision
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId =
Custom.list
$"""SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC"""
[ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (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> 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! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@id", Sql.string (keyFunc key)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
()
}