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

WIP on uploads (#2)

Browse Source 
- Add data types and fields
- Implement in both RethinkDB and SQLite
- Add uploads to backup/restore
- Add empty upload folder to project
- Add indexes to SQLite tables (#15)
This commit is contained in:
Daniel J. Summers 2022-06-28 17:34:18 -04:00
parent 46bd785a1f
commit c29bbc04ac
20 changed files with 800 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/MyWebLog.Data/Converters.fs
View File

@ -99,7 +99,21 @@ module Json =
writer.WriteValue (ThemeId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
(string >> ThemeId) reader.Value
type UploadDestinationConverter () =
inherit JsonConverter<UploadDestination> ()
override _.WriteJson (writer : JsonWriter, value : UploadDestination, _ : JsonSerializer) =
writer.WriteValue (UploadDestination.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadDestination, _ : bool, _ : JsonSerializer) =
(string >> UploadDestination.parse) reader.Value
type UploadIdConverter () =
inherit JsonConverter<UploadId> ()
override _.WriteJson (writer : JsonWriter, value : UploadId, _ : JsonSerializer) =
writer.WriteValue (UploadId.toString value)
override _.ReadJson (reader : JsonReader, _ : Type, _ : UploadId, _ : bool, _ : JsonSerializer) =
(string >> UploadId) reader.Value
type WebLogIdConverter () =
inherit JsonConverter<WebLogId> ()
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
@ -120,21 +134,23 @@ module Json =
let all () : JsonConverter seq =
seq {
// Our converters
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
CategoryIdConverter ()
CommentIdConverter ()
CustomFeedIdConverter ()
CustomFeedSourceConverter ()
ExplicitRatingConverter ()
MarkupTextConverter ()
PermalinkConverter ()
PageIdConverter ()
PodcastMediumConverter ()
PostIdConverter ()
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields
CompactUnionJsonConverter ()
CompactUnionJsonConverter ()
}

19
src/MyWebLog.Data/Interfaces.fs
View File

@ -199,6 +199,22 @@ type IThemeAssetData =
abstract member save : ThemeAsset -> Task<unit>
/// Functions to manipulate uploaded files
type IUploadData =
/// Add an uploaded file
abstract member add : Upload -> Task<unit>
/// Find an uploaded file by its path for the given web log
abstract member findByPath : string -> WebLogId -> Task<Upload option>
/// Find all uploaded files for a web log
abstract member findByWebLog : WebLogId -> Task<Upload list>
/// Restore uploaded files from a backup
abstract member restore : Upload list -> Task<unit>
/// Functions to manipulate web logs
type IWebLogData =
@ -270,6 +286,9 @@ type IData =
/// Theme asset data functions
abstract member ThemeAsset : IThemeAssetData
/// Uploaded file functions
abstract member Upload : IUploadData
/// Web log data functions
abstract member WebLog : IWebLogData

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

@ -31,6 +31,7 @@
<Compile Include="SQLite\SQLitePostData.fs" />
<Compile Include="SQLite\SQLiteTagMapData.fs" />
<Compile Include="SQLite\SQLiteThemeData.fs" />
<Compile Include="SQLite\SQLiteUploadData.fs" />
<Compile Include="SQLite\SQLiteWebLogData.fs" />
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
<Compile Include="SQLiteData.fs" />

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

@ -33,6 +33,9 @@ module private RethinkHelpers =
/// The theme asset table
let ThemeAsset = "ThemeAsset"
/// The uploaded file table
let Upload = "Upload"
/// The web log table
let WebLog = "WebLog"
@ -40,7 +43,7 @@ module private RethinkHelpers =
let WebLogUser = "WebLogUser"
/// A list of all tables
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ]
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; Upload; WebLog; WebLogUser ]
/// Shorthand for the ReQL starting point
@ -125,6 +128,15 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Uploaded files need an index by web log ID and path, as that is how they are retrieved
if Table.Upload = table then
if not (indexes |> List.contains "webLogAndPath") then
log.LogInformation $"Creating index {table}.webLogAndPath..."
do! rethink {
withTable table
indexCreate "webLogAndPath" (fun row -> r.Array (row["webLogId"], row["path"]) :> obj)
write; withRetryOnce; ignoreResult conn
}
// Users log on with e-mail
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
log.LogInformation $"Creating index {table}.logOn..."
@ -725,6 +737,41 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
}
member _.Upload = {
new IUploadData with
member _.add upload = rethink {
withTable Table.Upload
insert upload
write; withRetryDefault; ignoreResult conn
}
member _.findByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
getAll [ r.Array (path, webLogId) ] "webLogAndPath"
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn
member _.findByWebLog webLogId = rethink<Upload> {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
resultCursor; withRetryCursorDefault; toList conn
}
member _.restore uploads = backgroundTask {
// Files can be large; we'll do 5 at a time
for batch in uploads |> List.chunkBySize 5 do
do! rethink {
withTable Table.TagMap
insert batch
write; withRetryOnce; ignoreResult conn
}
}
}
member _.WebLog = {
new IWebLogData with
@ -763,6 +810,14 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryOnce; ignoreResult conn
}
// Uploaded files do not have a straightforward webLogId index
do! rethink {
withTable Table.Upload
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
[ Index "webLogAndPath" ]
delete
write; withRetryOnce; ignoreResult conn
}
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] do
do! rethink {
withTable table
@ -900,6 +955,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
do! ensureIndexes Table.TagMap []
do! ensureIndexes Table.Upload []
do! ensureIndexes Table.WebLog [ "urlBase" ]
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
}

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

