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

v2 RC2 #33

Merged
danieljsummers merged 13 commits from add-pgsql into main 2022-08-21 22:56:18 +00:00
Conversation 0 Commits 13 Files Changed 45 +898 -113
10 changed files with 898 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit b3c008629a - Show all commits

3
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -36,6 +36,9 @@
<Compile Include="PostgreSql\PostgreSqlPageData.fs" />
<Compile Include="PostgreSql\PostgreSqlPostData.fs" />
<Compile Include="PostgreSql\PostgreSqlTagMapData.fs" />
<Compile Include="PostgreSql\PostgreSqlThemeData.fs" />
<Compile Include="PostgreSql\PostgreSqlUploadData.fs" />
<Compile Include="PostgreSql\PostgreSqlWebLogData.fs" />
<Compile Include="PostgreSqlData.fs" />
</ItemGroup>

46
src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs
View File

@ -117,35 +117,47 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
| None -> return CategoryNotFound
}
/// Update a category
let save (cat : Category) = backgroundTask {
/// The INSERT statement for a category
let catInsert = """
INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"""
/// Create parameters for a category insert / update
let catParameters (cat : Category) = [
webLogIdParam cat.WebLogId
"@id", Sql.string (CategoryId.toString cat.Id)
"@name", Sql.string cat.Name
"@slug", Sql.string cat.Slug
"@description", Sql.stringOrNone cat.Description
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
]
/// Save a category
let save cat = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
) ON CONFLICT (id) DO UPDATE
|> 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
[ 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) ]
|> Sql.parameters (catParameters cat)
|> Sql.executeNonQueryAsync
()
}
/// Restore categories from a backup
let restore cats = backgroundTask {
for cat in cats do
do! save cat
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
catInsert, cats |> List.map catParameters
]
()
}
interface ICategoryData with

90
src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs
View File

@ -57,6 +57,39 @@ module Map =
let toCount (row : RowReader) =
row.int "the_count"
/// Create a custom feed from the current row
let toCustomFeed (row : RowReader) : CustomFeed =
{ Id = row.string "id" |> CustomFeedId
Source = row.string "source" |> CustomFeedSource.parse
Path = row.string "path" |> Permalink
Podcast =
match row.stringOrNone "title" with
| Some title ->
Some {
Title = title
Subtitle = row.stringOrNone "subtitle"
ItemsInFeed = row.int "items_in_feed"
Summary = row.string "summary"
DisplayedAuthor = row.string "displayed_author"
Email = row.string "email"
ImageUrl = row.string "image_url" |> Permalink
AppleCategory = row.string "apple_category"
AppleSubcategory = row.stringOrNone "apple_subcategory"
Explicit = row.string "explicit" |> ExplicitRating.parse
DefaultMediaType = row.stringOrNone "default_media_type"
MediaBaseUrl = row.stringOrNone "media_base_url"
PodcastGuid = row.uuidOrNone "podcast_guid"
FundingUrl = row.stringOrNone "funding_url"
FundingText = row.stringOrNone "funding_text"
Medium = row.stringOrNone "medium" |> Option.map PodcastMedium.parse
}
| None -> None
}
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool "does_exist"
/// Create a meta item from the current row
let toMetaItem (row : RowReader) : MetaItem =
{ Name = row.string "name"
@ -118,10 +151,65 @@ module Map =
Text = row.string "revision_text" |> MarkupText.parse
}
/// Create a tag mapping from the current row in the given data reader
/// Create a tag mapping from the current row
let toTagMap (row : RowReader) : TagMap =
{ Id = row.string "id" |> TagMapId
WebLogId = row.string "web_log_id" |> WebLogId
Tag = row.string "tag"
UrlValue = row.string "url_value"
}
/// Create a theme from the current row (excludes templates)
let toTheme (row : RowReader) : Theme =
{ Theme.empty with
Id = row.string "id" |> ThemeId
Name = row.string "name"
Version = row.string "version"
}
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.dateTime "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Create a theme template from the current row
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
{ Name = row.string "name"
Text = if includeText then row.string "template" else ""
}
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.dateTime "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
/// Create a web log from the current row
let toWebLog (row : RowReader) : WebLog =
{ Id = row.string "id" |> WebLogId
Name = row.string "name"
Slug = row.string "slug"
Subtitle = row.stringOrNone "subtitle"
DefaultPage = row.string "default_page"
PostsPerPage = row.int "posts_per_page"
ThemeId = row.string "theme_id" |> ThemeId
UrlBase = row.string "url_base"
TimeZone = row.string "time_zone"
AutoHtmx = row.bool "auto_htmx"
Uploads = row.string "uploads" |> UploadDestination.parse
Rss = {
IsFeedEnabled = row.bool "is_feed_enabled"
FeedName = row.string "feed_name"
ItemsInFeed = row.intOrNone "items_in_feed"
IsCategoryEnabled = row.bool "is_category_enabled"
IsTagEnabled = row.bool "is_tag_enabled"
Copyright = row.stringOrNone "copyright"
CustomFeeds = []
}
}

