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

Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
Conversation 0 Commits 123 Files Changed 116 +260 -600
9 changed files with 260 additions and 600 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit e04c8b58e9 - Show all commits

8
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@ -23,8 +23,12 @@ type PostgresWebLogData(log: ILogger) =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
Custom.nonQuery Custom.nonQuery
$"""DELETE FROM {Table.PostComment} $"""DELETE FROM {Table.PostComment}
WHERE data ->> '{nameof Comment.Empty.PostId}' IN WHERE data ->> '{nameof Comment.Empty.PostId}'
(SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}); IN (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
DELETE FROM {Table.PostRevision}
WHERE post_id IN (SELECT data ->> 'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
DELETE FROM {Table.PageRevision}
WHERE page_id IN (SELECT data ->> 'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
{Query.Delete.byContains Table.Post}; {Query.Delete.byContains Table.Post};
{Query.Delete.byContains Table.Page}; {Query.Delete.byContains Table.Page};
{Query.Delete.byContains Table.Category}; {Query.Delete.byContains Table.Category};

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

@ -168,16 +168,6 @@ module Map =
/// Get a string value from a data reader /// Get a string value from a data reader
let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col) let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col)
/// Parse a Duration from the given value
let parseDuration value =
match DurationPattern.Roundtrip.Parse value with
| it when it.Success -> it.Value
| it -> raise it.Exception
/// Get a Duration value from a data reader
let getDuration col rdr =
getString col rdr |> parseDuration
/// Parse an Instant from the given value /// Parse an Instant from the given value
let parseInstant value = let parseInstant value =
match InstantPattern.General.Parse value with match InstantPattern.General.Parse value with
@ -211,29 +201,10 @@ module Map =
let tryString col (rdr: SqliteDataReader) = let tryString col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null Duration value from a data reader
let tryDuration col rdr =
tryString col rdr |> Option.map parseDuration
/// Get a possibly null Instant value from a data reader
let tryInstant col rdr =
tryString col rdr |> Option.map parseInstant
/// Get a possibly null timespan value from a data reader /// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr: SqliteDataReader) = let tryTimeSpan col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Map an id field to a category ID
let toCategoryId rdr = getString "id" rdr |> CategoryId
/// Create a custom feed from the current row in the given data reader
let toCustomFeed ser rdr : CustomFeed =
{ Id = getString "id" rdr |> CustomFeedId
Source = getString "source" rdr |> CustomFeedSource.Parse
Path = getString "path" rdr |> Permalink
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
}
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
@ -242,22 +213,6 @@ module Map =
{ AsOf = getInstant "as_of" rdr { AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.Parse } Text = getString "revision_text" rdr |> MarkupText.Parse }
/// Create a tag mapping from the current row in the given data reader
let toTagMap rdr : TagMap =
{ Id = getString "id" rdr |> TagMapId
WebLogId = getString "web_log_id" rdr |> WebLogId
Tag = getString "tag" rdr
UrlValue = getString "url_value" rdr
}
/// Create a theme from the current row in the given data reader (excludes templates)
let toTheme rdr : Theme =
{ Theme.Empty with
Id = getString "id" rdr |> ThemeId
Name = getString "name" rdr
Version = getString "version" rdr
}
/// Create a theme asset from the current row in the given data reader /// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData rdr : ThemeAsset = let toThemeAsset includeData rdr : ThemeAsset =
let assetData = let assetData =
@ -272,12 +227,6 @@ module Map =
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = assetData } Data = assetData }
/// Create a theme template from the current row in the given data reader
let toThemeTemplate includeText rdr : ThemeTemplate =
{ Name = getString "name" rdr
Text = if includeText then getString "template" rdr else ""
}
/// Create an uploaded file from the current row in the given data reader /// Create an uploaded file from the current row in the given data reader
let toUpload includeData rdr : Upload = let toUpload includeData rdr : Upload =
let data = let data =
@ -294,46 +243,6 @@ module Map =
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = data } Data = data }
/// Create a web log from the current row in the given data reader
let toWebLog ser rdr : WebLog =
{ Id = getString "id" rdr |> WebLogId
Name = getString "name" rdr
Slug = getString "slug" rdr
Subtitle = tryString "subtitle" rdr
DefaultPage = getString "default_page" rdr
PostsPerPage = getInt "posts_per_page" rdr
ThemeId = getString "theme_id" rdr |> ThemeId
UrlBase = getString "url_base" rdr
TimeZone = getString "time_zone" rdr
AutoHtmx = getBoolean "auto_htmx" rdr
Uploads = getString "uploads" rdr |> UploadDestination.Parse
Rss = {
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
FeedName = getString "feed_name" rdr
ItemsInFeed = tryInt "items_in_feed" rdr
IsCategoryEnabled = getBoolean "is_category_enabled" rdr
IsTagEnabled = getBoolean "is_tag_enabled" rdr
Copyright = tryString "copyright" rdr
CustomFeeds = []
}
RedirectRules = getString "redirect_rules" rdr |> Utils.deserialize ser
}
/// Create a web log user from the current row in the given data reader
let toWebLogUser rdr : WebLogUser =
{ Id = getString "id" rdr |> WebLogUserId
WebLogId = getString "web_log_id" rdr |> WebLogId
Email = getString "email" rdr
FirstName = getString "first_name" rdr
LastName = getString "last_name" rdr
PreferredName = getString "preferred_name" rdr
PasswordHash = getString "password_hash" rdr
Url = tryString "url" rdr
AccessLevel = getString "access_level" rdr |> AccessLevel.Parse
CreatedOn = getInstant "created_on" rdr
LastSeenOn = tryInstant "last_seen_on" rdr
}
/// Map from a document to a domain type, specifying the field name for the document /// Map from a document to a domain type, specifying the field name for the document
let fromData<'T> ser rdr fieldName : 'T = let fromData<'T> ser rdr fieldName : 'T =
Utils.deserialize<'T> ser (getString fieldName rdr) Utils.deserialize<'T> ser (getString fieldName rdr)
@ -409,6 +318,16 @@ module Document =
return! count cmd return! count cmd
} }
/// Find a document by its ID
let findById<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById}"
addDocId cmd key
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None
}
/// Find a document by its ID and web log ID /// Find a document by its ID and web log ID
let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask { let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask {
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()
@ -444,6 +363,17 @@ module Document =
do! write cmd do! write cmd
} }
/// Update a field in a document by its ID
let updateField<'TKey, 'TValue> (conn: SqliteConnection) ser table (key: 'TKey) jsonField
(value: 'TValue) = backgroundTask {
use cmd = conn.CreateCommand()
cmd.CommandText <-
$"UPDATE %s{table} SET data = json_set(data, '$.{jsonField}', json(@it)) WHERE {Query.whereById}"
addDocId cmd key
addParam cmd "@it" (Utils.serialize ser value)
do! write cmd
}
/// Delete a document by its ID /// Delete a document by its ID
let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask { let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask {
use cmd = conn.CreateCommand() use cmd = conn.CreateCommand()

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

@ -186,14 +186,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
log.LogTrace "Page.updatePriorPermalinks" log.LogTrace "Page.updatePriorPermalinks"
match! findById pageId webLogId with match! findById pageId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() do! Document.updateField conn ser Table.Page pageId (nameof Page.Empty.PriorPermalinks) permalinks
cmd.CommandText <- $"
UPDATE {Table.Page}
SET data = json_set(data, '$.{nameof Page.Empty.PriorPermalinks}', json(@links))
WHERE {Query.whereById}"
addDocId cmd pageId
addParam cmd "@links" (Utils.serialize ser permalinks)
do! write cmd
return true return true
| None -> return false | None -> return false
} }

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

@ -224,14 +224,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask { let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
match! findById postId webLogId with match! findById postId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() do! Document.updateField conn ser Table.Post postId (nameof Post.Empty.PriorPermalinks) permalinks
cmd.CommandText <- $"
UPDATE {Table.Post}
SET data = json_set(data, '$.{nameof Post.Empty.PriorPermalinks}', json(@links))
WHERE {Query.whereById}"
addDocId cmd postId
addParam cmd "@links" (Utils.serialize ser permalinks)
do! write cmd
return true return true
| None -> return false | None -> return false
} }

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

