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

v2 RC2 (#33)

Browse Source 
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
This commit was merged in pull request #33.
This commit is contained in:
Daniel J. Summers
2022-08-21 18:56:18 -04:00
committed by GitHub
parent 1ec664ad24
commit 5f3daa1de9
45 changed files with 3820 additions and 1306 deletions
Download Patch File Download Diff File Expand all files Collapse all files

218
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@@ -5,6 +5,8 @@ module MyWebLog.Data.SQLite.Helpers
open System
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open NodaTime.Text
/// Run a command that returns a count
let count (cmd : SqliteCommand) = backgroundTask {
@@ -12,23 +14,6 @@ let count (cmd : SqliteCommand) = backgroundTask {
return int (it :?> int64)
}
/// Get lists of items removed from and added to the given lists
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.Name}|{item.Value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.AsOf.Ticks}|{MarkupText.toString rev.Text}")
/// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
seq { while rdr.Read () do it rdr }
@@ -47,6 +32,42 @@ let write (cmd : SqliteCommand) = backgroundTask {
()
}
/// Add a possibly-missing parameter, substituting null for None
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
/// Create a value for a Duration
let durationParam =
DurationPattern.Roundtrip.Format
/// Create a value for an Instant
let instantParam =
InstantPattern.General.Format
/// Create an optional value for a Duration
let maybeDuration =
Option.map durationParam >> maybe
/// Create an optional value for an Instant
let maybeInstant =
Option.map instantParam >> maybe
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
items
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Functions to map domain items from a data reader
module Map =
@@ -73,6 +94,26 @@ module Map =
/// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
/// Parse a Duration from the given value
let parseDuration value =
match DurationPattern.Roundtrip.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get a Duration value from a data reader
let getDuration col rdr =
getString col rdr |> parseDuration
/// Parse an Instant from the given value
let parseInstant value =
match InstantPattern.General.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get an Instant value from a data reader
let getInstant col rdr =
getString col rdr |> parseInstant
/// Get a timespan value from a data reader
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
@@ -96,6 +137,14 @@ module Map =
let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader
let tryDuration col rdr =
tryString col rdr |> Option.map parseDuration
/// Get a possibly null Instant value from a data reader
let tryInstant col rdr =
tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
@@ -114,100 +163,57 @@ module Map =
}
/// Create a custom feed from the current row in the given data reader
let toCustomFeed rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Path = getString "path" rdr |> Permalink
Podcast =
if rdr.IsDBNull (rdr.GetOrdinal "title") then
None
else
Some {
Title = getString "title" rdr
Subtitle = tryString "subtitle" rdr
ItemsInFeed = getInt "items_in_feed" rdr
Summary = getString "summary" rdr
DisplayedAuthor = getString "displayed_author" rdr
Email = getString "email" rdr
ImageUrl = getString "image_url" rdr |> Permalink
AppleCategory = getString "apple_category" rdr
AppleSubcategory = tryString "apple_subcategory" rdr
Explicit = getString "explicit" rdr |> ExplicitRating.parse
DefaultMediaType = tryString "default_media_type" rdr
MediaBaseUrl = tryString "media_base_url" rdr
PodcastGuid = tryGuid "podcast_guid" rdr
FundingUrl = tryString "funding_url" rdr
FundingText = tryString "funding_text" rdr
Medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
}
}
/// Create a meta item from the current row in the given data reader
let toMetaItem rdr : MetaItem =
{ Name = getString "name" rdr
Value = getString "value" rdr
let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.parse
Path = getString "path" rdr |> Permalink
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
}
/// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a page from the current row in the given data reader
let toPage rdr : Page =
let toPage ser rdr : Page =
{ Page.empty with
Id = getString "id" rdr |> PageId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = getDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
PublishedOn = getInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
IsInPageList = getBoolean "is_in_page_list" rdr
Template = tryString "template" rdr
Text = getString "page_text" rdr
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a post from the current row in the given data reader
let toPost rdr : Post =
let toPost ser rdr : Post =
{ Post.empty with
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryDateTime "published_on" rdr
UpdatedOn = getDateTime "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode =
match tryString "media" rdr with
| Some media ->
Some {
Media = media
Length = getLong "length" rdr
Duration = tryTimeSpan "duration" rdr
MediaType = tryString "media_type" rdr
ImageUrl = tryString "image_url" rdr
Subtitle = tryString "subtitle" rdr
Explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
ChapterFile = tryString "chapter_file" rdr
ChapterType = tryString "chapter_type" rdr
TranscriptUrl = tryString "transcript_url" rdr
TranscriptType = tryString "transcript_type" rdr
TranscriptLang = tryString "transcript_lang" rdr
TranscriptCaptions = tryBoolean "transcript_captions" rdr
SeasonNumber = tryInt "season_number" rdr
SeasonDescription = tryString "season_description" rdr
EpisodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
EpisodeDescription = tryString "episode_description" rdr
}
| None -> None
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryInstant "published_on" rdr
UpdatedOn = getInstant "updated_on" rdr
Template = tryString "template" rdr
Text = getString "post_text" rdr
Episode = tryString "episode" rdr |> Option.map (Utils.deserialize ser)
Metadata = tryString "meta_items" rdr
|> Option.map (Utils.deserialize ser)
|> Option.defaultValue []
}
/// Create a revision from the current row in the given data reader
let toRevision rdr : Revision =
{ AsOf = getDateTime "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
{ AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
}
/// Create a tag mapping from the current row in the given data reader
@@ -237,7 +243,7 @@ module Map =
else
[||]
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getDateTime "updated_on" rdr
UpdatedOn = getInstant "updated_on" rdr
Data = assetData
}
@@ -257,10 +263,10 @@ module Map =
dataStream.ToArray ()
else
[||]
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getDateTime "updated_on" rdr
{ Id = getString "id" rdr |> UploadId
WebLogId = getString "web_log_id" rdr |> WebLogId
Path = getString "path" rdr |> Permalink
UpdatedOn = getInstant "updated_on" rdr
Data = data
}
@@ -290,23 +296,19 @@ module Map =
/// Create a web log user from the current row in the given data reader
let toWebLogUser rdr : WebLogUser =
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Salt = getGuid "salt" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getDateTime "created_on" rdr
LastSeenOn = tryDateTime "last_seen_on" rdr
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.parse
CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryInstant "last_seen_on" rdr
}
/// Add a possibly-missing parameter, substituting null for None
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
/// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore

