v2 RC2 #33
|
@ -36,6 +36,9 @@
|
||||||
<Compile Include="PostgreSql\PostgreSqlPageData.fs" />
|
<Compile Include="PostgreSql\PostgreSqlPageData.fs" />
|
||||||
<Compile Include="PostgreSql\PostgreSqlPostData.fs" />
|
<Compile Include="PostgreSql\PostgreSqlPostData.fs" />
|
||||||
<Compile Include="PostgreSql\PostgreSqlTagMapData.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" />
|
<Compile Include="PostgreSqlData.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
|
|
|
@ -117,35 +117,47 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
|
||||||
| None -> return CategoryNotFound
|
| None -> return CategoryNotFound
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Update a category
|
/// The INSERT statement for a category
|
||||||
let save (cat : Category) = backgroundTask {
|
let catInsert = """
|
||||||
let! _ =
|
|
||||||
Sql.existingConnection conn
|
|
||||||
|> Sql.query """
|
|
||||||
INSERT INTO category (
|
INSERT INTO category (
|
||||||
id, web_log_id, name, slug, description, parent_id
|
id, web_log_id, name, slug, description, parent_id
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @name, @slug, @description, @parentId
|
@id, @webLogId, @name, @slug, @description, @parentId
|
||||||
) ON CONFLICT (id) DO UPDATE
|
)"""
|
||||||
SET name = EXCLUDED.name,
|
|
||||||
slug = EXCLUDED.slug,
|
/// Create parameters for a category insert / update
|
||||||
description = EXCLUDED.description,
|
let catParameters (cat : Category) = [
|
||||||
parent_id = EXCLUDED.parent_id"""
|
webLogIdParam cat.WebLogId
|
||||||
|> Sql.parameters
|
|
||||||
[ webLogIdParam cat.WebLogId
|
|
||||||
"@id", Sql.string (CategoryId.toString cat.Id)
|
"@id", Sql.string (CategoryId.toString cat.Id)
|
||||||
"@name", Sql.string cat.Name
|
"@name", Sql.string cat.Name
|
||||||
"@slug", Sql.string cat.Slug
|
"@slug", Sql.string cat.Slug
|
||||||
"@description", Sql.stringOrNone cat.Description
|
"@description", Sql.stringOrNone cat.Description
|
||||||
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ]
|
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
|
||||||
|
]
|
||||||
|
|
||||||
|
/// Save a category
|
||||||
|
let save cat = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
Sql.existingConnection conn
|
||||||
|
|> Sql.query $"""
|
||||||
|
{catInsert} ON CONFLICT (id) DO UPDATE
|
||||||
|
SET name = EXCLUDED.name,
|
||||||
|
slug = EXCLUDED.slug,
|
||||||
|
description = EXCLUDED.description,
|
||||||
|
parent_id = EXCLUDED.parent_id"""
|
||||||
|
|> Sql.parameters (catParameters cat)
|
||||||
|> Sql.executeNonQueryAsync
|
|> Sql.executeNonQueryAsync
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Restore categories from a backup
|
/// Restore categories from a backup
|
||||||
let restore cats = backgroundTask {
|
let restore cats = backgroundTask {
|
||||||
for cat in cats do
|
let! _ =
|
||||||
do! save cat
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
catInsert, cats |> List.map catParameters
|
||||||
|
]
|
||||||
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
interface ICategoryData with
|
interface ICategoryData with
|
||||||
|
|
|
@ -57,6 +57,39 @@ module Map =
|
||||||
let toCount (row : RowReader) =
|
let toCount (row : RowReader) =
|
||||||
row.int "the_count"
|
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
|
/// Create a meta item from the current row
|
||||||
let toMetaItem (row : RowReader) : MetaItem =
|
let toMetaItem (row : RowReader) : MetaItem =
|
||||||
{ Name = row.string "name"
|
{ Name = row.string "name"
|
||||||
|
@ -118,10 +151,65 @@ module Map =
|
||||||
Text = row.string "revision_text" |> MarkupText.parse
|
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 =
|
let toTagMap (row : RowReader) : TagMap =
|
||||||
{ Id = row.string "id" |> TagMapId
|
{ Id = row.string "id" |> TagMapId
|
||||||
WebLogId = row.string "web_log_id" |> WebLogId
|
WebLogId = row.string "web_log_id" |> WebLogId
|
||||||
Tag = row.string "tag"
|
Tag = row.string "tag"
|
||||||
UrlValue = row.string "url_value"
|
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 = []
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
@ -25,6 +25,16 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||||
let pageWithoutText row =
|
let pageWithoutText row =
|
||||||
{ Map.toPage row with Text = "" }
|
{ 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
|
/// Update a page's revisions
|
||||||
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
||||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
|
@ -40,13 +50,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||||
"@asOf", Sql.timestamptz it.AsOf
|
"@asOf", Sql.timestamptz it.AsOf
|
||||||
])
|
])
|
||||||
if not (List.isEmpty toAdd) then
|
if not (List.isEmpty toAdd) then
|
||||||
"INSERT INTO page_revision VALUES (@pageId, @asOf, @text)",
|
revInsert, toAdd |> List.map (revParams pageId)
|
||||||
toAdd
|
|
||||||
|> List.map (fun it -> [
|
|
||||||
"@pageId", Sql.string (PageId.toString pageId)
|
|
||||||
"@asOf", Sql.timestamptz it.AsOf
|
|
||||||
"@text", Sql.string (MarkupText.toString it.Text)
|
|
||||||
])
|
|
||||||
]
|
]
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
@ -173,31 +177,19 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||||
|> 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 Map.toPage
|
|> Sql.executeAsync Map.toPage
|
||||||
|
|
||||||
/// Save a page
|
/// The INSERT statement for a page
|
||||||
let save (page : Page) = backgroundTask {
|
let pageInsert = """
|
||||||
let! oldPage = findFullById page.Id page.WebLogId
|
|
||||||
let! _ =
|
|
||||||
Sql.existingConnection conn
|
|
||||||
|> Sql.query """
|
|
||||||
INSERT INTO page (
|
INSERT INTO page (
|
||||||
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on,
|
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
|
||||||
is_in_page_list, template, page_text, meta_items
|
template, page_text, meta_items
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
|
||||||
@isInPageList, @template, @text, @metaItems
|
@template, @text, @metaItems
|
||||||
) ON CONFLICT (id) DO UPDATE
|
)"""
|
||||||
SET author_id = EXCLUDED.author_id,
|
|
||||||
title = EXCLUDED.title,
|
/// The parameters for saving a page
|
||||||
permalink = EXCLUDED.permalink,
|
let pageParams (page : Page) = [
|
||||||
prior_permalinks = EXCLUDED.prior_permalinks,
|
webLogIdParam page.WebLogId
|
||||||
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.text,
|
|
||||||
meta_items = EXCLUDED.meta_items"""
|
|
||||||
|> Sql.parameters
|
|
||||||
[ webLogIdParam page.WebLogId
|
|
||||||
"@id", Sql.string (PageId.toString page.Id)
|
"@id", Sql.string (PageId.toString page.Id)
|
||||||
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
|
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
|
||||||
"@title", Sql.string page.Title
|
"@title", Sql.string page.Title
|
||||||
|
@ -208,17 +200,42 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||||
"@template", Sql.stringOrNone page.Template
|
"@template", Sql.stringOrNone page.Template
|
||||||
"@text", Sql.string page.Text
|
"@text", Sql.string page.Text
|
||||||
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
|
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
|
||||||
"@priorPermalinks",
|
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
|
||||||
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 $"""
|
||||||
|
{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.text,
|
||||||
|
meta_items = EXCLUDED.meta_items"""
|
||||||
|
|> Sql.parameters (pageParams page)
|
||||||
|> Sql.executeNonQueryAsync
|
|> 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
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Restore pages from a backup
|
/// Restore pages from a backup
|
||||||
let restore pages = backgroundTask {
|
let restore (pages : Page list) = backgroundTask {
|
||||||
for page in pages do
|
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
||||||
do! save page
|
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
|
/// Update a page's prior permalinks
|
||||||
|
|
|
@ -31,28 +31,41 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||||
let postWithoutText row =
|
let postWithoutText row =
|
||||||
{ Map.toPost row with Text = "" }
|
{ 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
|
/// Update a post's assigned categories
|
||||||
let updatePostCategories postId oldCats newCats = backgroundTask {
|
let updatePostCategories postId oldCats newCats = backgroundTask {
|
||||||
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
|
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
|
||||||
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
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! _ =
|
let! _ =
|
||||||
Sql.existingConnection conn
|
Sql.existingConnection conn
|
||||||
|> Sql.executeTransactionAsync [
|
|> Sql.executeTransactionAsync [
|
||||||
if not (List.isEmpty toDelete) then
|
if not (List.isEmpty toDelete) then
|
||||||
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
|
"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
|
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
|
/// Update a post's revisions
|
||||||
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
||||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||||
|
@ -68,13 +81,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||||
"@asOf", Sql.timestamptz it.AsOf
|
"@asOf", Sql.timestamptz it.AsOf
|
||||||
])
|
])
|
||||||
if not (List.isEmpty toAdd) then
|
if not (List.isEmpty toAdd) then
|
||||||
"INSERT INTO post_revision VALUES (@postId, @asOf, @text)",
|
revInsert, toAdd |> List.map (revParams postId)
|
||||||
toAdd
|
|
||||||
|> List.map (fun it -> [
|
|
||||||
"@postId", Sql.string (PostId.toString postId)
|
|
||||||
"@asOf", Sql.timestamptz it.AsOf
|
|
||||||
"@text", Sql.string (MarkupText.toString it.Text)
|
|
||||||
])
|
|
||||||
]
|
]
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
@ -259,19 +266,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||||
return List.tryHead older, List.tryHead newer
|
return List.tryHead older, List.tryHead newer
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Save a post
|
/// The INSERT statement for a post
|
||||||
let save (post : Post) = backgroundTask {
|
let postInsert = """
|
||||||
let! oldPost = findFullById post.Id post.WebLogId
|
|
||||||
let! _ =
|
|
||||||
Sql.existingConnection conn
|
|
||||||
|> Sql.query """
|
|
||||||
INSERT INTO post (
|
INSERT INTO post (
|
||||||
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
|
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
|
||||||
template, post_text, tags, meta_items, episode
|
template, post_text, tags, meta_items, episode
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
||||||
@template, @text, @tags, @metaItems, @episode
|
@template, @text, @tags, @metaItems, @episode
|
||||||
) ON CONFLICT (id) DO UPDATE
|
)"""
|
||||||
|
|
||||||
|
/// 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 $"""
|
||||||
|
{postInsert} ON CONFLICT (id) DO UPDATE
|
||||||
SET author_id = EXCLUDED.author_id,
|
SET author_id = EXCLUDED.author_id,
|
||||||
status = EXCLUDED.status,
|
status = EXCLUDED.status,
|
||||||
title = EXCLUDED.title,
|
title = EXCLUDED.title,
|
||||||
|
@ -284,26 +315,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||||
tags = EXCLUDED.tags,
|
tags = EXCLUDED.tags,
|
||||||
meta_items = EXCLUDED.meta_items,
|
meta_items = EXCLUDED.meta_items,
|
||||||
episode = EXCLUDED.episode"""
|
episode = EXCLUDED.episode"""
|
||||||
|> Sql.parameters
|
|> Sql.parameters (postParams 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
|
|
||||||
]
|
|
||||||
|> Sql.executeNonQueryAsync
|
|> Sql.executeNonQueryAsync
|
||||||
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
|
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
|
||||||
|
@ -311,8 +323,16 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||||
|
|
||||||
/// Restore posts from a backup
|
/// Restore posts from a backup
|
||||||
let restore posts = backgroundTask {
|
let restore posts = backgroundTask {
|
||||||
for post in posts do
|
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c))
|
||||||
do! save post
|
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
|
/// Update prior permalinks for a post
|
||||||
|
|
|
@ -56,32 +56,43 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) =
|
||||||
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|
||||||
|> Sql.executeAsync Map.toTagMap
|
|> Sql.executeAsync Map.toTagMap
|
||||||
|
|
||||||
/// Save a tag mapping
|
/// The INSERT statement for a tag mapping
|
||||||
let save (tagMap : TagMap) = backgroundTask {
|
let tagMapInsert = """
|
||||||
let! _ =
|
|
||||||
Sql.existingConnection conn
|
|
||||||
|> Sql.query """
|
|
||||||
INSERT INTO tag_map (
|
INSERT INTO tag_map (
|
||||||
id, web_log_id, tag, url_value
|
id, web_log_id, tag, url_value
|
||||||
) VALUES (
|
) VALUES (
|
||||||
@id, @webLogId, @tag, @urlValue
|
@id, @webLogId, @tag, @urlValue
|
||||||
) ON CONFLICT (id) DO UPDATE
|
)"""
|
||||||
SET tag = EXCLUDED.tag,
|
|
||||||
url_value = EXCLUDED.url_value"""
|
/// The parameters for saving a tag mapping
|
||||||
|> Sql.parameters
|
let tagMapParams (tagMap : TagMap) = [
|
||||||
[ webLogIdParam tagMap.WebLogId
|
webLogIdParam tagMap.WebLogId
|
||||||
"@id", Sql.string (TagMapId.toString tagMap.Id)
|
"@id", Sql.string (TagMapId.toString tagMap.Id)
|
||||||
"@tag", Sql.string tagMap.Tag
|
"@tag", Sql.string tagMap.Tag
|
||||||
"@urlValue", Sql.string tagMap.UrlValue
|
"@urlValue", Sql.string tagMap.UrlValue
|
||||||
]
|
]
|
||||||
|
|
||||||
|
/// Save a tag mapping
|
||||||
|
let save tagMap = backgroundTask {
|
||||||
|
let! _ =
|
||||||
|
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
|
|> Sql.executeNonQueryAsync
|
||||||
()
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Restore tag mappings from a backup
|
/// Restore tag mappings from a backup
|
||||||
let restore tagMaps = backgroundTask {
|
let restore tagMaps = backgroundTask {
|
||||||
for tagMap in tagMaps do
|
let! _ =
|
||||||
do! save tagMap
|
Sql.existingConnection conn
|
||||||
|
|> Sql.executeTransactionAsync [
|
||||||
|
tagMapInsert, tagMaps |> List.map tagMapParams
|
||||||
|
]
|
||||||
|
()
|
||||||
}
|
}
|
||||||
|
|
||||||
interface ITagMapData with
|
interface ITagMapData with
|
||||||
|
|
204
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
Normal file
204
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
Normal 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
99
src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
Normal 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
326
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
Normal 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
|
|
@ -14,6 +14,11 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
|
||||||
member _.Category = PostgreSqlCategoryData conn
|
member _.Category = PostgreSqlCategoryData conn
|
||||||
member _.Page = PostgreSqlPageData conn
|
member _.Page = PostgreSqlPageData conn
|
||||||
member _.Post = PostgreSqlPostData 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 {
|
member _.StartUp () = backgroundTask {
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user