@ -1,77 +1,62 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeData (conn : SqliteConnection) = type SQLiteThemeData(conn : SqliteConnection, ser: JsonSerializer, log: ILogger) =
/// The JSON field for the theme ID
let idField = $"data ->> '{nameof Theme.Empty.Id}'"
/// Remove the template text from a theme
let withoutTemplateText (it: Theme) =
{ it with Templates = it.Templates |> List.map (fun t -> { t with Text = "" }) }
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask { let all () = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Theme.all"
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id" use cmd = conn.CreateCommand()
use! rdr = cmd.ExecuteReaderAsync () cmd.CommandText <- $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
let themes = toList Map.toTheme rdr let! themes = cmdToList<Theme> cmd ser
do! rdr.CloseAsync () return themes |> List.map withoutTemplateText
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
use! rdr = cmd.ExecuteReaderAsync ()
let templates =
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|> List.ofSeq
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
} }
/// Does a given theme exist? /// Does a given theme exist?
let exists (themeId: ThemeId) = backgroundTask { let exists (themeId: ThemeId) = backgroundTask {
log.LogTrace "Theme.exists"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id" cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Theme} WHERE {idField} = @id"
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore addDocId cmd themeId
let! count = count cmd let! count = count cmd
return count > 0 return count > 0
} }
/// Find a theme by its ID /// Find a theme by its ID
let findById (themeId: ThemeId) = backgroundTask { let findById themeId =
use cmd = conn.CreateCommand () log.LogTrace "Theme.findById"
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id" Document.findById<ThemeId, Theme> conn ser Table.Theme themeId
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let theme = Map.toTheme rdr
let templateCmd = conn.CreateCommand ()
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with Templates = toList (Map.toThemeTemplate true) templateRdr }
else
return None
}
/// Find a theme by its ID (excludes the text of templates) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask { let findByIdWithoutText themeId = backgroundTask {
match! findById themeId with log.LogTrace "Theme.findByIdWithoutText"
| Some theme -> let! theme = findById themeId
return Some { return theme |> Option.map withoutTemplateText
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
}
| None -> return None
} }
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
log.LogTrace "Theme.delete"
match! findByIdWithoutText themeId with match! findByIdWithoutText themeId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <- $"
"DELETE FROM theme_asset WHERE theme_id = @id; DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
DELETE FROM theme_template WHERE theme_id = @id; DELETE FROM {Table.Theme} WHERE {Query.whereById}"
DELETE FROM theme WHERE id = @id" addDocId cmd themeId
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
do! write cmd do! write cmd
return true return true
| None -> return false | None -> return false
@ -79,62 +64,14 @@ type SQLiteThemeData (conn : SqliteConnection) =
/// Save a theme /// Save a theme
let save (theme: Theme) = backgroundTask { let save (theme: Theme) = backgroundTask {
use cmd = conn.CreateCommand() log.LogTrace "Theme.save"
let! oldTheme = findById theme.Id match! findById theme.Id with
cmd.CommandText <- | Some _ -> do! Document.update conn ser Table.Theme theme.Id theme
match oldTheme with | None -> do! Document.insert conn ser Table.Theme theme
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", string theme.Id)
cmd.Parameters.AddWithValue ("@name", theme.Name)
cmd.Parameters.AddWithValue ("@version", theme.Version)
] |> ignore
do! write cmd
let toDelete, toAdd =
Utils.diffLists (oldTheme |> Option.map _.Templates |> Option.defaultValue []) theme.Templates _.Name
let toUpdate =
theme.Templates
|> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.Name = t.Name))
&& not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", string theme.Id)
cmd.Parameters.Add ("@name", SqliteType.Text)
cmd.Parameters.Add ("@template", SqliteType.Text)
] |> ignore
toUpdate
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
toAdd
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name" ].Value <- template.Name
cmd.Parameters["@template"].Value <- template.Text
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
cmd.Parameters.Remove cmd.Parameters["@template"]
toDelete
|> List.map (fun template -> backgroundTask {
cmd.Parameters["@name"].Value <- template.Name
do! write cmd
})
|> Task.WhenAll
|> ignore
} }
interface IThemeData with interface IThemeData with
member _.All () = all () member _.All() = all ()
member _.Delete themeId = delete themeId member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId member _.FindById themeId = findById themeId
@ -144,97 +81,100 @@ type SQLiteThemeData (conn : SqliteConnection) =
open System.IO open System.IO
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeAssetData (conn : SqliteConnection) = type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
/// Get all theme assets (excludes data) /// Get all theme assets (excludes data)
let all () = backgroundTask { let all () = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "ThemeAsset.all"
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset" use cmd = conn.CreateCommand()
use! rdr = cmd.ExecuteReaderAsync () cmd.CommandText <- $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}"
use! rdr = cmd.ExecuteReaderAsync()
return toList (Map.toThemeAsset false) rdr return toList (Map.toThemeAsset false) rdr
} }
/// Delete all assets for the given theme /// Delete all assets for the given theme
let deleteByTheme (themeId: ThemeId) = backgroundTask { let deleteByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "ThemeAsset.deleteByTheme"
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId" use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore cmd.CommandText <- $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
addParam cmd "@themeId" (string themeId)
do! write cmd do! write cmd
} }
/// Find a theme asset by its ID /// Find a theme asset by its ID
let findById assetId = backgroundTask { let findById assetId = backgroundTask {
log.LogTrace "ThemeAsset.findById"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = assetId let (ThemeAssetId (ThemeId themeId, path)) = assetId
[ cmd.Parameters.AddWithValue ("@themeId", themeId) addParam cmd "@themeId" themeId
cmd.Parameters.AddWithValue ("@path", path) addParam cmd "@path" path
] |> ignore use! rdr = cmd.ExecuteReaderAsync()
use! rdr = cmd.ExecuteReaderAsync () let! isFound = rdr.ReadAsync()
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None return if isFound then Some (Map.toThemeAsset true rdr) else None
} }
/// Get theme assets for the given theme (excludes data) /// Get theme assets for the given theme (excludes data)
let findByTheme (themeId: ThemeId) = backgroundTask { let findByTheme (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "ThemeAsset.findByTheme"
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore cmd.CommandText <- $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
use! rdr = cmd.ExecuteReaderAsync () addParam cmd "@themeId" (string themeId)
use! rdr = cmd.ExecuteReaderAsync()
return toList (Map.toThemeAsset false) rdr return toList (Map.toThemeAsset false) rdr
} }
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData (themeId: ThemeId) = backgroundTask { let findByThemeWithData (themeId: ThemeId) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "ThemeAsset.findByThemeWithData"
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId" use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
addParam cmd "@themeId" (string themeId)
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset true) rdr return toList (Map.toThemeAsset true) rdr
} }
/// Save a theme asset /// Save a theme asset
let save (asset : ThemeAsset) = backgroundTask { let save (asset: ThemeAsset) = backgroundTask {
use sideCmd = conn.CreateCommand () log.LogTrace "ThemeAsset.save"
sideCmd.CommandText <- use sideCmd = conn.CreateCommand()
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" sideCmd.CommandText <- $"SELECT COUNT(*) FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId) addParam sideCmd "@themeId" themeId
sideCmd.Parameters.AddWithValue ("@path", path) addParam sideCmd "@path" path
] |> ignore
let! exists = count sideCmd let! exists = count sideCmd
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- cmd.CommandText <-
if exists = 1 then if exists = 1 then
"UPDATE theme_asset $"UPDATE {Table.ThemeAsset}
SET updated_on = @updatedOn, SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength) data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId WHERE theme_id = @themeId
AND path = @path" AND path = @path"
else else
"INSERT INTO theme_asset ( $"INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength) @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)" )"
[ cmd.Parameters.AddWithValue ("@themeId", themeId) addParam cmd "@themeId" themeId
cmd.Parameters.AddWithValue ("@path", path) addParam cmd "@path" path
cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn) addParam cmd "@updatedOn" (instantParam asset.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) addParam cmd "@dataLength" asset.Data.Length
] |> ignore
do! write cmd do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" sideCmd.CommandText <- $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync () let! rowId = sideCmd.ExecuteScalarAsync()
use dataStream = new MemoryStream (asset.Data) use dataStream = new MemoryStream(asset.Data)
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64) use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }
interface IThemeAssetData with interface IThemeAssetData with
member _.All () = all () member _.All() = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId member _.FindByTheme themeId = findByTheme themeId

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