73
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
View File

@@ -10,23 +10,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.WebLogId)
cmd.Parameters.AddWithValue ("@name", cat.Name)
cmd.Parameters.AddWithValue ("@slug", cat.Slug)
cmd.Parameters.AddWithValue ("@description", maybe cat.Description)
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
] |> ignore
/// Add a category
let add cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO category (
cmd.CommandText <-
"INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"""
)"
addCategoryParameters cmd cat
let! _ = cmd.ExecuteNonQueryAsync ()
()
@@ -68,24 +68,23 @@ type SQLiteCategoryData (conn : SqliteConnection) =
ordered
|> Seq.map (fun it -> backgroundTask {
// Parent category post counts include posts in subcategories
let catSql, catParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> inClause "AND pc.category_id" "catId" id
cmd.Parameters.Clear ()
addWebLogId cmd webLogId
cmd.CommandText <- """
cmd.Parameters.AddRange catParams
cmd.CommandText <- $"
SELECT COUNT(DISTINCT p.id)
FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = 'Published'
AND pc.category_id IN ("""
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.append (Seq.singleton it.Id)
|> Seq.iteri (fun idx item ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
{catSql}"
let! postCount = count cmd
return it.Id, postCount
})
@@ -133,19 +132,15 @@ type SQLiteCategoryData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@newParentId", maybe (cat.ParentId |> Option.map CategoryId.toString))
|> ignore
do! write cmd
// Delete the category off all posts where it is assigned
cmd.CommandText <- """
DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
// Delete the category off all posts where it is assigned, and the category itself
cmd.CommandText <-
"DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId);
DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear ()
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
do! write cmd
// Delete the category itself
cmd.CommandText <- "DELETE FROM category WHERE id = @id"
cmd.Parameters.Clear ()
cmd.Parameters.Add catIdParameter |> ignore
let _ = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
addWebLogId cmd webLogId
do! write cmd
return if children = 0 then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound
@@ -160,14 +155,14 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category
let update cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE category
SET name = @name,
slug = @slug,
description = @description,
parent_id = @parentId
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE category
SET name = @name,
slug = @slug,
description = @description,
parent_id = @parentId
WHERE id = @id
AND web_log_id = @webLogId"
addCategoryParameters cmd cat
do! write cmd
}

209
src/MyWebLog.Data/SQLite/SQLitePageData.fs
View File

@@ -4,35 +4,29 @@ open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog page data implementation
type SQLitePageData (conn : SqliteConnection) =
type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd : SqliteCommand) (page : Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", page.UpdatedOn)
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
cmd.Parameters.AddWithValue ("@template", maybe page.Template)
cmd.Parameters.AddWithValue ("@text", page.Text)
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty page.Metadata then None
else Some (Utils.serialize ser page.Metadata)))
] |> ignore
/// Append meta items to a page
let appendPageMeta (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return { page with Metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
@@ -48,47 +42,23 @@ type SQLitePageData (conn : SqliteConnection) =
return { page with Revisions = toList Map.toRevision rdr }
}
/// Return a page with no text (or meta items, prior permalinks, or revisions)
let pageWithoutTextOrMeta rdr =
{ Map.toPage rdr with Text = "" }
/// Shorthand for mapping a data reader to a page
let toPage =
Map.toPage ser
/// Update a page's metadata items
let updatePageMeta pageId oldItems newItems = backgroundTask {
let toDelete, toAdd = diffMetaItems oldItems newItems
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Return a page with no text (or prior permalinks or revisions)
let pageWithoutText rdr =
{ toPage rdr with Text = "" }
/// Update a page's prior permalinks
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.Add ("@link", SqliteType.Text)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
@@ -108,15 +78,15 @@ type SQLitePageData (conn : SqliteConnection) =
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
@@ -139,17 +109,16 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask {
use cmd = conn.CreateCommand ()
// The page itself
cmd.CommandText <- """
INSERT INTO page (
cmd.CommandText <-
"INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, is_in_page_list, template,
page_text
page_text, meta_items
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @isInPageList, @template,
@text
)"""
@text, @metaItems
)"
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.Id [] page.Metadata
do! updatePagePermalinks page.Id [] page.PriorPermalinks
do! updatePageRevisions page.Id [] page.Revisions
}
@@ -160,7 +129,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList pageWithoutTextOrMeta rdr
return toList pageWithoutText rdr
}
/// Count all pages for the given web log
@@ -174,11 +143,11 @@ type SQLitePageData (conn : SqliteConnection) =
/// Count all pages shown in the page list for the given web log
let countListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"""
cmd.CommandText <-
"SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
return! count cmd
@@ -190,11 +159,7 @@ type SQLitePageData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) Map.toPage rdr with
| Some page ->
let! page = appendPageMeta page
return Some page
| None -> return None
return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
}
/// Find a complete page by its ID
@@ -211,11 +176,10 @@ type SQLitePageData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.CommandText <- """
DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page_meta WHERE page_id = @id;
DELETE FROM page WHERE id = @id"""
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
DELETE FROM page WHERE id = @id"
do! write cmd
return true
| None -> return false
@@ -228,29 +192,21 @@ type SQLitePageData (conn : SqliteConnection) =
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! page = appendPageMeta (Map.toPage rdr)
return Some page
else
return None
return if rdr.Read () then Some (toPage rdr) else None
}
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId
AND pp.permalink IN ("""
permalinks
|> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
FROM page p
INNER JOIN page_permalink pp ON pp.page_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
@@ -262,11 +218,8 @@ type SQLitePageData (conn : SqliteConnection) =
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList Map.toPage rdr
|> List.map (fun page -> backgroundTask {
let! page = appendPageMeta page
return! appendPageRevisionsAndPermalinks page
})
toList toPage rdr
|> List.map (fun page -> backgroundTask { return! appendPageRevisionsAndPermalinks page })
|> Task.WhenAll
return List.ofArray pages
}
@@ -274,37 +227,33 @@ type SQLitePageData (conn : SqliteConnection) =
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
let findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"""
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
AND is_in_page_list = @isInPageList
ORDER BY LOWER(title)"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@isInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList pageWithoutTextOrMeta rdr
|> List.map (fun page -> backgroundTask { return! appendPageMeta page })
|> Task.WhenAll
return List.ofArray pages
return toList pageWithoutText rdr
}
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
let findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"""
cmd.CommandText <-
"SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@toSkip", (pageNbr - 1) * 25)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toPage rdr
return toList toPage rdr
}
/// Restore pages from a backup
@@ -318,21 +267,21 @@ type SQLitePageData (conn : SqliteConnection) =
match! findFullById page.Id page.WebLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
is_in_page_list = @isInPageList,
template = @template,
page_text = @text,
meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.Id oldPage.Metadata page.Metadata
do! updatePagePermalinks page.Id oldPage.PriorPermalinks page.PriorPermalinks
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
return ()

340
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@@ -1,53 +1,38 @@
namespace MyWebLog.Data.SQLite
open System
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
/// SQLite myWebLog post data implementation
type SQLitePostData (conn : SqliteConnection) =
type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybe post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
cmd.Parameters.AddWithValue ("@text", post.Text)
cmd.Parameters.AddWithValue ("@episode", maybe (if Option.isSome post.Episode then
Some (Utils.serialize ser post.Episode)
else None))
cmd.Parameters.AddWithValue ("@metaItems", maybe (if List.isEmpty post.Metadata then None
else Some (Utils.serialize ser post.Metadata)))
] |> ignore
/// Add parameters for episode INSERT or UPDATE statements
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
[ cmd.Parameters.AddWithValue ("@media", ep.Media)
cmd.Parameters.AddWithValue ("@length", ep.Length)
cmd.Parameters.AddWithValue ("@duration", maybe ep.Duration)
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.MediaType)
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.ImageUrl)
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.Subtitle)
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.Explicit |> Option.map ExplicitRating.toString))
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.ChapterFile)
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.ChapterType)
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.TranscriptUrl)
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.TranscriptType)
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.TranscriptLang)
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.TranscriptCaptions)
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.SeasonNumber)
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.SeasonDescription)
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.EpisodeNumber |> Option.map string))
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.EpisodeDescription)
] |> ignore
/// Append category IDs, tags, and meta items to a post
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
/// Append category IDs and tags to a post
let appendPostCategoryAndTag (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
@@ -58,12 +43,7 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
let post = { post with Tags = toList (Map.getString "tag") rdr }
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with Metadata = toList Map.toMetaItem rdr }
return { post with Tags = toList (Map.getString "tag") rdr }
}
/// Append revisions and permalinks to a post
@@ -82,7 +62,11 @@ type SQLitePostData (conn : SqliteConnection) =
}
/// The SELECT statement for a post that will include episode data, if it exists
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
let selectPost = "SELECT p.* FROM post p"
/// Shorthand for mapping a data reader to a post
let toPost =
Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById postId webLogId = backgroundTask {
@@ -90,22 +74,22 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) Map.toPost rdr
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText rdr =
{ Map.toPost rdr with Text = "" }
{ toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore
let runCmd catId = backgroundTask {
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
@@ -125,13 +109,13 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post's assigned categories
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
let toDelete, toAdd = diffLists oldTags newTags id
let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@tag", SqliteType.Text)
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore
let runCmd (tag : string) = backgroundTask {
cmd.Parameters["@tag"].Value <- tag
@@ -149,95 +133,15 @@ type SQLitePostData (conn : SqliteConnection) =
|> ignore
}
/// Update an episode
let updatePostEpisode (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
let! count = count cmd
if count = 1 then
match post.Episode with
| Some ep ->
cmd.CommandText <- """
UPDATE post_episode
SET media = @media,
length = @length,
duration = @duration,
media_type = @mediaType,
image_url = @imageUrl,
subtitle = @subtitle,
explicit = @explicit,
chapter_file = @chapterFile,
chapter_type = @chapterType,
transcript_url = @transcriptUrl,
transcript_type = @transcriptType,
transcript_lang = @transcriptLang,
transcript_captions = @transcriptCaptions,
season_number = @seasonNumber,
season_description = @seasonDescription,
episode_number = @episodeNumber,
episode_description = @episodeDescription
WHERE post_id = @postId"""
addEpisodeParameters cmd ep
do! write cmd
| None ->
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
do! write cmd
else
match post.Episode with
| Some ep ->
cmd.CommandText <- """
INSERT INTO post_episode (
post_id, media, length, duration, media_type, image_url, subtitle, explicit, chapter_file,
chapter_type, transcript_url, transcript_type, transcript_lang, transcript_captions,
season_number, season_description, episode_number, episode_description
) VALUES (
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)"""
addEpisodeParameters cmd ep
do! write cmd
| None -> ()
}
/// Update a post's metadata items
let updatePostMeta postId oldItems newItems = backgroundTask {
let toDelete, toAdd = diffMetaItems oldItems newItems
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@value", SqliteType.Text)
] |> ignore
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters["@name" ].Value <- item.Name
cmd.Parameters["@value"].Value <- item.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's prior permalinks
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@link", SqliteType.Text)
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
@@ -257,15 +161,15 @@ type SQLitePostData (conn : SqliteConnection) =
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.AsOf)
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
do! write cmd
@@ -287,18 +191,18 @@ type SQLitePostData (conn : SqliteConnection) =
/// Add a post
let add post = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
cmd.CommandText <-
"INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text,
episode, meta_items
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
)"""
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text,
@episode, @metaItems
)"
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.Id [] post.CategoryIds
do! updatePostTags post.Id [] post.Tags
do! updatePostEpisode post
do! updatePostMeta post.Id [] post.Metadata
do! updatePostPermalinks post.Id [] post.PriorPermalinks
do! updatePostRevisions post.Id [] post.Revisions
}
@@ -316,7 +220,7 @@ type SQLitePostData (conn : SqliteConnection) =
let findById postId webLogId = backgroundTask {
match! findPostById postId webLogId with
| Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostCategoryAndTag post
return Some post
| None -> return None
}
@@ -329,7 +233,7 @@ type SQLitePostData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (Map.toPost rdr)
let! post = appendPostCategoryAndTag (toPost rdr)
return Some post
else
return None
@@ -350,14 +254,13 @@ type SQLitePostData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.CommandText <- """
DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_meta WHERE post_id = @id;
DELETE FROM post_episode WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post WHERE id = @id"""
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
DELETE FROM post_tag WHERE post_id = @id;
DELETE FROM post_category WHERE post_id = @id;
DELETE FROM post_comment WHERE post_id = @id;
DELETE FROM post WHERE id = @id"
do! write cmd
return true
| None -> return false
@@ -366,19 +269,15 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
AND pp.permalink IN ("""
permalinks
|> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
{linkSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange linkParams
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
@@ -390,9 +289,9 @@ type SQLitePostData (conn : SqliteConnection) =
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
toList toPost rdr
|> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostCategoryAndTag post
return! appendPostRevisionsAndPermalinks post
})
|> Task.WhenAll
@@ -402,27 +301,22 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"""
let catSql, catParams = inClause "AND pc.category_id" "catId" CategoryId.toString categoryIds
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pc.category_id IN ("""
categoryIds
|> List.iteri (fun idx catId ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
cmd.CommandText <-
$"""{cmd.CommandText})
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
{catSql}
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
@@ -430,16 +324,16 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"""
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
WHERE p.web_log_id = @webLogId
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
@@ -447,18 +341,18 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"""
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
@@ -466,60 +360,60 @@ type SQLitePostData (conn : SqliteConnection) =
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"""
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pt.tag = @tag
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pt.tag = @tag
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
toList toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryAndTag post })
|> Task.WhenAll
return List.ofArray posts
}
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"""
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on < @publishedOn
ORDER BY p.published_on DESC
LIMIT 1"""
LIMIT 1"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
}
do! rdr.CloseAsync ()
cmd.CommandText <- $"""
cmd.CommandText <- $"
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on > @publishedOn
ORDER BY p.published_on
LIMIT 1"""
LIMIT 1"
use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask {
if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
let! post = appendPostCategoryAndTag (postWithoutText rdr)
return Some post
else
return None
@@ -538,24 +432,24 @@ type SQLitePostData (conn : SqliteConnection) =
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
template = @template,
post_text = @text
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
template = @template,
post_text = @text,
episode = @episode,
meta_items = @metaItems
WHERE id = @id
AND web_log_id = @webLogId"
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.Id oldPost.CategoryIds post.CategoryIds
do! updatePostTags post.Id oldPost.Tags post.Tags
do! updatePostEpisode post
do! updatePostMeta post.Id oldPost.Metadata post.Metadata
do! updatePostPermalinks post.Id oldPost.PriorPermalinks post.PriorPermalinks
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> return ()

40
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
View File

@@ -50,18 +50,14 @@ type SQLiteTagMapData (conn : SqliteConnection) =
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags : string list) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
let mapSql, mapParams = inClause "AND tag" "tag" id tags
cmd.CommandText <- $"
SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
AND tag IN ("""
tags
|> List.iteri (fun idx tag ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
FROM tag_map
WHERE web_log_id = @webLogId
{mapSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange mapParams
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
@@ -71,23 +67,23 @@ type SQLiteTagMapData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
match! findById tagMap.Id tagMap.WebLogId with
| Some _ ->
cmd.CommandText <- """
UPDATE tag_map
SET tag = @tag,
url_value = @urlValue
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE tag_map
SET tag = @tag,
url_value = @urlValue
WHERE id = @id
AND web_log_id = @webLogId"
| None ->
cmd.CommandText <- """
INSERT INTO tag_map (
cmd.CommandText <-
"INSERT INTO tag_map (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"""
)"
addWebLogId cmd tagMap.WebLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.Id)
cmd.Parameters.AddWithValue ("@tag", tagMap.Tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.UrlValue)
] |> ignore
do! write cmd
}