@ -248,10 +248,24 @@ module Map =
text = getString "template" rdr
}
/// Create an uploaded file from the current row in the given data reader
let toUpload (rdr : SqliteDataReader) : Upload =
{ id = UploadId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
path = Permalink (getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data =
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
}
/// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog =
{ id = WebLogId (getString "id" rdr)
name = getString "name" rdr
slug = getString "slug" rdr
subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr
@ -259,6 +273,7 @@ module Map =
urlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr
uploads = UploadDestination.parse (getString "uploads" rdr)
rss = {
feedEnabled = getBoolean "feed_enabled" rdr
feedName = getString "feed_name" rdr

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

@ -21,12 +21,12 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Add a category
let add cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO category (
id, web_log_id, name, slug, description, parent_id
) VALUES (
@id, @webLogId, @name, @slug, @description, @parentId
)"""
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 ()
()
@ -70,13 +70,13 @@ type SQLiteCategoryData (conn : SqliteConnection) =
// Parent category post counts include posts in subcategories
cmd.Parameters.Clear ()
addWebLogId cmd webLogId
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 ("""
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)
@ -125,10 +125,10 @@ type SQLiteCategoryData (conn : SqliteConnection) =
| Some _ ->
use cmd = conn.CreateCommand ()
// 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)"""
cmd.CommandText <- """
DELETE FROM post_category
WHERE category_id = @id
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
do! write cmd
@ -150,14 +150,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
}

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

@ -139,14 +139,14 @@ type SQLitePageData (conn : SqliteConnection) =
let add page = backgroundTask {
use cmd = conn.CreateCommand ()
// The page itself
cmd.CommandText <-
"""INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list,
template, page_text
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList,
@template, @text
)"""
cmd.CommandText <- """
INSERT INTO page (
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list, template,
page_text
) VALUES (
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
@text
)"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id [] page.metadata
@ -174,11 +174,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 show_in_page_list = @showInPageList"""
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
return! count cmd
@ -211,11 +211,11 @@ 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_meta WHERE page_id = @id;
DELETE FROM page WHERE id = @id"""
do! write cmd
return true
| None -> return false
@ -238,12 +238,12 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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 <-
"""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 ("""
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}, "
@ -274,12 +274,12 @@ 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 show_in_page_list = @showInPageList
ORDER BY LOWER(title)"""
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
ORDER BY LOWER(title)"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
@ -293,12 +293,12 @@ type SQLitePageData (conn : SqliteConnection) =
/// 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)
@ -318,18 +318,18 @@ 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,
show_in_page_list = @showInPageList,
template = @template,
page_text = @text
WHERE id = @pageId
AND web_log_id = @webLogId"""
cmd.CommandText <- """
UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
show_in_page_list = @showInPageList,
template = @template,
page_text = @text
WHERE id = @pageId
AND web_log_id = @webLogId"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata

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

@ -146,26 +146,26 @@ type SQLitePostData (conn : SqliteConnection) =
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"""
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 ->
@ -174,16 +174,16 @@ type SQLitePostData (conn : SqliteConnection) =
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
)"""
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 -> ()
@ -278,14 +278,12 @@ 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
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn,
@template, @text
)"""
cmd.CommandText <- """
INSERT INTO post (
id, web_log_id, author_id, status, title, permalink, published_on, updated_on, template, post_text
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
)"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id [] post.categoryIds
@ -340,14 +338,14 @@ 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_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"""
do! write cmd
return true
| None -> return false
@ -356,12 +354,12 @@ 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 <-
"""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 ("""
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}, "
@ -392,12 +390,12 @@ 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 <-
$"""{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 ("""
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}, "
@ -420,11 +418,11 @@ 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 <-
$"""{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}"""
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}"""
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
@ -437,12 +435,12 @@ 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 <-
$"""{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
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}"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
@ -456,14 +454,14 @@ 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 <-
$"""{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}"""
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}"""
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag)
@ -479,13 +477,13 @@ type SQLitePostData (conn : SqliteConnection) =
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
use cmd = conn.CreateCommand ()
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"""
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"""
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
@ -499,13 +497,13 @@ type SQLitePostData (conn : SqliteConnection) =
return None
}
do! rdr.CloseAsync ()
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"""
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"""
use! rdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask {
if rdr.Read () then
@ -528,18 +526,18 @@ 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
WHERE id = @id
AND web_log_id = @webLogId"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds

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

@ -50,11 +50,11 @@ 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 <-
"""SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
AND tag IN ("""
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}, "
@ -71,19 +71,19 @@ 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 (
id, web_log_id, tag, url_value
) VALUES (
@id, @webLogId, @tag, @urlValue
)"""
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)