@ -2,92 +2,100 @@ namespace MyWebLog.Data.SQLite
open System.IO open System.IO
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteUploadData(conn: SqliteConnection) = type SQLiteUploadData(conn: SqliteConnection, log: ILogger) =
/// Add parameters for uploaded file INSERT and UPDATE statements /// Add parameters for uploaded file INSERT and UPDATE statements
let addUploadParameters (cmd: SqliteCommand) (upload: Upload) = let addUploadParameters (cmd: SqliteCommand) (upload: Upload) =
[ cmd.Parameters.AddWithValue ("@id", string upload.Id) addParam cmd "@id" (string upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", string upload.WebLogId) addParam cmd "@webLogId" (string upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", string upload.Path) addParam cmd "@path" (string upload.Path)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn) addParam cmd "@updatedOn" (instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) addParam cmd "@dataLength" upload.Data.Length
] |> ignore
/// Save an uploaded file /// Save an uploaded file
let add upload = backgroundTask { let add upload = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Upload.add"
use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <-
"INSERT INTO upload ( $"INSERT INTO {Table.Upload} (
id, web_log_id, path, updated_on, data id, web_log_id, path, updated_on, data
) VALUES ( ) VALUES (
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
)" )"
addUploadParameters cmd upload addUploadParameters cmd upload
do! write cmd do! write cmd
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id" cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id"
let! rowId = cmd.ExecuteScalarAsync () let! rowId = cmd.ExecuteScalarAsync()
use dataStream = new MemoryStream (upload.Data) use dataStream = new MemoryStream(upload.Data)
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64) use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream do! dataStream.CopyToAsync blobStream
} }
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask { let delete (uploadId: UploadId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Upload.delete"
use cmd = conn.CreateCommand()
cmd.CommandText <- cmd.CommandText <-
"SELECT id, web_log_id, path, updated_on $"SELECT id, web_log_id, path, updated_on
FROM upload FROM {Table.Upload}
WHERE id = @id WHERE id = @id
AND web_log_id = @webLogId" AND web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", string uploadId) |> ignore addDocId cmd uploadId
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync()
if (rdr.Read ()) then let! isFound = rdr.ReadAsync()
if isFound then
let upload = Map.toUpload false rdr let upload = Map.toUpload false rdr
do! rdr.CloseAsync () do! rdr.CloseAsync()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" cmd.CommandText <- $"DELETE FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
do! write cmd do! write cmd
return Ok (string upload.Path) return Ok (string upload.Path)
else else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" return Error $"""Upload ID {cmd.Parameters["@id"].Value} not found"""
} }
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask { let findByPath (path: string) webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Upload.findByPath"
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path" use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@path", path) |> ignore addParam cmd "@path" path
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (Map.toUpload true rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.toUpload true rdr) else None
} }
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "Upload.findByWebLog"
cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId" use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync()
return toList (Map.toUpload false) rdr return toList (Map.toUpload false) rdr
} }
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = backgroundTask { let findByWebLogWithData webLogId = backgroundTask {
log.LogTrace "Upload.findByWebLogWithData"
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId" cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId addWebLogId cmd webLogId
let! rdr = cmd.ExecuteReaderAsync () let! rdr = cmd.ExecuteReaderAsync()
return toList (Map.toUpload true) rdr return toList (Map.toUpload true) rdr
} }
/// Restore uploads from a backup /// Restore uploads from a backup
let restore uploads = backgroundTask { let restore uploads = backgroundTask {
log.LogTrace "Upload.restore"
for upload in uploads do do! add upload for upload in uploads do do! add upload
} }

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

@ -2,263 +2,78 @@ namespace MyWebLog.Data.SQLite
open System.Threading.Tasks open System.Threading.Tasks
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json open Newtonsoft.Json
// The web log podcast insert loop is not statically compilable; this is OK
#nowarn "3511"
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer) = type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
// SUPPORT FUNCTIONS
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd: SqliteCommand) (webLog: WebLog) =
[ cmd.Parameters.AddWithValue ("@id", string webLog.Id)
cmd.Parameters.AddWithValue ("@name", webLog.Name)
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
cmd.Parameters.AddWithValue ("@themeId", string webLog.ThemeId)
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
cmd.Parameters.AddWithValue ("@uploads", string webLog.Uploads)
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add parameters for custom feed INSERT or UPDATE statements
let addCustomFeedParameters (cmd: SqliteCommand) (webLogId: WebLogId) (feed: CustomFeed) =
[ cmd.Parameters.AddWithValue ("@id", string feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", string webLogId)
cmd.Parameters.AddWithValue ("@source", string feed.Source)
cmd.Parameters.AddWithValue ("@path", string feed.Path)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))
] |> ignore
/// Shorthand to map a data reader to a custom feed
let toCustomFeed =
Map.toCustomFeed ser
/// Get the current custom feeds for a web log
let getCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
addWebLogId cmd webLog.Id
use! rdr = cmd.ExecuteReaderAsync ()
return toList toCustomFeed rdr
}
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
}
/// Update the custom feeds for a web log
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
let! feeds = getCustomFeeds webLog
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds string
let toId (feed : CustomFeed) = feed.Id
let toUpdate =
webLog.Rss.CustomFeeds
|> List.filter (fun f ->
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
use cmd = conn.CreateCommand ()
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
toDelete
|> List.map (fun it -> backgroundTask {
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
cmd.Parameters["@id"].Value <- string it.Id
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.Parameters.Clear ()
toAdd
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"INSERT INTO web_log_feed (
id, web_log_id, source, path, podcast
) VALUES (
@id, @webLogId, @source, @path, @podcast
)"
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
})
|> Task.WhenAll
|> ignore
toUpdate
|> List.map (fun it -> backgroundTask {
cmd.CommandText <-
"UPDATE web_log_feed
SET source = @source,
path = @path,
podcast = @podcast
WHERE id = @id
AND web_log_id = @webLogId"
cmd.Parameters.Clear ()
addCustomFeedParameters cmd webLog.Id it
do! write cmd
})
|> Task.WhenAll
|> ignore
}
// IMPLEMENTATION FUNCTIONS
/// Add a web log /// Add a web log
let add webLog = backgroundTask { let add webLog =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.add"
cmd.CommandText <- Document.insert<WebLog> conn ser Table.WebLog webLog
"INSERT INTO web_log (
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright,
redirect_rules
) VALUES (
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright,
@redirectRules
)"
addWebLogParameters cmd webLog
do! write cmd
do! updateCustomFeeds webLog
}
/// Retrieve all web logs /// Retrieve all web logs
let all () = backgroundTask { let all () =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.all"
cmd.CommandText <- "SELECT * FROM web_log" use cmd = conn.CreateCommand()
use! rdr = cmd.ExecuteReaderAsync () cmd.CommandText <- Query.selectFromTable Table.WebLog
let! webLogs = cmdToList<WebLog> cmd ser
toList (Map.toWebLog ser) rdr
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|> Task.WhenAll
return List.ofArray webLogs
}
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLog.delete"
addWebLogId cmd webLogId let idField = "data ->> 'WebLogId'"
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {idField} = @webLogId)"
let postSubQuery = subQuery "post" use cmd = conn.CreateCommand()
let pageSubQuery = subQuery "page"
cmd.CommandText <- $" cmd.CommandText <- $"
DELETE FROM post_comment WHERE post_id IN {postSubQuery}; DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
DELETE FROM post_revision WHERE post_id IN {postSubQuery}; DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
DELETE FROM post_tag WHERE post_id IN {postSubQuery}; DELETE FROM {Table.Post} WHERE {idField} = @webLogId;
DELETE FROM post_category WHERE post_id IN {postSubQuery}; DELETE FROM {Table.Page} WHERE {idField} = @webLogId;
DELETE FROM post WHERE web_log_id = @webLogId; DELETE FROM {Table.Category} WHERE {idField} = @webLogId;
DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; DELETE FROM {Table.TagMap} WHERE {idField} = @webLogId;
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery}; DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM page WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLogUser} WHERE {idField} = @webLogId;
DELETE FROM category WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLog} WHERE id = @webLogId"
DELETE FROM tag_map WHERE web_log_id = @webLogId; addWebLogId cmd webLogId
DELETE FROM upload WHERE web_log_id = @webLogId;
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
DELETE FROM web_log WHERE id = @webLogId"
do! write cmd do! write cmd
} }
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url : string) = backgroundTask { let findByHost (url: string) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLog.findByHost"
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase" use cmd = conn.CreateCommand()
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore cmd.CommandText <-
use! rdr = cmd.ExecuteReaderAsync () $"{Query.selectFromTable Table.WebLog} WHERE data ->> '{nameof WebLog.Empty.UrlBase}' = @urlBase"
if rdr.Read () then addParam cmd "@urlBase" url
let! webLog = appendCustomFeeds (Map.toWebLog ser rdr) use! rdr = cmd.ExecuteReaderAsync()
return Some webLog let! isFound = rdr.ReadAsync()
else return if isFound then Some (Map.fromDoc<WebLog> ser rdr) else None
return None
} }
/// Find a web log by its ID /// Find a web log by its ID
let findById webLogId = backgroundTask { let findById webLogId =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.findById"
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId" Document.findById<WebLogId, WebLog> conn ser Table.WebLog webLogId
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
return Some webLog
else
return None
}
/// Update redirect rules for a web log /// Update redirect rules for a web log
let updateRedirectRules webLog = backgroundTask { let updateRedirectRules (webLog: WebLog) =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.updateRedirectRules"
cmd.CommandText <- "UPDATE web_log SET redirect_rules = @redirectRules WHERE id = @id" Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.RedirectRules) webLog.RedirectRules
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules) |> ignore
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
do! write cmd
}
/// Update RSS options for a web log /// Update RSS options for a web log
let updateRssOptions webLog = backgroundTask { let updateRssOptions (webLog: WebLog) =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.updateRssOptions"
cmd.CommandText <- Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.Rss) webLog.Rss
"UPDATE web_log
SET is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright
WHERE id = @id"
addWebLogRssParameters cmd webLog
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
do! write cmd
do! updateCustomFeeds webLog
}
/// Update settings for a web log /// Update settings for a web log
let updateSettings webLog = backgroundTask { let updateSettings (webLog: WebLog) =
use cmd = conn.CreateCommand () log.LogTrace "WebLog.updateSettings"
cmd.CommandText <- Document.update conn ser Table.WebLog webLog.Id webLog
"UPDATE web_log
SET name = @name,
slug = @slug,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
uploads = @uploads,
is_feed_enabled = @isFeedEnabled,
feed_name = @feedName,
items_in_feed = @itemsInFeed,
is_category_enabled = @isCategoryEnabled,
is_tag_enabled = @isTagEnabled,
copyright = @copyright,
redirect_rules = @redirectRules
WHERE id = @id"
addWebLogParameters cmd webLog
do! write cmd
}
interface IWebLogData with interface IWebLogData with
member _.Add webLog = add webLog member _.Add webLog = add webLog

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

@ -1,11 +1,13 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog user data implementation /// SQLite myWebLog user data implementation
type SQLiteWebLogUserData(conn: SqliteConnection) = type SQLiteWebLogUserData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
// SUPPORT FUNCTIONS // SUPPORT FUNCTIONS
@ -27,119 +29,94 @@ type SQLiteWebLogUserData(conn: SqliteConnection) =
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Add a user /// Add a user
let add user = backgroundTask { let add user =
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.add"
cmd.CommandText <- Document.insert<WebLogUser> conn ser Table.WebLogUser user
"INSERT INTO web_log_user (
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
created_on, last_seen_on
) VALUES (
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
@createdOn, @lastSeenOn
)"
addWebLogUserParameters cmd user
do! write cmd
}
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById (userId: WebLogUserId) webLogId = backgroundTask { let findById userId webLogId =
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.findById"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id" Document.findByIdAndWebLog<WebLogUserId, WebLogUser> conn ser Table.WebLogUser userId webLogId
cmd.Parameters.AddWithValue ("@id", string userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<WebLogUser> webLogId (_.WebLogId) Map.toWebLogUser rdr
}
/// Delete a user if they have no posts or pages /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.delete"
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId" cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Page} WHERE data ->> 'AuthorId' = @id"
cmd.Parameters.AddWithValue ("@userId", string userId) |> ignore addDocId cmd userId
let! pageCount = count cmd let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId" cmd.CommandText <- cmd.CommandText.Replace($"FROM {Table.Page}", $"FROM {Table.Post}")
let! postCount = count cmd let! postCount = count cmd
if pageCount + postCount > 0 then if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId" do! Document.delete conn Table.WebLogUser userId
let! _ = cmd.ExecuteNonQueryAsync ()
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email : string) webLogId = backgroundTask { let findByEmail (email: string) webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.findByEmail"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email" use cmd = conn.CreateCommand()
cmd.CommandText <- $"
{Query.selectFromTable Table.WebLogUser}
WHERE {Query.whereByWebLog}
AND data ->> '{nameof WebLogUser.Empty.Email}' = @email"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@email", email) |> ignore addParam cmd "@email" email
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync()
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<WebLogUser> ser rdr) else None
} }
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.findByWebLog"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)" let! users = Document.findByWebLog<WebLogUser> conn ser Table.WebLogUser webLogId
addWebLogId cmd webLogId return users |> List.sortBy _.PreferredName.ToLowerInvariant()
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toWebLogUser rdr
} }
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask { let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.findNames"
let nameSql, nameParams = inClause "AND id" "id" string userIds use cmd = conn.CreateCommand()
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}" let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds
cmd.CommandText <- $"{Query.selectFromTable Table.WebLogUser} WHERE {Query.whereByWebLog} {nameSql}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddRange nameParams cmd.Parameters.AddRange nameParams
use! rdr = cmd.ExecuteReaderAsync () let! users = cmdToList<WebLogUser> cmd ser
return toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
} }
/// Restore users from a backup /// Restore users from a backup
let restore users = backgroundTask { let restore users = backgroundTask {
log.LogTrace "WebLogUser.restore"
for user in users do for user in users do
do! add user do! add user
} }
/// Set a user's last seen date/time to now /// Set a user's last seen date/time to now
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask { let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.setLastSeen"
cmd.CommandText <- use cmd = conn.CreateCommand()
"UPDATE web_log_user cmd.CommandText <- $"
SET last_seen_on = @lastSeenOn UPDATE {Table.WebLogUser}
WHERE id = @id SET data = json_set(data, '$.{nameof WebLogUser.Empty.LastSeenOn}', @lastSeenOn)
AND web_log_id = @webLogId" WHERE {Query.whereById}
AND {Query.whereByWebLog}"
addDocId cmd userId
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@id", string userId) addParam cmd "@lastSeenOn" (instantParam (Noda.now ()))
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) do! write cmd
] |> ignore
let! _ = cmd.ExecuteNonQueryAsync ()
()
} }
/// Update a user /// Update a user
let update user = backgroundTask { let update (user: WebLogUser) =
use cmd = conn.CreateCommand () log.LogTrace "WebLogUser.update"
cmd.CommandText <- Document.update conn ser Table.WebLogUser user.Id user
"UPDATE web_log_user
SET email = @email,
first_name = @firstName,
last_name = @lastName,
preferred_name = @preferredName,
password_hash = @passwordHash,
url = @url,
access_level = @accessLevel,
created_on = @createdOn,
last_seen_on = @lastSeenOn
WHERE id = @id
AND web_log_id = @webLogId"
addWebLogUserParameters cmd user
do! write cmd
}
interface IWebLogUserData with interface IWebLogUserData with
member _.Add user = add user member _.Add user = add user

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

@ -474,11 +474,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
member _.Page = SQLitePageData (conn, ser, log) member _.Page = SQLitePageData (conn, ser, log)
member _.Post = SQLitePostData (conn, ser, log) member _.Post = SQLitePostData (conn, ser, log)
member _.TagMap = SQLiteTagMapData (conn, ser, log) member _.TagMap = SQLiteTagMapData (conn, ser, log)
member _.Theme = SQLiteThemeData conn member _.Theme = SQLiteThemeData (conn, ser, log)
member _.ThemeAsset = SQLiteThemeAssetData conn member _.ThemeAsset = SQLiteThemeAssetData (conn, log)
member _.Upload = SQLiteUploadData conn member _.Upload = SQLiteUploadData (conn, log)
member _.WebLog = SQLiteWebLogData (conn, ser) member _.WebLog = SQLiteWebLogData (conn, ser, log)
member _.WebLogUser = SQLiteWebLogUserData conn member _.WebLogUser = SQLiteWebLogUserData (conn, ser, log)
member _.Serializer = ser member _.Serializer = ser