68
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
View File

@@ -17,13 +17,13 @@ type SQLiteThemeData (conn : SqliteConnection) =
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
use! rdr = cmd.ExecuteReaderAsync ()
let mutable templates = []
while rdr.Read () do
templates <- (ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr) :: templates
let templates =
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|> List.ofSeq
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
}
/// Does a given theme exist?
@@ -67,10 +67,10 @@ type SQLiteThemeData (conn : SqliteConnection) =
match! findByIdWithoutText themeId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"""
cmd.CommandText <-
"DELETE FROM theme_asset WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id;
DELETE FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
do! write cmd
return true
@@ -85,15 +85,15 @@ type SQLiteThemeData (conn : SqliteConnection) =
match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore
do! write cmd
let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
theme.Templates (fun t -> t.Name)
let toUpdate =
theme.Templates
|> List.filter (fun t ->
@@ -102,9 +102,9 @@ type SQLiteThemeData (conn : SqliteConnection) =
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text)
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore
toUpdate
|> List.map (fun template -> backgroundTask {
@@ -169,8 +169,8 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = assetId
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
@@ -200,29 +200,29 @@ type SQLiteThemeAssetData (conn : SqliteConnection) =
sideCmd.CommandText <-
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path)
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path)
] |> ignore
let! exists = count sideCmd
use cmd = conn.CreateCommand ()
cmd.CommandText <-
if exists = 1 then
"""UPDATE theme_asset
SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId
AND path = @path"""
"UPDATE theme_asset
SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId
AND path = @path"
else
"""INSERT INTO theme_asset (
theme_id, path, updated_on, data
) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)"""
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
"INSERT INTO theme_asset (
theme_id, path, updated_on, data
) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)"
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
] |> ignore
do! write cmd

24
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
View File

@@ -10,22 +10,22 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", upload.UpdatedOn)
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore
/// Save an uploaded file
let add upload = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO upload (
cmd.CommandText <-
"INSERT INTO upload (
id, web_log_id, path, updated_on, data
) VALUES (
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
)"""
)"
addUploadParameters cmd upload
do! write cmd
@@ -40,11 +40,11 @@ type SQLiteUploadData (conn : SqliteConnection) =
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT id, web_log_id, path, updated_on
FROM upload
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"SELECT id, web_log_id, path, updated_on
FROM upload
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()