81
src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs
View File

@ -25,6 +25,16 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
let pageWithoutText row =
{ Map.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 = [
"@pageId", Sql.string (PageId.toString pageId)
"@asOf", Sql.timestamptz rev.AsOf
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
@ -40,13 +50,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
"@asOf", Sql.timestamptz it.AsOf
])
if not (List.isEmpty toAdd) then
"INSERT INTO page_revision VALUES (@pageId, @asOf, @text)",
toAdd
|> List.map (fun it -> [
"@pageId", Sql.string (PageId.toString pageId)
"@asOf", Sql.timestamptz it.AsOf
"@text", Sql.string (MarkupText.toString it.Text)
])
revInsert, toAdd |> List.map (revParams pageId)
]
()
}
@ -173,19 +177,39 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|> Sql.executeAsync Map.toPage
/// The INSERT statement for a page
let pageInsert = """
INSERT INTO page (
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
template, page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
@template, @text, @metaItems
)"""
/// The parameters for saving a page
let pageParams (page : Page) = [
webLogIdParam page.WebLogId
"@id", Sql.string (PageId.toString page.Id)
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
"@title", Sql.string page.Title
"@permalink", Sql.string (Permalink.toString page.Permalink)
"@publishedOn", Sql.timestamptz page.PublishedOn
"@updatedOn", Sql.timestamptz page.UpdatedOn
"@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
]
/// Save a page
let save (page : Page) = backgroundTask {
let! oldPage = findFullById page.Id page.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query """
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
) ON CONFLICT (id) DO UPDATE
|> Sql.query $"""
{pageInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
title = EXCLUDED.title,
permalink = EXCLUDED.permalink,
@ -196,29 +220,22 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
template = EXCLUDED.template,
page_text = EXCLUDED.text,
meta_items = EXCLUDED.meta_items"""
|> Sql.parameters
[ webLogIdParam page.WebLogId
"@id", Sql.string (PageId.toString page.Id)
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
"@title", Sql.string page.Title
"@permalink", Sql.string (Permalink.toString page.Permalink)
"@publishedOn", Sql.timestamptz page.PublishedOn
"@updatedOn", Sql.timestamptz page.UpdatedOn
"@isInPageList", Sql.bool page.IsInPageList
"@template", Sql.stringOrNone page.Template
"@text", Sql.string page.Text
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
"@priorPermalinks",
Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ]
|> Sql.parameters (pageParams page)
|> Sql.executeNonQueryAsync
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
()
}
/// Restore pages from a backup
let restore pages = backgroundTask {
for page in pages do
do! save page
let restore (pages : Page list) = backgroundTask {
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
pageInsert, pages |> List.map pageParams
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev)
]
()
}
/// Update a page's prior permalinks

110
src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs
View File

@ -31,28 +31,41 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
let postWithoutText row =
{ Map.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 catParams cats =
cats
|> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId)
"categoryId", Sql.string (CategoryId.toString it)
])
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
catParams toDelete
toDelete |> List.map (catParams postId)
if not (List.isEmpty toAdd) then
"INSERT INTO post_category VALUES (@postId, @categoryId)", catParams toAdd
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 = [
"@postId", Sql.string (PostId.toString postId)
"@asOf", Sql.timestamptz rev.AsOf
"@text", Sql.string (MarkupText.toString rev.Text)
]
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
@ -68,13 +81,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
"@asOf", Sql.timestamptz it.AsOf
])
if not (List.isEmpty toAdd) then
"INSERT INTO post_revision VALUES (@postId, @asOf, @text)",
toAdd
|> List.map (fun it -> [
"@postId", Sql.string (PostId.toString postId)
"@asOf", Sql.timestamptz it.AsOf
"@text", Sql.string (MarkupText.toString it.Text)
])
revInsert, toAdd |> List.map (revParams postId)
]
()
}
@ -259,19 +266,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
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
let postParams (post : Post) = [
webLogIdParam post.WebLogId
"@id", Sql.string (PostId.toString post.Id)
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
"@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@publishedOn", Sql.timestamptzOrNone post.PublishedOn
"@updatedOn", Sql.timestamptz post.UpdatedOn
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@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 (JsonConvert.SerializeObject post.Metadata)
|> Sql.jsonbOrNone
]
/// Save a post
let save (post : Post) = backgroundTask {
let! oldPost = findFullById post.Id post.WebLogId
let! _ =
Sql.existingConnection conn
|> Sql.query """
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
) ON CONFLICT (id) DO UPDATE
|> Sql.query $"""
{postInsert} ON CONFLICT (id) DO UPDATE
SET author_id = EXCLUDED.author_id,
status = EXCLUDED.status,
title = EXCLUDED.title,
@ -284,26 +315,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
tags = EXCLUDED.tags,
meta_items = EXCLUDED.meta_items,
episode = EXCLUDED.episode"""
|> Sql.parameters
[ webLogIdParam post.WebLogId
"@id", Sql.string (PostId.toString post.Id)
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
"@status", Sql.string (PostStatus.toString post.Status)
"@title", Sql.string post.Title
"@permalink", Sql.string (Permalink.toString post.Permalink)
"@publishedOn", Sql.timestamptzOrNone post.PublishedOn
"@updatedOn", Sql.timestamptz post.UpdatedOn
"@template", Sql.stringOrNone post.Template
"@text", Sql.string post.Text
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
"@priorPermalinks",
Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
"@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 (JsonConvert.SerializeObject post.Metadata)
|> Sql.jsonbOrNone
]
|> 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
@ -311,8 +323,16 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
/// Restore posts from a backup
let restore posts = backgroundTask {
for post in posts do
do! save post
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! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
postInsert, posts |> List.map postParams
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId)
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev)
]
()
}
/// Update prior permalinks for a post

