From e04c8b58e9d824bb708d6f54a41505387075528c Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 17 Dec 2023 23:00:57 -0500 Subject: [PATCH] First cut of SQLite JSON doc complete - Still needs testing - Add revision deletes to PG web log delete --- .../Postgres/PostgresWebLogData.fs | 8 +- src/MyWebLog.Data/SQLite/Helpers.fs | 112 ++----- src/MyWebLog.Data/SQLite/SQLitePageData.fs | 9 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 9 +- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 230 ++++++--------- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 84 +++--- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 277 +++--------------- .../SQLite/SQLiteWebLogUserData.fs | 121 ++++---- src/MyWebLog.Data/SQLiteData.fs | 10 +- 9 files changed, 260 insertions(+), 600 deletions(-) diff --git a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs index 5c8eb0e..60ed13c 100644 --- a/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresWebLogData.fs @@ -23,8 +23,12 @@ type PostgresWebLogData(log: ILogger) = log.LogTrace "WebLog.delete" Custom.nonQuery $"""DELETE FROM {Table.PostComment} - WHERE data ->> '{nameof Comment.Empty.PostId}' IN - (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"}); + WHERE data ->> '{nameof Comment.Empty.PostId}' + 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.Page}; {Query.Delete.byContains Table.Category}; diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 9ebabeb..e5357bd 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -168,16 +168,6 @@ module Map = /// Get a string value from a data reader let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col) - /// Parse a Duration from the given value - let parseDuration value = - match DurationPattern.Roundtrip.Parse value with - | it when it.Success -> it.Value - | it -> raise it.Exception - - /// Get a Duration value from a data reader - let getDuration col rdr = - getString col rdr |> parseDuration - /// Parse an Instant from the given value let parseInstant value = match InstantPattern.General.Parse value with @@ -211,29 +201,10 @@ module Map = let tryString col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr) - /// Get a possibly null Duration value from a data reader - let tryDuration col rdr = - tryString col rdr |> Option.map parseDuration - - /// Get a possibly null Instant value from a data reader - let tryInstant col rdr = - tryString col rdr |> Option.map parseInstant - /// Get a possibly null timespan value from a data reader let tryTimeSpan col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) - /// 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 let toPermalink rdr = getString "permalink" rdr |> Permalink @@ -242,22 +213,6 @@ module Map = { AsOf = getInstant "as_of" rdr Text = getString "revision_text" rdr |> MarkupText.Parse } - /// Create a tag mapping from the current row in the given data reader - 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 let toThemeAsset includeData rdr : ThemeAsset = let assetData = @@ -272,12 +227,6 @@ module Map = UpdatedOn = getInstant "updated_on" rdr 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 let toUpload includeData rdr : Upload = let data = @@ -294,46 +243,6 @@ module Map = UpdatedOn = getInstant "updated_on" rdr 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 let fromData<'T> ser rdr fieldName : 'T = Utils.deserialize<'T> ser (getString fieldName rdr) @@ -409,6 +318,16 @@ module Document = 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 let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask { use cmd = conn.CreateCommand() @@ -444,6 +363,17 @@ module Document = 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 let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask { use cmd = conn.CreateCommand() diff --git a/src/MyWebLog.Data/SQLite/SQLitePageData.fs b/src/MyWebLog.Data/SQLite/SQLitePageData.fs index 277e53f..a97c362 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePageData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePageData.fs @@ -186,14 +186,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = log.LogTrace "Page.updatePriorPermalinks" match! findById pageId webLogId with | Some _ -> - use cmd = conn.CreateCommand() - 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 + do! Document.updateField conn ser Table.Page pageId (nameof Page.Empty.PriorPermalinks) permalinks return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index dc26393..b6f82a7 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -224,14 +224,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask { match! findById postId webLogId with | Some _ -> - use cmd = conn.CreateCommand() - 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 + do! Document.updateField conn ser Table.Post postId (nameof Post.Empty.PriorPermalinks) permalinks return true | None -> return false } diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index ff5403b..5d78177 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -1,77 +1,62 @@ namespace MyWebLog.Data.SQLite -open System.Threading.Tasks open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data +open Newtonsoft.Json -/// SQLite myWebLog theme data implementation -type SQLiteThemeData (conn : SqliteConnection) = +/// SQLite myWebLog theme data implementation +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) let all () = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id" - use! rdr = cmd.ExecuteReaderAsync () - let themes = toList Map.toTheme rdr - do! rdr.CloseAsync () - 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 }) + log.LogTrace "Theme.all" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}" + let! themes = cmdToList cmd ser + return themes |> List.map withoutTemplateText } /// Does a given theme exist? let exists (themeId: ThemeId) = backgroundTask { + log.LogTrace "Theme.exists" use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore + cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Theme} WHERE {idField} = @id" + addDocId cmd themeId let! count = count cmd return count > 0 } /// Find a theme by its ID - let findById (themeId: ThemeId) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM theme WHERE id = @id" - 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 - } + let findById themeId = + log.LogTrace "Theme.findById" + Document.findById conn ser Table.Theme themeId /// Find a theme by its ID (excludes the text of templates) let findByIdWithoutText themeId = backgroundTask { - match! findById themeId with - | Some theme -> - return Some { - theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" }) - } - | None -> return None + log.LogTrace "Theme.findByIdWithoutText" + let! theme = findById themeId + return theme |> Option.map withoutTemplateText } /// Delete a theme by its ID let delete themeId = backgroundTask { + log.LogTrace "Theme.delete" match! findByIdWithoutText themeId with | Some _ -> - use cmd = conn.CreateCommand () - cmd.CommandText <- - "DELETE FROM theme_asset WHERE theme_id = @id; - DELETE FROM theme_template WHERE theme_id = @id; - DELETE FROM theme WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; + DELETE FROM {Table.Theme} WHERE {Query.whereById}" + addDocId cmd themeId do! write cmd return true | None -> return false @@ -79,62 +64,14 @@ type SQLiteThemeData (conn : SqliteConnection) = /// Save a theme let save (theme: Theme) = backgroundTask { - use cmd = conn.CreateCommand() - let! oldTheme = findById theme.Id - cmd.CommandText <- - match oldTheme with - | Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id" - | None -> "INSERT INTO theme VALUES (@id, @name, @version)" - [ cmd.Parameters.AddWithValue ("@id", 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 + log.LogTrace "Theme.save" + match! findById theme.Id with + | Some _ -> do! Document.update conn ser Table.Theme theme.Id theme + | None -> do! Document.insert conn ser Table.Theme theme } interface IThemeData with - member _.All () = all () + member _.All() = all () member _.Delete themeId = delete themeId member _.Exists themeId = exists themeId member _.FindById themeId = findById themeId @@ -144,97 +81,100 @@ type SQLiteThemeData (conn : SqliteConnection) = open System.IO -/// SQLite myWebLog theme data implementation -type SQLiteThemeAssetData (conn : SqliteConnection) = +/// SQLite myWebLog theme data implementation +type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) = /// Get all theme assets (excludes data) let all () = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset" - use! rdr = cmd.ExecuteReaderAsync () + log.LogTrace "ThemeAsset.all" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" + use! rdr = cmd.ExecuteReaderAsync() return toList (Map.toThemeAsset false) rdr } /// Delete all assets for the given theme let deleteByTheme (themeId: ThemeId) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId" - cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore + log.LogTrace "ThemeAsset.deleteByTheme" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId" + addParam cmd "@themeId" (string themeId) do! write cmd } /// Find a theme asset by its ID let findById assetId = backgroundTask { + log.LogTrace "ThemeAsset.findById" 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 - [ cmd.Parameters.AddWithValue ("@themeId", themeId) - cmd.Parameters.AddWithValue ("@path", path) - ] |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None + addParam cmd "@themeId" themeId + addParam cmd "@path" path + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.toThemeAsset true rdr) else None } /// Get theme assets for the given theme (excludes data) let findByTheme (themeId: ThemeId) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId" - cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore - use! rdr = cmd.ExecuteReaderAsync () + log.LogTrace "ThemeAsset.findByTheme" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId" + addParam cmd "@themeId" (string themeId) + use! rdr = cmd.ExecuteReaderAsync() return toList (Map.toThemeAsset false) rdr } /// Get theme assets for the given theme let findByThemeWithData (themeId: ThemeId) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId" - cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore + log.LogTrace "ThemeAsset.findByThemeWithData" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId" + addParam cmd "@themeId" (string themeId) use! rdr = cmd.ExecuteReaderAsync () return toList (Map.toThemeAsset true) rdr } /// Save a theme asset - let save (asset : ThemeAsset) = backgroundTask { - use sideCmd = conn.CreateCommand () - sideCmd.CommandText <- - "SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path" + let save (asset: ThemeAsset) = backgroundTask { + log.LogTrace "ThemeAsset.save" + use sideCmd = conn.CreateCommand() + sideCmd.CommandText <- $"SELECT COUNT(*) FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" let (ThemeAssetId (ThemeId themeId, path)) = asset.Id - [ sideCmd.Parameters.AddWithValue ("@themeId", themeId) - sideCmd.Parameters.AddWithValue ("@path", path) - ] |> ignore + addParam sideCmd "@themeId" themeId + addParam sideCmd "@path" path let! exists = count sideCmd use cmd = conn.CreateCommand () cmd.CommandText <- if exists = 1 then - "UPDATE theme_asset - SET updated_on = @updatedOn, - data = ZEROBLOB(@dataLength) - WHERE theme_id = @themeId - AND path = @path" + $"UPDATE {Table.ThemeAsset} + SET updated_on = @updatedOn, + data = ZEROBLOB(@dataLength) + WHERE theme_id = @themeId + AND path = @path" else - "INSERT INTO theme_asset ( + $"INSERT INTO {Table.ThemeAsset} ( theme_id, path, updated_on, data - ) VALUES ( + ) VALUES ( @themeId, @path, @updatedOn, ZEROBLOB(@dataLength) - )" - [ cmd.Parameters.AddWithValue ("@themeId", themeId) - cmd.Parameters.AddWithValue ("@path", path) - cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn) - cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length) - ] |> ignore + )" + addParam cmd "@themeId" themeId + addParam cmd "@path" path + addParam cmd "@updatedOn" (instantParam asset.UpdatedOn) + addParam cmd "@dataLength" asset.Data.Length do! write cmd - sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path" - let! rowId = sideCmd.ExecuteScalarAsync () + sideCmd.CommandText <- $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" + let! rowId = sideCmd.ExecuteScalarAsync() - use dataStream = new MemoryStream (asset.Data) - use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64) + use dataStream = new MemoryStream(asset.Data) + use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId :?> int64) do! dataStream.CopyToAsync blobStream } interface IThemeAssetData with - member _.All () = all () + member _.All() = all () member _.DeleteByTheme themeId = deleteByTheme themeId member _.FindById assetId = findById assetId member _.FindByTheme themeId = findByTheme themeId diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index cf915ae..9a7cd82 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -2,92 +2,100 @@ namespace MyWebLog.Data.SQLite open System.IO open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data /// 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 let addUploadParameters (cmd: SqliteCommand) (upload: Upload) = - [ cmd.Parameters.AddWithValue ("@id", string upload.Id) - cmd.Parameters.AddWithValue ("@webLogId", string upload.WebLogId) - cmd.Parameters.AddWithValue ("@path", string upload.Path) - cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn) - cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) - ] |> ignore + addParam cmd "@id" (string upload.Id) + addParam cmd "@webLogId" (string upload.WebLogId) + addParam cmd "@path" (string upload.Path) + addParam cmd "@updatedOn" (instantParam upload.UpdatedOn) + addParam cmd "@dataLength" upload.Data.Length /// Save an uploaded file let add upload = backgroundTask { - use cmd = conn.CreateCommand () + log.LogTrace "Upload.add" + use cmd = conn.CreateCommand() cmd.CommandText <- - "INSERT INTO upload ( + $"INSERT INTO {Table.Upload} ( id, web_log_id, path, updated_on, data - ) VALUES ( + ) 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 () + cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" + let! rowId = cmd.ExecuteScalarAsync() - use dataStream = new MemoryStream (upload.Data) - use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64) + use dataStream = new MemoryStream(upload.Data) + use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId :?> int64) do! dataStream.CopyToAsync blobStream } /// Delete an uploaded file by its ID - let delete uploadId webLogId = backgroundTask { - use cmd = conn.CreateCommand () + let delete (uploadId: UploadId) webLogId = backgroundTask { + log.LogTrace "Upload.delete" + use cmd = conn.CreateCommand() cmd.CommandText <- - "SELECT id, web_log_id, path, updated_on - FROM upload - WHERE id = @id - AND web_log_id = @webLogId" + $"SELECT id, web_log_id, path, updated_on + FROM {Table.Upload} + WHERE id = @id + AND web_log_id = @webLogId" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@id", string uploadId) |> ignore - let! rdr = cmd.ExecuteReaderAsync () - if (rdr.Read ()) then + addDocId cmd uploadId + let! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + if isFound then let upload = Map.toUpload false rdr - do! rdr.CloseAsync () - cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" + do! rdr.CloseAsync() + cmd.CommandText <- $"DELETE FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId" do! write cmd return Ok (string upload.Path) 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 - let findByPath (path : string) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path" + let findByPath (path: string) webLogId = backgroundTask { + log.LogTrace "Upload.findByPath" + use cmd = conn.CreateCommand() + cmd.CommandText <- $"SELECT *, ROWID FROM {Table.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 true rdr) else None + addParam cmd "@path" path + let! rdr = cmd.ExecuteReaderAsync() + 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) let findByWebLog webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId" + log.LogTrace "Upload.findByWebLog" + 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 - let! rdr = cmd.ExecuteReaderAsync () + let! rdr = cmd.ExecuteReaderAsync() return toList (Map.toUpload false) rdr } /// Find all uploaded files for the given web log let findByWebLogWithData webLogId = backgroundTask { + log.LogTrace "Upload.findByWebLogWithData" 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 - let! rdr = cmd.ExecuteReaderAsync () + let! rdr = cmd.ExecuteReaderAsync() return toList (Map.toUpload true) rdr } /// Restore uploads from a backup let restore uploads = backgroundTask { + log.LogTrace "Upload.restore" for upload in uploads do do! add upload } diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index ea2b4ea..ebd7925 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -2,263 +2,78 @@ namespace MyWebLog.Data.SQLite open System.Threading.Tasks open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data open Newtonsoft.Json -// The web log podcast insert loop is not statically compilable; this is OK -#nowarn "3511" - /// SQLite myWebLog web log data implementation -type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer) = - - // SUPPORT FUNCTIONS - - /// Add parameters for web log INSERT or web log/RSS options UPDATE statements - let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) = - [ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled) - cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName) - cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed) - cmd.Parameters.AddWithValue ("@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 +type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = /// Add a web log - let add webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "INSERT INTO web_log ( - id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx, - uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright, - 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 - } + let add webLog = + log.LogTrace "WebLog.add" + Document.insert conn ser Table.WebLog webLog /// Retrieve all web logs - let all () = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log" - use! rdr = cmd.ExecuteReaderAsync () - let! webLogs = - toList (Map.toWebLog ser) rdr - |> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog }) - |> Task.WhenAll - return List.ofArray webLogs - } + let all () = + log.LogTrace "WebLog.all" + use cmd = conn.CreateCommand() + cmd.CommandText <- Query.selectFromTable Table.WebLog + cmdToList cmd ser /// Delete a web log by its ID let delete webLogId = backgroundTask { - use cmd = conn.CreateCommand () - addWebLogId cmd webLogId - let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)" - let postSubQuery = subQuery "post" - let pageSubQuery = subQuery "page" + log.LogTrace "WebLog.delete" + let idField = "data ->> 'WebLogId'" + let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {idField} = @webLogId)" + use cmd = conn.CreateCommand() cmd.CommandText <- $" - DELETE FROM post_comment WHERE post_id IN {postSubQuery}; - DELETE FROM post_revision WHERE post_id IN {postSubQuery}; - DELETE FROM post_permalink WHERE post_id IN {postSubQuery}; - DELETE FROM post_tag WHERE post_id IN {postSubQuery}; - DELETE FROM post_category WHERE post_id IN {postSubQuery}; - DELETE FROM post WHERE web_log_id = @webLogId; - DELETE FROM page_revision WHERE page_id IN {pageSubQuery}; - DELETE FROM page_permalink WHERE page_id IN {pageSubQuery}; - DELETE FROM page WHERE web_log_id = @webLogId; - DELETE FROM category WHERE web_log_id = @webLogId; - DELETE FROM tag_map WHERE web_log_id = @webLogId; - DELETE FROM upload WHERE web_log_id = @webLogId; - DELETE FROM web_log_user WHERE web_log_id = @webLogId; - DELETE FROM web_log_feed WHERE web_log_id = @webLogId; - DELETE FROM web_log WHERE id = @webLogId" + DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post}; + DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post}; + DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page}; + DELETE FROM {Table.Post} WHERE {idField} = @webLogId; + DELETE FROM {Table.Page} WHERE {idField} = @webLogId; + DELETE FROM {Table.Category} WHERE {idField} = @webLogId; + DELETE FROM {Table.TagMap} WHERE {idField} = @webLogId; + DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; + DELETE FROM {Table.WebLogUser} WHERE {idField} = @webLogId; + DELETE FROM {Table.WebLog} WHERE id = @webLogId" + addWebLogId cmd webLogId do! write cmd } /// Find a web log by its host (URL base) - let findByHost (url : string) = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase" - cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! webLog = appendCustomFeeds (Map.toWebLog ser rdr) - return Some webLog - else - return None + let findByHost (url: string) = backgroundTask { + log.LogTrace "WebLog.findByHost" + use cmd = conn.CreateCommand() + cmd.CommandText <- + $"{Query.selectFromTable Table.WebLog} WHERE data ->> '{nameof WebLog.Empty.UrlBase}' = @urlBase" + addParam cmd "@urlBase" url + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc ser rdr) else None } /// Find a web log by its ID - let findById webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId" - addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - if rdr.Read () then - let! webLog = appendCustomFeeds (Map.toWebLog ser rdr) - return Some webLog - else - return None - } + let findById webLogId = + log.LogTrace "WebLog.findById" + Document.findById conn ser Table.WebLog webLogId /// Update redirect rules for a web log - let updateRedirectRules webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "UPDATE web_log SET redirect_rules = @redirectRules WHERE id = @id" - cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules) |> ignore - cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore - do! write cmd - } + let updateRedirectRules (webLog: WebLog) = + log.LogTrace "WebLog.updateRedirectRules" + Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.RedirectRules) webLog.RedirectRules /// Update RSS options for a web log - let updateRssOptions webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE web_log - SET is_feed_enabled = @isFeedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - is_category_enabled = @isCategoryEnabled, - is_tag_enabled = @isTagEnabled, - copyright = @copyright - WHERE id = @id" - addWebLogRssParameters cmd webLog - cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore - do! write cmd - do! updateCustomFeeds webLog - } + let updateRssOptions (webLog: WebLog) = + log.LogTrace "WebLog.updateRssOptions" + Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.Rss) webLog.Rss /// Update settings for a web log - let updateSettings webLog = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE web_log - SET name = @name, - slug = @slug, - subtitle = @subtitle, - default_page = @defaultPage, - posts_per_page = @postsPerPage, - theme_id = @themeId, - url_base = @urlBase, - time_zone = @timeZone, - auto_htmx = @autoHtmx, - uploads = @uploads, - is_feed_enabled = @isFeedEnabled, - feed_name = @feedName, - items_in_feed = @itemsInFeed, - is_category_enabled = @isCategoryEnabled, - is_tag_enabled = @isTagEnabled, - copyright = @copyright, - redirect_rules = @redirectRules - WHERE id = @id" - addWebLogParameters cmd webLog - do! write cmd - } + let updateSettings (webLog: WebLog) = + log.LogTrace "WebLog.updateSettings" + Document.update conn ser Table.WebLog webLog.Id webLog interface IWebLogData with member _.Add webLog = add webLog diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 7c0f242..f37de25 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -1,11 +1,13 @@ namespace MyWebLog.Data.SQLite open Microsoft.Data.Sqlite +open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data +open Newtonsoft.Json /// SQLite myWebLog user data implementation -type SQLiteWebLogUserData(conn: SqliteConnection) = +type SQLiteWebLogUserData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = // SUPPORT FUNCTIONS @@ -27,119 +29,94 @@ type SQLiteWebLogUserData(conn: SqliteConnection) = // IMPLEMENTATION FUNCTIONS /// Add a user - let add user = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "INSERT INTO web_log_user ( - id, web_log_id, email, first_name, last_name, preferred_name, password_hash, 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 - } + let add user = + log.LogTrace "WebLogUser.add" + Document.insert conn ser Table.WebLogUser user /// Find a user by their ID for the given web log - let findById (userId: WebLogUserId) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id" - cmd.Parameters.AddWithValue ("@id", string userId) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return verifyWebLog webLogId (_.WebLogId) Map.toWebLogUser rdr - } + let findById userId webLogId = + log.LogTrace "WebLogUser.findById" + Document.findByIdAndWebLog conn ser Table.WebLogUser userId webLogId /// Delete a user if they have no posts or pages let delete userId webLogId = backgroundTask { + log.LogTrace "WebLogUser.delete" match! findById userId webLogId with | Some _ -> - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId" - cmd.Parameters.AddWithValue ("@userId", string userId) |> ignore + use cmd = conn.CreateCommand() + cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Page} WHERE data ->> 'AuthorId' = @id" + addDocId cmd userId 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 if pageCount + postCount > 0 then return Error "User has pages or posts; cannot delete" else - cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId" - let! _ = cmd.ExecuteNonQueryAsync () + do! Document.delete conn Table.WebLogUser userId return Ok true | None -> return Error "User does not exist" } /// 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 email = @email" + let findByEmail (email: string) webLogId = backgroundTask { + log.LogTrace "WebLogUser.findByEmail" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + {Query.selectFromTable Table.WebLogUser} + WHERE {Query.whereByWebLog} + AND data ->> '{nameof WebLogUser.Empty.Email}' = @email" addWebLogId cmd webLogId - cmd.Parameters.AddWithValue ("@email", email) |> ignore - use! rdr = cmd.ExecuteReaderAsync () - return if rdr.Read () then Some (Map.toWebLogUser rdr) else None + addParam cmd "@email" email + use! rdr = cmd.ExecuteReaderAsync() + let! isFound = rdr.ReadAsync() + return if isFound then Some (Map.fromDoc ser rdr) else None } /// Get all users for the given web log let findByWebLog webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)" - addWebLogId cmd webLogId - use! rdr = cmd.ExecuteReaderAsync () - return toList Map.toWebLogUser rdr + log.LogTrace "WebLogUser.findByWebLog" + let! users = Document.findByWebLog conn ser Table.WebLogUser webLogId + return users |> List.sortBy _.PreferredName.ToLowerInvariant() } /// Find the names of users by their IDs for the given web log let findNames webLogId (userIds: WebLogUserId list) = backgroundTask { - use cmd = conn.CreateCommand () - let nameSql, nameParams = inClause "AND id" "id" string userIds - cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}" + log.LogTrace "WebLogUser.findNames" + use cmd = conn.CreateCommand() + let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds + cmd.CommandText <- $"{Query.selectFromTable Table.WebLogUser} WHERE {Query.whereByWebLog} {nameSql}" addWebLogId cmd webLogId cmd.Parameters.AddRange nameParams - use! rdr = cmd.ExecuteReaderAsync () - return toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) + let! users = cmdToList cmd ser + return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) } /// Restore users from a backup let restore users = backgroundTask { + log.LogTrace "WebLogUser.restore" for user in users do do! add user } /// Set a user's last seen date/time to now let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE web_log_user - SET last_seen_on = @lastSeenOn - WHERE id = @id - AND web_log_id = @webLogId" + log.LogTrace "WebLogUser.setLastSeen" + use cmd = conn.CreateCommand() + cmd.CommandText <- $" + UPDATE {Table.WebLogUser} + SET data = json_set(data, '$.{nameof WebLogUser.Empty.LastSeenOn}', @lastSeenOn) + WHERE {Query.whereById} + AND {Query.whereByWebLog}" + addDocId cmd userId addWebLogId cmd webLogId - [ cmd.Parameters.AddWithValue ("@id", string userId) - cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ())) - ] |> ignore - let! _ = cmd.ExecuteNonQueryAsync () - () + addParam cmd "@lastSeenOn" (instantParam (Noda.now ())) + do! write cmd } /// Update a user - let update user = backgroundTask { - use cmd = conn.CreateCommand () - cmd.CommandText <- - "UPDATE web_log_user - SET email = @email, - first_name = @firstName, - last_name = @lastName, - preferred_name = @preferredName, - password_hash = @passwordHash, - 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 - } + let update (user: WebLogUser) = + log.LogTrace "WebLogUser.update" + Document.update conn ser Table.WebLogUser user.Id user interface IWebLogUserData with member _.Add user = add user diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index af84359..7bb2616 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -474,11 +474,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria member _.Page = SQLitePageData (conn, ser, log) member _.Post = SQLitePostData (conn, ser, log) member _.TagMap = SQLiteTagMapData (conn, ser, log) - member _.Theme = SQLiteThemeData conn - member _.ThemeAsset = SQLiteThemeAssetData conn - member _.Upload = SQLiteUploadData conn - member _.WebLog = SQLiteWebLogData (conn, ser) - member _.WebLogUser = SQLiteWebLogUserData conn + member _.Theme = SQLiteThemeData (conn, ser, log) + member _.ThemeAsset = SQLiteThemeAssetData (conn, log) + member _.Upload = SQLiteUploadData (conn, log) + member _.WebLog = SQLiteWebLogData (conn, ser, log) + member _.WebLogUser = SQLiteWebLogUserData (conn, ser, log) member _.Serializer = ser