258
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@@ -4,81 +4,64 @@ open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
// The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511"
/// SQLite myWebLog web log data implementation
type SQLiteWebLogData (conn : SqliteConnection) =
type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
// SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (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 ("@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)
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 (cmd : SqliteCommand) (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 ("@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)
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 ("@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)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))
] |> ignore
/// Add parameters for podcast INSERT or UPDATE statements
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
cmd.Parameters.AddWithValue ("@title", podcast.Title)
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.Subtitle)
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.ItemsInFeed)
cmd.Parameters.AddWithValue ("@summary", podcast.Summary)
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.DisplayedAuthor)
cmd.Parameters.AddWithValue ("@email", podcast.Email)
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.ImageUrl)
cmd.Parameters.AddWithValue ("@appleCategory", podcast.AppleCategory)
cmd.Parameters.AddWithValue ("@appleSubcategory", maybe podcast.AppleSubcategory)
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.Explicit)
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.DefaultMediaType)
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.MediaBaseUrl)
cmd.Parameters.AddWithValue ("@podcastGuid", maybe podcast.PodcastGuid)
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.FundingUrl)
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.FundingText)
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.Medium |> Option.map PodcastMedium.toString))
] |> ignore
/// Shorthand to map a data reader to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
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"""
cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr
return toList toCustomFeed rdr
}
/// Append custom feeds to a web log
@@ -87,27 +70,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// Add a podcast to a custom feed
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
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
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
}
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
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
@@ -117,9 +83,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
do! write cmd
})
@@ -128,68 +92,30 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- """
INSERT INTO web_log_feed (
id, web_log_id, source, path
cmd.CommandText <-
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path
)"""
@id, @webLogId, @source, @path, @podcast
)"
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.CommandText <-
"UPDATE web_log_feed
SET source = @source,
path = @path,
podcast = @podcast
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 ->
if hadPodcast then
cmd.CommandText <- """
UPDATE web_log_feed_podcast
SET title = @title,
subtitle = @subtitle,
items_in_feed = @itemsInFeed,
summary = @summary,
displayed_author = @displayedAuthor,
email = @email,
image_url = @imageUrl,
apple_category = @appleCategory,
apple_subcategory = @appleSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
podcast_guid = @podcastGuid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
cmd.Parameters.Clear ()
addPodcastParameters cmd it.Id podcast
do! write cmd
else
do! addPodcast 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
@@ -200,14 +126,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO web_log (
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
@@ -232,26 +158,22 @@ type SQLiteWebLogData (conn : SqliteConnection) =
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
cmd.CommandText <- $"""
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
DELETE FROM post_episode WHERE post_id IN {postSubQuery};
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
DELETE FROM post_category WHERE post_id IN {postSubQuery};
DELETE FROM post_meta 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_permalink WHERE page_id IN {pageSubQuery};
DELETE FROM page_meta 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"""
cmd.CommandText <- $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
DELETE FROM post_tag 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_permalink 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 WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"
do! write cmd
}
@@ -284,25 +206,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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"""
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
}
@@ -310,15 +232,15 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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"""
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