41
src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs
View File

@ -56,32 +56,43 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) =
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|> Sql.executeAsync Map.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
let tagMapParams (tagMap : TagMap) = [
webLogIdParam tagMap.WebLogId
"@id", Sql.string (TagMapId.toString tagMap.Id)
"@tag", Sql.string tagMap.Tag
"@urlValue", Sql.string tagMap.UrlValue
]
/// Save a tag mapping
let save (tagMap : TagMap) = backgroundTask {
let save tagMap = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
) ON CONFLICT (id) DO UPDATE
|> Sql.query $"""
{tagMapInsert} ON CONFLICT (id) DO UPDATE
SET tag = EXCLUDED.tag,
url_value = EXCLUDED.url_value"""
|> Sql.parameters
[ webLogIdParam tagMap.WebLogId
"@id", Sql.string (TagMapId.toString tagMap.Id)
"@tag", Sql.string tagMap.Tag
"@urlValue", Sql.string tagMap.UrlValue
]
|> Sql.parameters (tagMapParams tagMap)
|> Sql.executeNonQueryAsync
()
}
/// Restore tag mappings from a backup
let restore tagMaps = backgroundTask {
for tagMap in tagMaps do
do! save tagMap
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
tagMapInsert, tagMaps |> List.map tagMapParams
]
()
}
interface ITagMapData with

204
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs Normal file
View File

@ -0,0 +1,204 @@
namespace MyWebLog.Data.PostgreSql
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation
type PostgreSqlThemeData (conn : NpgsqlConnection) =
/// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask {
let! themes =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|> Sql.executeAsync Map.toTheme
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?
let exists themeId =
Sql.existingConnection conn
|> 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
let findById themeId = backgroundTask {
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ]
let! tryTheme =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|> Sql.parameters themeIdParam
|> Sql.executeAsync Map.toTheme
match List.tryHead tryTheme with
| Some theme ->
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 with Templates = templates }
| None -> return None
}
/// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask {
match! findById themeId with
| 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
let delete themeId = backgroundTask {
match! findByIdWithoutText themeId with
| Some _ ->
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 [ "@id", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync
return true
| None -> return false
}
/// Save a theme
let save (theme : Theme) = backgroundTask {
let! oldTheme = findById theme.Id
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
member _.All () = all ()
member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
member _.Save theme = save theme
/// PostreSQL myWebLog theme data implementation
type PostgreSqlThemeAssetData (conn : NpgsqlConnection) =
/// Get all theme assets (excludes data)
let all () =
Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset"
|> Sql.executeAsync (Map.toThemeAsset false)
/// Delete all assets for the given theme
let deleteByTheme themeId = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a theme asset by its ID
let findById assetId = backgroundTask {
let (ThemeAssetId (ThemeId themeId, path)) = assetId
let! asset =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toThemeAsset true)
return List.tryHead asset
}
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId =
Sql.existingConnection conn
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset false)
/// Get theme assets for the given theme
let findByThemeWithData themeId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId"
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|> Sql.executeAsync (Map.toThemeAsset true)
/// Save a theme asset
let save (asset : ThemeAsset) = backgroundTask {
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
let! _ =
Sql.existingConnection conn
|> Sql.query """
INSERT INTO theme_asset (
theme_id, path, updated_on, data
) VALUES (
@themeId, @path, @updatedOn, @data
) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data"""
|> Sql.parameters
[ "@themeId", Sql.string themeId
"@path", Sql.string path
"@updatedOn", Sql.timestamptz asset.UpdatedOn
"@data", Sql.bytea asset.Data ]
|> Sql.executeNonQueryAsync
()
}
interface IThemeAssetData with
member _.All () = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId
member _.FindByThemeWithData themeId = findByThemeWithData themeId
member _.Save asset = save asset

