bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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

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

@ -100,6 +100,20 @@ module Json =
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) =
@ -133,6 +147,8 @@ module Json =
TagMapIdConverter ()
ThemeAssetIdConverter ()
ThemeIdConverter ()
UploadDestinationConverter ()
UploadIdConverter ()
WebLogIdConverter ()
WebLogUserIdConverter ()
// Handles DUs with no associated data, as well as option fields

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

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

@ -21,8 +21,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// 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
@ -70,8 +70,8 @@ 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)
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
@ -125,8 +125,8 @@ 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
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)
@ -150,8 +150,8 @@ type SQLiteCategoryData (conn : SqliteConnection) =
/// Update a category
let update cat = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE category
cmd.CommandText <- """
UPDATE category
SET name = @name,
slug = @slug,
description = @description,

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

@ -139,13 +139,13 @@ 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
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
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList, @template,
@text
)"""
addPageParameters cmd page
do! write cmd
@ -174,8 +174,8 @@ 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)
cmd.CommandText <- """
SELECT COUNT(id)
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList"""
@ -211,8 +211,8 @@ 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;
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"""
@ -238,8 +238,8 @@ 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
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
@ -274,8 +274,8 @@ 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 *
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
@ -293,8 +293,8 @@ 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 *
cmd.CommandText <- """
SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
@ -318,8 +318,8 @@ type SQLitePageData (conn : SqliteConnection) =
match! findFullById page.id page.webLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE page
cmd.CommandText <- """
UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,

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

@ -146,8 +146,8 @@ type SQLitePostData (conn : SqliteConnection) =
if count = 1 then
match post.episode with
| Some ep ->
cmd.CommandText <-
"""UPDATE post_episode
cmd.CommandText <- """
UPDATE post_episode
SET media = @media,
length = @length,
duration = @duration,
@ -174,15 +174,15 @@ 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
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
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit, @chapterFile,
@chapterType, @transcriptUrl, @transcriptType, @transcriptLang, @transcriptCaptions,
@seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
)"""
addEpisodeParameters cmd ep
do! write cmd
@ -278,13 +278,11 @@ 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
) VALUES (
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn,
@template, @text
@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn, @template, @text
)"""
addPostParameters cmd post
do! write cmd
@ -340,8 +338,8 @@ 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;
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;
@ -356,8 +354,8 @@ 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
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
@ -392,8 +390,8 @@ 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}
cmd.CommandText <- $"""
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
@ -420,8 +418,8 @@ 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}
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}"""
@ -437,8 +435,8 @@ 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}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY p.published_on DESC
@ -456,8 +454,8 @@ 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}
cmd.CommandText <- $"""
{selectPost}
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
@ -479,8 +477,8 @@ 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}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on < @publishedOn
@ -499,8 +497,8 @@ type SQLitePostData (conn : SqliteConnection) =
return None
}
do! rdr.CloseAsync ()
cmd.CommandText <-
$"""{selectPost}
cmd.CommandText <- $"""
{selectPost}
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND p.published_on > @publishedOn
@ -528,8 +526,8 @@ type SQLitePostData (conn : SqliteConnection) =
match! findFullById post.id post.webLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE post
cmd.CommandText <- """
UPDATE post
SET author_id = @authorId,
status = @status,
title = @title,

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

@ -50,8 +50,8 @@ 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 *
cmd.CommandText <- """
SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
AND tag IN ("""
@ -71,15 +71,15 @@ type SQLiteTagMapData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
match! findById tagMap.id tagMap.webLogId with
| Some _ ->
cmd.CommandText <-
"""UPDATE tag_map
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

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

67
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,8 +71,8 @@ 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.*
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"""
@ -88,15 +90,15 @@ 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
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
@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,8 +117,8 @@ 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;
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,8 +128,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"""INSERT INTO web_log_feed (
cmd.CommandText <- """
INSERT INTO web_log_feed (
id, web_log_id, source, path
) VALUES (
@id, @webLogId, @source, @path
@ -143,8 +145,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
|> ignore
toUpdate
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"""UPDATE web_log_feed
cmd.CommandText <- """
UPDATE web_log_feed
SET source = @source,
path = @path
WHERE id = @id
@ -156,8 +158,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
match it.podcast with
| Some podcast ->
if hadPodcast then
cmd.CommandText <-
"""UPDATE web_log_feed_podcast
cmd.CommandText <- """
UPDATE web_log_feed_podcast
SET title = @title,
subtitle = @subtitle,
items_in_feed = @itemsInFeed,
@ -198,15 +200,13 @@ 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
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, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
@copyright
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled, @copyright
)"""
addWebLogParameters cmd webLog
do! write cmd
@ -232,8 +232,8 @@ 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};
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};
@ -247,6 +247,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
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;
@ -283,9 +284,10 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update settings for a web log
let updateSettings webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
cmd.CommandText <- """
UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
@ -293,6 +295,7 @@ type SQLiteWebLogData (conn : SqliteConnection) =
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
@ -307,8 +310,8 @@ type SQLiteWebLogData (conn : SqliteConnection) =
/// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
cmd.CommandText <- """
UPDATE web_log
SET feed_enabled = @feedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,

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