83
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View File

@@ -1,6 +1,5 @@
namespace MyWebLog.Data.SQLite
open System
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
@@ -12,18 +11,17 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add parameters for web log user INSERT or UPDATE statements
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.WebLogId)
cmd.Parameters.AddWithValue ("@email", user.Email)
cmd.Parameters.AddWithValue ("@firstName", user.FirstName)
cmd.Parameters.AddWithValue ("@lastName", user.LastName)
cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@salt", user.Salt)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybe user.LastSeenOn)
cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash)
cmd.Parameters.AddWithValue ("@url", maybe user.Url)
cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.AccessLevel)
cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn)
cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn)
] |> ignore
// IMPLEMENTATION FUNCTIONS
@@ -31,14 +29,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Add a user
let add user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, salt, url, access_level,
cmd.CommandText <-
"INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, @accessLevel,
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
@createdOn, @lastSeenOn
)"""
)"
addWebLogUserParameters cmd user
do! write cmd
}
@@ -93,14 +91,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
userIds
|> List.iteri (fun idx userId ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
let nameSql, nameParams = inClause "AND id" "id" WebLogUserId.toString userIds
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync ()
return
toList Map.toWebLogUser rdr
@@ -116,14 +110,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log_user
SET last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE web_log_user
SET last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", DateTime.UtcNow)
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId)
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()
@@ -132,20 +126,19 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Update a user
let update user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
UPDATE web_log_user
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
salt = @salt,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.CommandText <-
"UPDATE web_log_user
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogUserParameters cmd user
do! write cmd
}