99
src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs Normal file
View File

@ -0,0 +1,99 @@
namespace MyWebLog.Data.PostgreSql
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation
type PostgreSqlUploadData (conn : NpgsqlConnection) =
/// The INSERT statement for an uploaded file
let upInsert = """
INSERT INTO upload (
id, web_log_id, path, updated_on, data
) VALUES (
@id, @webLogId, @path, @updatedOn, @data
)"""
/// Parameters for adding an uploaded file
let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path)
"@updatedOn", Sql.timestamptz upload.UpdatedOn
"@data", Sql.bytea upload.Data
]
/// Save an uploaded file
let add upload = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query upInsert
|> Sql.parameters (upParams upload)
|> Sql.executeNonQueryAsync
()
}
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ]
let! tryPath =
Sql.existingConnection conn
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams
|> Sql.executeAsync (fun row -> row.string "path")
match List.tryHead tryPath with
| Some path ->
let! _ =
Sql.existingConnection conn
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|> Sql.parameters theParams
|> Sql.executeNonQueryAsync
return Ok path
| None -> return Error $"""Upload ID {UploadId.toString uploadId} not found"""
}
/// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask {
let! upload =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path"
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|> Sql.executeAsync (Map.toUpload true)
return List.tryHead upload
}
/// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload false)
/// Find all uploaded files for the given web log
let findByWebLogWithData webLogId =
Sql.existingConnection conn
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId"
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeAsync (Map.toUpload true)
/// Restore uploads from a backup
let restore uploads = backgroundTask {
for batch in uploads |> List.chunkBySize 5 do
let! _ =
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
upInsert, batch |> List.map upParams
]
()
}
interface IUploadData with
member _.Add upload = add upload
member _.Delete uploadId webLogId = delete uploadId webLogId
member _.FindByPath path webLogId = findByPath path webLogId
member _.FindByWebLog webLogId = findByWebLog webLogId
member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
member _.Restore uploads = restore uploads

326
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs Normal file
View File