@ -28,13 +28,13 @@ 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, user_name, first_name, last_name, preferred_name, password_hash, salt,
url, authorization_level
cmd.CommandText <- """
INSERT INTO web_log_user (
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url,
authorization_level
) VALUES (
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt,
@url, @authorizationLevel
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url,
@authorizationLevel
)"""
addWebLogUserParameters cmd user
do! write cmd
@ -43,8 +43,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
@ -95,8 +94,8 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
/// Update a user
let update user = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log_user
cmd.CommandText <- """
UPDATE web_log_user
SET user_name = @userName,
first_name = @firstName,
last_name = @lastName,

136
src/MyWebLog.Data/SQLiteData.fs
View File

@ -36,6 +36,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
member _.TagMap = SQLiteTagMapData conn
member _.Theme = SQLiteThemeData conn
member _.ThemeAsset = SQLiteThemeAssetData conn
member _.Upload = SQLiteUploadData conn
member _.WebLog = SQLiteWebLogData conn
member _.WebLogUser = SQLiteWebLogUserData conn
@ -48,8 +49,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme table..."
cmd.CommandText <-
"""CREATE TABLE theme (
cmd.CommandText <- """
CREATE TABLE theme (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
version TEXT NOT NULL)"""
@ -58,8 +59,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_template table..."
cmd.CommandText <-
"""CREATE TABLE theme_template (
cmd.CommandText <- """
CREATE TABLE theme_template (
theme_id TEXT NOT NULL REFERENCES theme (id),
name TEXT NOT NULL,
template TEXT NOT NULL,
@ -69,8 +70,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating theme_asset table..."
cmd.CommandText <-
"""CREATE TABLE theme_asset (
cmd.CommandText <- """
CREATE TABLE theme_asset (
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
@ -83,10 +84,11 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log table..."
cmd.CommandText <-
"""CREATE TABLE web_log (
cmd.CommandText <- """
CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
slug TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
posts_per_page INTEGER NOT NULL,
@ -94,30 +96,33 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
uploads TEXT NOT NULL,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,
category_enabled INTEGER NOT NULL DEFAULT 0,
tag_enabled INTEGER NOT NULL DEFAULT 0,
copyright TEXT)"""
copyright TEXT);
CREATE INDEX web_log_theme_idx ON web_log (theme_id)"""
do! write cmd
match! tableExists "web_log_feed" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed table..."
cmd.CommandText <-
"""CREATE TABLE web_log_feed (
cmd.CommandText <- """
CREATE TABLE web_log_feed (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
source TEXT NOT NULL,
path TEXT NOT NULL)"""
path TEXT NOT NULL);
CREATE INDEX web_log_feed_web_log_idx ON web_log_feed (web_log_id)"""
do! write cmd
match! tableExists "web_log_feed_podcast" with
| true -> ()
| false ->
log.LogInformation "Creating web_log_feed_podcast table..."
cmd.CommandText <-
"""CREATE TABLE web_log_feed_podcast (
cmd.CommandText <- """
CREATE TABLE web_log_feed_podcast (
feed_id TEXT PRIMARY KEY REFERENCES web_log_feed (id),
title TEXT NOT NULL,
subtitle TEXT,
@ -142,14 +147,15 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating category table..."
cmd.CommandText <-
"""CREATE TABLE category (
cmd.CommandText <- """
CREATE TABLE category (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
name TEXT NOT NULL,
slug TEXT NOT NULL,
description TEXT,
parent_id TEXT)"""
parent_id TEXT);
CREATE INDEX category_web_log_idx ON category (web_log_id)"""
do! write cmd
// Web log user table
@ -157,8 +163,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating web_log_user table..."
cmd.CommandText <-
"""CREATE TABLE web_log_user (
cmd.CommandText <- """
CREATE TABLE web_log_user (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
user_name TEXT NOT NULL,
@ -168,7 +174,9 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
password_hash TEXT NOT NULL,
salt TEXT NOT NULL,
url TEXT,
authorization_level TEXT NOT NULL)"""
authorization_level TEXT NOT NULL);
CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id);
CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)"""
do! write cmd
// Page tables
@ -176,8 +184,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page table..."
cmd.CommandText <-
"""CREATE TABLE page (
cmd.CommandText <- """
CREATE TABLE page (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
@ -187,14 +195,17 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
updated_on TEXT NOT NULL,
show_in_page_list INTEGER NOT NULL DEFAULT 0,
template TEXT,
page_text TEXT NOT NULL)"""
page_text TEXT NOT NULL);
CREATE INDEX page_web_log_idx ON page (web_log_id);
CREATE INDEX page_author_idx ON page (author_id);
CREATE INDEX page_permalink_idx ON page (web_log_id, permalink)"""
do! write cmd
match! tableExists "page_meta" with
| true -> ()
| false ->
log.LogInformation "Creating page_meta table..."
cmd.CommandText <-
"""CREATE TABLE page_meta (
cmd.CommandText <- """
CREATE TABLE page_meta (
page_id TEXT NOT NULL REFERENCES page (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@ -204,8 +215,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_permalink table..."
cmd.CommandText <-
"""CREATE TABLE page_permalink (
cmd.CommandText <- """
CREATE TABLE page_permalink (
page_id TEXT NOT NULL REFERENCES page (id),
permalink TEXT NOT NULL,
PRIMARY KEY (page_id, permalink))"""
@ -214,8 +225,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating page_revision table..."
cmd.CommandText <-
"""CREATE TABLE page_revision (
cmd.CommandText <- """
CREATE TABLE page_revision (
page_id TEXT NOT NULL REFERENCES page (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@ -227,8 +238,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post table..."
cmd.CommandText <-
"""CREATE TABLE post (
cmd.CommandText <- """
CREATE TABLE post (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
author_id TEXT NOT NULL REFERENCES web_log_user (id),
@ -238,24 +249,29 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
published_on TEXT,
updated_on TEXT NOT NULL,
template TEXT,
post_text TEXT NOT NULL)"""
post_text TEXT NOT NULL);
CREATE INDEX post_web_log_idx ON post (web_log_id);
CREATE INDEX post_author_idx ON post (author_id);
CREATE INDEX post_status_idx ON post (web_log_id, status, updated_on);
CREATE INDEX post_permalink_idx ON post (web_log_id, permalink)"""
do! write cmd
match! tableExists "post_category" with
| true -> ()
| false ->
log.LogInformation "Creating post_category table..."
cmd.CommandText <-
"""CREATE TABLE post_category (
cmd.CommandText <- """
CREATE TABLE post_category (
post_id TEXT NOT NULL REFERENCES post (id),
category_id TEXT NOT NULL REFERENCES category (id),
PRIMARY KEY (post_id, category_id))"""
PRIMARY KEY (post_id, category_id));
CREATE INDEX post_category_category_idx ON post_category (category_id)"""
do! write cmd
match! tableExists "post_episode" with
| true -> ()
| false ->
log.LogInformation "Creating post_episode table..."
cmd.CommandText <-
"""CREATE TABLE post_episode (
cmd.CommandText <- """
CREATE TABLE post_episode (
post_id TEXT PRIMARY KEY REFERENCES post(id),
media TEXT NOT NULL,
length INTEGER NOT NULL,
@ -279,8 +295,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_tag table..."
cmd.CommandText <-
"""CREATE TABLE post_tag (
cmd.CommandText <- """
CREATE TABLE post_tag (
post_id TEXT NOT NULL REFERENCES post (id),
tag TEXT NOT NULL,
PRIMARY KEY (post_id, tag))"""
@ -289,8 +305,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_meta table..."
cmd.CommandText <-
"""CREATE TABLE post_meta (
cmd.CommandText <- """
CREATE TABLE post_meta (
post_id TEXT NOT NULL REFERENCES post (id),
name TEXT NOT NULL,
value TEXT NOT NULL,
@ -300,8 +316,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_permalink table..."
cmd.CommandText <-
"""CREATE TABLE post_permalink (
cmd.CommandText <- """
CREATE TABLE post_permalink (
post_id TEXT NOT NULL REFERENCES post (id),
permalink TEXT NOT NULL,
PRIMARY KEY (post_id, permalink))"""
@ -310,8 +326,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_revision table..."
cmd.CommandText <-
"""CREATE TABLE post_revision (
cmd.CommandText <- """
CREATE TABLE post_revision (
post_id TEXT NOT NULL REFERENCES post (id),
as_of TEXT NOT NULL,
revision_text TEXT NOT NULL,
@ -321,8 +337,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating post_comment table..."
cmd.CommandText <-
"""CREATE TABLE post_comment (
cmd.CommandText <- """
CREATE TABLE post_comment (
id TEXT PRIMARY KEY,
post_id TEXT NOT NULL REFERENCES post(id),
in_reply_to_id TEXT,
@ -331,7 +347,8 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
url TEXT,
status TEXT NOT NULL,
posted_on TEXT NOT NULL,
comment_text TEXT NOT NULL)"""
comment_text TEXT NOT NULL);
CREATE INDEX post_comment_post_idx ON post_comment (post_id)"""
do! write cmd
// Tag map table
@ -339,11 +356,28 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>) =
| true -> ()
| false ->
log.LogInformation "Creating tag_map table..."
cmd.CommandText <-
"""CREATE TABLE tag_map (
cmd.CommandText <- """
CREATE TABLE tag_map (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
tag TEXT NOT NULL,
url_value TEXT NOT NULL)"""
url_value TEXT NOT NULL);
CREATE INDEX tag_map_web_log_idx ON tag_map (web_log_id)"""
do! write cmd
// Uploaded file table
match! tableExists "upload" with
| true -> ()
| false ->
log.LogInformation "Creating upload table..."
cmd.CommandText <- """
CREATE TABLE upload (
id TEXT PRIMARY KEY,
web_log_id TEXT NOT NULL REFERENCES web_log (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BLOB NOT NULL);
CREATE INDEX upload_web_log_idx ON upload (web_log_id);
CREATE INDEX upload_path_idx ON upload (web_log_id, path)"""
do! write cmd
}

39
src/MyWebLog.Domain/DataTypes.fs
View File

@ -295,6 +295,37 @@ type ThemeAsset =
}
/// An uploaded file
type Upload =
{ /// The ID of the upload
id : UploadId
/// The ID of the web log to which this upload belongs
webLogId : WebLogId
/// The link at which this upload is served
path : Permalink
/// The updated date/time for this upload
updatedOn : DateTime
/// The data for the upload
data : byte[]
}
/// Functions to support uploaded files
module Upload =
/// An empty upload
let empty = {
id = UploadId.empty
webLogId = WebLogId.empty
path = Permalink.empty
updatedOn = DateTime.MinValue
data = [||]
}
/// A web log
[<CLIMutable; NoComparison; NoEquality>]
type WebLog =
@ -304,6 +335,9 @@ type WebLog =
/// The name of the web log
name : string
/// The slug of the web log
slug : string
/// A subtitle for the web log
subtitle : string option
@ -327,6 +361,9 @@ type WebLog =
/// Whether to automatically load htmx
autoHtmx : bool
/// Where uploads are placed
uploads : UploadDestination
}
/// Functions to support web logs
@ -336,6 +373,7 @@ module WebLog =
let empty =
{ id = WebLogId.empty
name = ""
slug = ""
subtitle = None
defaultPage = ""
postsPerPage = 10
@ -344,6 +382,7 @@ module WebLog =
timeZone = ""
rss = RssOptions.empty
autoHtmx = false
uploads = Database
}
/// Get the host (including scheme) and extra path from the URL base

35
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -556,6 +556,41 @@ type ThemeTemplate =
}
/// Where uploads should be placed
type UploadDestination =
| Database
| Disk
/// Functions to support upload destinations
module UploadDestination =
/// Convert an upload destination to its string representation
let toString = function Database -> "database" | Disk -> "disk"
/// Parse an upload destination from its string representation
let parse value =
match value with
| "database" -> Database
| "disk" -> Disk
| it -> invalidOp $"{it} is not a valid upload destination"
/// An identifier for an upload
type UploadId = UploadId of string
/// Functions to support upload IDs
module UploadId =
/// An empty upload ID
let empty = UploadId ""
/// Convert an upload ID to a string
let toString = function UploadId ui -> ui
/// Create a new upload ID
let create () = UploadId (newId ())
/// An identifier for a web log
type WebLogId = WebLogId of string

39
src/MyWebLog/Handlers/Routes.fs
View File

@ -93,44 +93,14 @@ module CatchAll =
/// Serve theme assets
module Asset =
open System
open Microsoft.AspNetCore.Http.Headers
open Microsoft.AspNetCore.StaticFiles
open Microsoft.Net.Http.Headers
/// Determine if the asset has been modified since the date/time specified by the If-Modified-Since header
let private checkModified asset (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it ->
if asset.updatedOn > DateTime.Parse it[0] then
None
else
Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
/// An instance of ASP.NET Core's file extension to MIME type converter
let private mimeMap = FileExtensionContentTypeProvider ()
// GET /theme/{theme}/{**path}
let serveAsset (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.findById (ThemeAssetId.ofString path) with
| Some asset ->
match checkModified asset ctx with
match Upload.checkModified asset.updatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None ->
let mimeType =
match mimeMap.TryGetContentType path with
| true, typ -> typ
| false, _ -> "application/octet-stream"
let headers = ResponseHeaders ctx.Response.Headers
headers.LastModified <- Some (DateTimeOffset asset.updatedOn) |> Option.toNullable
headers.ContentType <- MediaTypeHeaderValue mimeType
headers.CacheControl <-
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
return! setBody asset.data next ctx
| None -> return! Upload.sendFile asset.updatedOn path asset.data next ctx
| None -> return! Error.notFound next ctx
}
@ -210,7 +180,8 @@ let router : HttpHandler = choose [
GET_HEAD >=> routef "/page/%i" Post.pageOfPosts
GET_HEAD >=> routef "/page/%i/" Post.redirectToPageOfPosts
GET_HEAD >=> routexp "/tag/(.*)" Post.pageOfTaggedPosts
GET_HEAD >=> routexp "/themes/(.*)" Asset.serveAsset
GET_HEAD >=> routexp "/themes/(.*)" Asset.serve
GET_HEAD >=> routexp "/upload/(.*)" Upload.serve
subRoute "/user" (choose [
GET_HEAD >=> choose [
route "/log-on" >=> User.logOn None

61
src/MyWebLog/Handlers/Upload.fs Normal file
View File

@ -0,0 +1,61 @@
/// Handlers to manipulate uploaded files
module MyWebLog.Handlers.Upload
open System
open Giraffe
open Microsoft.AspNetCore.Http
open MyWebLog
/// Helper functions for this module
[<AutoOpen>]
module private Helpers =
open Microsoft.AspNetCore.StaticFiles
/// A MIME type mapper instance to use when serving files from the database
let mimeMap = FileExtensionContentTypeProvider ()
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it when since > DateTime.Parse it[0] -> None
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
open Microsoft.AspNetCore.Http.Headers
open Microsoft.Net.Http.Headers
/// Derive a MIME type based on the extension of the file
let deriveMimeType path =
match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream"
/// Send a file, caching the response for 30 days
let sendFile updatedOn path data : HttpHandler = fun next ctx -> task {
let headers = ResponseHeaders ctx.Response.Headers
headers.LastModified <- Some (DateTimeOffset updatedOn) |> Option.toNullable
headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path
headers.CacheControl <-
let hdr = CacheControlHeaderValue()
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
return! setBody data next ctx
}
// GET /upload/{web-log-slug}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/'
let slug = Array.head parts
let path = String.Join ('/', parts |> Array.skip 1)
let webLog = ctx.WebLog
if slug = webLog.slug then
match! ctx.Data.Upload.findByPath path webLog.id with
| Some upload ->
match checkModified upload.updatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.updatedOn path upload.data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
}

63
src/MyWebLog/Maintenance.fs
View File

@ -2,6 +2,7 @@ module MyWebLog.Maintenance
open System
open System.IO
open System.Text.RegularExpressions
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
@ -23,11 +24,13 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let homePageId = PageId.create ()
let slug = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (args[2], ""), "-")).ToLowerInvariant ()
do! data.WebLog.add
{ WebLog.empty with
id = webLogId
name = args[2]
slug = slug
urlBase = args[1]
defaultPage = PageId.toString homePageId
timeZone = timeZone
@ -162,12 +165,47 @@ module Backup =
}
/// Create a theme asset from an encoded theme asset
static member fromAsset (asset : EncodedAsset) : ThemeAsset =
{ id = asset.id
updatedOn = asset.updatedOn
data = Convert.FromBase64String asset.data
static member fromEncoded (encoded : EncodedAsset) : ThemeAsset =
{ id = encoded.id
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.data
}
/// An uploaded file, with the data base-64 encoded
type EncodedUpload =
{ /// The ID of the upload
id : UploadId
/// The ID of the web log to which the upload belongs
webLogId : WebLogId
/// The path at which this upload is served
path : Permalink
/// The date/time this upload was last updated (file time)
updatedOn : DateTime
/// The data for the upload, base-64 encoded
data : string
}
/// Create an encoded uploaded file from the original uploaded file
static member fromUpload (upload : Upload) : EncodedUpload =
{ id = upload.id
webLogId = upload.webLogId
path = upload.path
updatedOn = upload.updatedOn
data = Convert.ToBase64String upload.data
}
/// Create an uploaded file from an encoded uploaded file
static member fromEncoded (encoded : EncodedUpload) : Upload =
{ id = encoded.id
webLogId = encoded.webLogId
path = encoded.path
updatedOn = encoded.updatedOn
data = Convert.FromBase64String encoded.data
}
/// A unified archive for a web log
type Archive =
@ -194,6 +232,9 @@ module Backup =
/// The posts for this web log (containing only the most recent revision)
posts : Post list
/// The uploaded files for this web log
uploads : EncodedUpload list
}
/// Create a JSON serializer (uses RethinkDB data implementation's JSON converters)
@ -212,6 +253,7 @@ module Backup =
let tagMapCount = List.length archive.tagMappings
let pageCount = List.length archive.pages
let postCount = List.length archive.posts
let uploadCount = List.length archive.uploads
// Create a pluralized output based on the count
let plural count ifOne ifMany =
@ -225,6 +267,7 @@ module Backup =
printfn $""" - {tagMapCount} tag mapping{plural tagMapCount "" "s"}"""
printfn $""" - {pageCount} page{plural pageCount "" "s"}"""
printfn $""" - {postCount} post{plural postCount "" "s"}"""
printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}"""
/// Create a backup archive
let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task {
@ -248,6 +291,9 @@ module Backup =
printfn "- Exporting posts..."
let! posts = data.Post.findFullByWebLog webLog.id
printfn "- Exporting uploads..."
let! uploads = data.Upload.findByWebLog webLog.id
printfn "- Writing archive..."
let archive = {
webLog = webLog
@ -258,6 +304,7 @@ module Backup =
tagMappings = tagMaps
pages = pages |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
posts = posts |> List.map (fun p -> { p with revisions = List.truncate 1 p.revisions })
uploads = uploads |> List.map EncodedUpload.fromUpload
}
// Write the structure to the backup file
@ -284,6 +331,7 @@ module Backup =
let newPageIds = archive.pages |> List.map (fun page -> page.id, PageId.create ()) |> dict
let newPostIds = archive.posts |> List.map (fun post -> post.id, PostId.create ()) |> dict
let newUserIds = archive.users |> List.map (fun user -> user.id, WebLogUserId.create ()) |> dict
let newUpIds = archive.uploads |> List.map (fun up -> up.id, UploadId.create ()) |> dict
return
{ archive with
webLog = { archive.webLog with id = newWebLogId; urlBase = Option.get newUrlBase }
@ -308,6 +356,8 @@ module Backup =
authorId = newUserIds[post.authorId]
categoryIds = post.categoryIds |> List.map (fun c -> newCatIds[c])
})
uploads = archive.uploads
|> List.map (fun u -> { u with id = newUpIds[u.id]; webLogId = newWebLogId })
}
| None ->
return
@ -320,7 +370,7 @@ module Backup =
printfn ""
printfn "- Importing theme..."
do! data.Theme.save restore.theme
let! _ = restore.assets |> List.map (EncodedAsset.fromAsset >> data.ThemeAsset.save) |> Task.WhenAll
let! _ = restore.assets |> List.map (EncodedAsset.fromEncoded >> data.ThemeAsset.save) |> Task.WhenAll
// Restore web log data
@ -342,6 +392,9 @@ module Backup =
// TODO: comments not yet implemented
printfn "- Restoring uploads..."
do! data.Upload.restore (restore.uploads |> List.map EncodedUpload.fromEncoded)
displayStats "Restored for {{NAME}}:" restore.webLog restore
}

3
src/MyWebLog/MyWebLog.fsproj
View File

@ -18,6 +18,7 @@
<Compile Include="Handlers\Feed.fs" />
<Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Upload.fs" />
<Compile Include="Handlers\Routes.fs" />
<Compile Include="DotLiquidBespoke.fs" />
<Compile Include="Maintenance.fs" />
@ -41,7 +42,7 @@
</ItemGroup>
<ItemGroup>
<None Include=".\wwwroot\img\*.png" CopyToOutputDirectory="Always" />
<None Include=".\wwwroot\upload\*" CopyToOutputDirectory="Always" />
</ItemGroup>
</Project>

0
src/MyWebLog/wwwroot/upload/.gitkeep Normal file
View File