69
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs Normal file
View File

@ -0,0 +1,69 @@
namespace MyWebLog.Data.SQLite
open System.IO
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
/// SQLite myWebLog web log data implementation
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 ("@dataLength", upload.data.Length)
] |> ignore
/// Save an uploaded file
let add upload = backgroundTask {
use cmd = conn.CreateCommand ()
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
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (upload.data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}
/// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@path", path) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toUpload rdr) else None
}
/// Find all uploaded files for the given web log
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
let! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toUpload rdr
}
/// Restore uploads from a backup
let restore uploads = backgroundTask {
for upload in uploads do do! add upload
}
interface IUploadData with
member _.add upload = add upload
member _.findByPath path webLogId = findByPath path webLogId
member _.findByWebLog webLogId = findByWebLog webLogId
member _.restore uploads = restore uploads

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

@ -27,6 +27,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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 ("@postsPerPage", webLog.postsPerPage)
@ -34,6 +35,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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
@ -69,11 +71,11 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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 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"""
addWebLogId cmd webLog.id
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toCustomFeed rdr
@ -88,16 +90,16 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// 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, itunes_category, itunes_subcategory, explicit, default_media_type,
media_base_url, guid, funding_url, funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email,
@imageUrl, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType,
@mediaBaseUrl, @guid, @fundingUrl, @fundingText, @medium
)"""
cmd.CommandText <- """
INSERT INTO web_log_feed_podcast (
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url,
itunes_category, itunes_subcategory, explicit, default_media_type, media_base_url, guid, funding_url,
funding_text, medium
) VALUES (
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl,
@iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @guid, @fundingUrl,
@fundingText, @medium
)"""
addPodcastParameters cmd feedId podcast
do! write cmd
}
@ -115,9 +117,9 @@ 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_podcast WHERE feed_id = @id;
DELETE FROM web_log_feed WHERE id = @id"""
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
do! write cmd
})
@ -126,12 +128,12 @@ 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
) VALUES (
@id, @webLogId, @source, @path
)"""
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
@ -143,12 +145,12 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|> 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
WHERE id = @id
AND web_log_id = @webLogId"""
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.id it
do! write cmd
@ -156,25 +158,25 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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,
itunes_category = @iTunesCategory,
itunes_subcategory = @iTunesSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
guid = @guid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
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,
itunes_category = @iTunesCategory,
itunes_subcategory = @iTunesSubcategory,
explicit = @explicit,
default_media_type = @defaultMediaType,
media_base_url = @mediaBaseUrl,
guid = @guid,
funding_url = @fundingUrl,
funding_text = @fundingText,
medium = @medium
WHERE feed_id = @feedId"""
cmd.Parameters.Clear ()
addPodcastParameters cmd it.id podcast
do! write cmd
@ -198,16 +200,14 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Add a web log
let add webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO web_log (
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone,
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled,
copyright
) VALUES (
@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
@copyright
)"""
cmd.CommandText <- """
INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled, copyright
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
do! updateCustomFeeds webLog
@ -232,25 +232,26 @@ 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 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_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"""
do! write cmd
}
@ -283,23 +284,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,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
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,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,