@ -0,0 +1,326 @@
namespace MyWebLog.Data.PostgreSql
open MyWebLog
open MyWebLog.Data
open Npgsql
open Npgsql.FSharp
// The web log podcast insert loop is not statically compilable; this is OK
//#nowarn "3511"
/// PostgreSQL myWebLog web log data implementation
type PostgreSqlWebLogData (conn : NpgsqlConnection) =
// SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
] |> ignore
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) =
Sql.existingConnection conn
|> Sql.query """
SELECT f.*, p.*
FROM web_log_feed f
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
WHERE f.web_log_id = @webLogId"""
|> Sql.parameters [ webLogIdParam webLog.Id ]
|> Sql.executeAsync Map.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 INSERT statement for a podcast feed
let feedInsert = """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, apple_category,
apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid, funding_url, funding_text,
medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @appleCategory,
@appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @fundingUrl, @fundingText,
@medium
)"""
/// The parameters to save a podcast feed
let feedParams feedId (podcast : PodcastOptions) = [
"@feedId", Sql.string (CustomFeedId.toString feedId)
"@title", Sql.string podcast.Title
"@subtitle", Sql.stringOrNone podcast.Subtitle
"@itemsInFeed", Sql.int podcast.ItemsInFeed
"@summary", Sql.string podcast.Summary
"@displayedAuthor", Sql.string podcast.DisplayedAuthor
"@email", Sql.string podcast.Email
"@imageUrl", Sql.string (Permalink.toString podcast.ImageUrl)
"@appleCategory", Sql.string podcast.AppleCategory
"@appleSubcategory", Sql.stringOrNone podcast.AppleSubcategory
"@explicit", Sql.string (ExplicitRating.toString podcast.Explicit)
"@defaultMediaType", Sql.stringOrNone podcast.DefaultMediaType
"@mediaBaseUrl", Sql.stringOrNone podcast.MediaBaseUrl
"@podcastGuid", Sql.uuidOrNone podcast.PodcastGuid
"@fundingUrl", Sql.stringOrNone podcast.FundingUrl
"@fundingText", Sql.stringOrNone podcast.FundingText
"@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString)
]
/// Save a podcast for a custom feed
let savePodcast feedId (podcast : PodcastOptions) = backgroundTask {
let! _ =
Sql.existingConnection conn
|> Sql.query $"""
{feedInsert} ON CONFLICT (feed_id) DO UPDATE
SET title = EXCLUDED.title,
subtitle = EXCLUDED.subtitle,
items_in_feed = EXCLUDED.items_in_feed,
summary = EXCLUDED.summary,
displayed_author = EXCLUDED.displayed_author,
email = EXCLUDED.email,
image_url = EXCLUDED.image_url,
apple_category = EXCLUDED.apple_category,
apple_subcategory = EXCLUDED.apple_subcategory,
explicit = EXCLUDED.explicit,
default_media_type = EXCLUDED.default_media_type,
media_base_url = EXCLUDED.media_base_url,
podcast_guid = EXCLUDED.podcast_guid,
funding_url = EXCLUDED.funding_url,
funding_text = EXCLUDED.funding_text,
medium = EXCLUDED.medium"""
|> Sql.parameters (feedParams feedId podcast)
|> Sql.executeNonQueryAsync
()
}
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.Rss.CustomFeeds
|> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- """
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- """
INSERT INTO web_log_feed (
id, web_log_id, source, path
) VALUES (
@id, @webLogId, @source, @path
)"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
match it.Podcast with
| Some podcast -> do! addPodcast it.Id podcast
| None -> ()
})
|> Task.WhenAll
|> ignore
toUpdate
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- """
UPDATE web_log_feed
SET source = @source,
path = @path
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
match it.Podcast with
| Some podcast -> do! savePodcast it.Id podcast
| None ->
if hadPodcast then
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
cmd.Parameters.Clear ()
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
do! write cmd
else
()
})
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
do! updateCustomFeeds webLog
}
/// Retrieve all web logs
let all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log"
use! rdr = cmd.ExecuteReaderAsync ()
let! webLogs =
toList Map.toWebLog rdr
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|> Task.WhenAll
return List.ofArray webLogs
}
/// Delete a web log by its ID
let delete webLogId = backgroundTask {
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
let! _ =
Sql.existingConnection conn
|> Sql.query $"""
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post WHERE web_log_id = @webLogId;
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
DELETE FROM page WHERE web_log_id = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId;
DELETE FROM tag_map WHERE web_log_id = @webLogId;
DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"""
|> Sql.parameters [ webLogIdParam webLogId ]
|> Sql.executeNonQueryAsync
()
}
/// Find a web log by its host (URL base)
let findByHost (url : string) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
return Some webLog
else
return None
}
/// Find a web log by its ID
let findById webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
return Some webLog
else
return None
}
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogParameters cmd webLog
do! write cmd
}
/// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
do! write cmd
do! updateCustomFeeds webLog
}
interface IWebLogData with
member _.Add webLog = add webLog
member _.All () = all ()
member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId
member _.UpdateSettings webLog = updateSettings webLog
member _.UpdateRssOptions webLog = updateRssOptions webLog

11
src/MyWebLog.Data/PostgreSqlData.fs
View File

@ -11,9 +11,14 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
interface IData with
member _.Category = PostgreSqlCategoryData conn
member _.Page = PostgreSqlPageData conn
member _.Post = PostgreSqlPostData conn
member _.Category = PostgreSqlCategoryData conn
member _.Page = PostgreSqlPageData conn
member _.Post = PostgreSqlPostData conn
member _.TagMap = PostgreSqlTagMapData conn
member _.Theme = PostgreSqlThemeData conn
member _.ThemeAsset = PostgreSqlThemeAssetData conn
member _.Upload = PostgreSqlUploadData conn
member _.WebLog = PostgreSqlWebLogData conn
member _.StartUp () = backgroundTask {