From f461b10ebc8d49721993cbff0ae78a3015091e49 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 19 Dec 2023 21:24:13 -0500 Subject: [PATCH] First cut of SQLite doc library --- .../Postgres/PostgresTagMapData.fs | 1 + src/MyWebLog.Data/SQLite/Helpers.fs | 166 ++---------------- .../SQLite/SQLiteCategoryData.fs | 2 +- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 2 +- src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs | 50 +++--- src/MyWebLog.Data/SQLite/SQLiteThemeData.fs | 162 +++++++---------- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 110 +++++------- src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs | 65 +++---- .../SQLite/SQLiteWebLogUserData.fs | 110 ++++-------- src/MyWebLog.Data/SQLiteData.fs | 8 +- 10 files changed, 221 insertions(+), 455 deletions(-) diff --git a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs index 04e33c9..1a43b74 100644 --- a/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresTagMapData.fs @@ -48,6 +48,7 @@ type PostgresTagMapData(log: ILogger) = /// Save a tag mapping let save (tagMap: TagMap) = + log.LogTrace "TagMap.save" save Table.TagMap tagMap /// Restore tag mappings from a backup diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 7ee8090..cd6c2b6 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -65,17 +65,6 @@ open MyWebLog open MyWebLog.Data open NodaTime.Text -/// Run a command that returns a count -let count (cmd: SqliteCommand) = backgroundTask { - let! it = cmd.ExecuteScalarAsync() - return int (it :?> int64) -} - -/// Create a list of items from the given data reader -let toList<'T> (it: SqliteDataReader -> 'T) (rdr: SqliteDataReader) = - seq { while rdr.Read () do it rdr } - |> List.ofSeq - /// Execute a command that returns no data let write (cmd: SqliteCommand) = backgroundTask { let! _ = cmd.ExecuteNonQueryAsync() @@ -85,18 +74,10 @@ let write (cmd: SqliteCommand) = backgroundTask { /// Add a possibly-missing parameter, substituting null for None let maybe<'T> (it: 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value -/// Create a value for a Duration -let durationParam = - DurationPattern.Roundtrip.Format - /// Create a value for an Instant let instantParam = InstantPattern.General.Format -/// Create an optional value for a Duration -let maybeDuration = - Option.map durationParam >> maybe - /// Create an optional value for an Instant let maybeInstant = Option.map instantParam >> maybe @@ -224,7 +205,7 @@ module Map = let toUpload includeData rdr : Upload = let data = if includeData then - use dataStream = new MemoryStream () + use dataStream = new MemoryStream() use blobStream = getStream "data" rdr blobStream.CopyTo dataStream dataStream.ToArray () @@ -235,79 +216,20 @@ module Map = Path = getString "path" rdr |> Permalink UpdatedOn = getInstant "updated_on" rdr Data = data } - - /// 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) - - /// Map from a document to a domain type - let fromDoc<'T> ser rdr : 'T = - fromData<'T> ser rdr "data" -/// Create a list of items for the results of the given command -let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask { - use! rdr = cmd.ExecuteReaderAsync() - let mutable it: 'TDoc list = [] - while! rdr.ReadAsync() do - it <- Map.fromDoc ser rdr :: it - return List.rev it -} -/// Queries to assist with document manipulation -[] -module QueryOld = +/// Create a named parameter +let sqlParam name (value: obj) = + SqliteParameter(name, value) - /// Fragment to add an ID condition to a WHERE clause (parameter @id) - let whereById = - "data ->> 'Id' = @id" - - /// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId) - let whereByWebLog = - "data ->> 'WebLogId' = @webLogId" - - /// A SELECT/FROM pair for the given table - let selectFromTable table = - $"SELECT data FROM %s{table}" - - /// An INSERT statement for a document (parameter @data) - let insert table = - $"INSERT INTO %s{table} VALUES (@data)" - - /// A SELECT query to count documents for a given web log ID - let countByWebLog table = - $"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}" - - /// An UPDATE query to update a full document by its ID (parameters @data and @id) - let updateById table = - $"UPDATE %s{table} SET data = @data WHERE {whereById}" - - /// A DELETE query to delete a document by its ID (parameter @id) - let deleteById table = - $"DELETE FROM %s{table} WHERE {whereById}" - - /// Create a document ID parameter let idParam (key: 'TKey) = - SqliteParameter("@id", string key) + sqlParam "@id" (string key) /// Create a web log ID parameter let webLogParam (webLogId: WebLogId) = - SqliteParameter("@webLogId", string webLogId) + sqlParam "@webLogId" (string webLogId) -let addParam (cmd: SqliteCommand) name (value: obj) = - cmd.Parameters.AddWithValue(name, value) |> ignore - -/// Add an ID parameter for a document -let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) = - addParam cmd "@id" (string id) - -/// Add a document parameter -let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser = - addParam cmd "@data" (Utils.serialize ser doc) - -/// Add a web log ID parameter -let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) = - addParam cmd "@webLogId" (string webLogId) open BitBadger.Sqlite.FSharp.Documents open BitBadger.Sqlite.FSharp.Documents.WithConn @@ -340,17 +262,6 @@ module Document = return int count } - /// 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> table (key: 'TKey) webLogId conn = Custom.single (Query.selectByIdAndWebLog table) [ idParam key; webLogParam webLogId ] fromData<'TDoc> conn @@ -358,46 +269,7 @@ module Document = /// Find documents for the given web log let findByWebLog<'TDoc> table (webLogId: WebLogId) conn = Find.byFieldEquals<'TDoc> table "WebLogId" webLogId conn - - /// Insert a document - [] - let insert<'TDoc> (conn: SqliteConnection) ser table (doc: 'TDoc) = backgroundTask { - use cmd = conn.CreateCommand() - cmd.CommandText <- QueryOld.insert table - addDocParam<'TDoc> cmd doc ser - do! write cmd - } - - /// Update (replace) a document by its ID - [] - let update<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) (doc: 'TDoc) = backgroundTask { - use cmd = conn.CreateCommand() - cmd.CommandText <- QueryOld.updateById table - addDocId cmd key - addDocParam<'TDoc> cmd doc ser - 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 {QueryOld.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() - cmd.CommandText <- QueryOld.deleteById table - addDocId cmd key - do! write cmd - } + /// Functions to support revisions module Revisions = @@ -422,21 +294,17 @@ module Revisions = (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) conn - /// Parameters for a revision INSERT statement - let revParams<'TKey> (key: 'TKey) rev = - [ SqliteParameter("asOf", rev.AsOf) - SqliteParameter("@id", string key) - SqliteParameter("@text", rev.Text) ] - /// Update a page or post's revisions let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask { let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs - if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then - for delRev in toDelete do - do! Custom.nonQuery - $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" - [ idParam key; SqliteParameter("@asOf", instantParam delRev.AsOf) ] - conn - for addRev in toAdd do - do! Custom.nonQuery $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" (revParams key addRev) conn + for delRev in toDelete do + do! Custom.nonQuery + $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" + [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ] + conn + for addRev in toAdd do + do! Custom.nonQuery + $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" + [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" addRev.Text ] + conn } diff --git a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs index 33bf01b..7ab5dbc 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs @@ -100,7 +100,7 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge for postId, cats in posts do do! Update.partialById Table.Post postId {| CategoryIds = cats |> List.filter (fun it -> it <> string catId) |} conn - do! Document.delete conn Table.Category catId + do! Delete.byId Table.Category catId conn return if children = 0L then CategoryDeleted else ReassignedChildCategories | None -> return CategoryNotFound } diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 0792fdf..5ada20c 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -97,7 +97,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) = log.LogTrace "Post.findCurrentPermalink" let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks Custom.single - $"SELECT data ->> '{linkName}' + $"SELECT data ->> '{linkName}' AS permalink FROM {Table.Post} WHERE {Document.Query.whereByWebLog} AND {linkSql}" (webLogParam webLogId :: linkParams) diff --git a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs index 9bc3616..0303034 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs @@ -1,72 +1,64 @@ namespace MyWebLog.Data.SQLite +open BitBadger.Sqlite.FSharp.Documents +open BitBadger.Sqlite.FSharp.Documents.WithConn open Microsoft.Data.Sqlite open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data -open Newtonsoft.Json /// SQLite myWebLog tag mapping data implementation -type SQLiteTagMapData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = +type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) = /// Find a tag mapping by its ID for the given web log let findById tagMapId webLogId = log.LogTrace "TagMap.findById" - Document.findByIdAndWebLog conn ser Table.TagMap tagMapId webLogId + Document.findByIdAndWebLog Table.TagMap tagMapId webLogId conn /// Delete a tag mapping for the given web log let delete tagMapId webLogId = backgroundTask { log.LogTrace "TagMap.delete" match! findById tagMapId webLogId with | Some _ -> - do! Document.delete conn Table.TagMap tagMapId + do! Delete.byId Table.TagMap tagMapId conn return true | None -> return false } /// Find a tag mapping by its URL value for the given web log - let findByUrlValue (urlValue: string) webLogId = backgroundTask { + let findByUrlValue (urlValue: string) webLogId = log.LogTrace "TagMap.findByUrlValue" - use cmd = conn.CreateCommand() - cmd.CommandText <- $" - {QueryOld.selectFromTable Table.TagMap} - WHERE {QueryOld.whereByWebLog} - AND data ->> '{nameof TagMap.Empty.UrlValue}' = @urlValue" - addWebLogId cmd webLogId - addParam cmd "@urlValue" urlValue - use! rdr = cmd.ExecuteReaderAsync() - let! isFound = rdr.ReadAsync() - return if isFound then Some (Map.fromDoc ser rdr) else None - } + Custom.single + $"""{Document.Query.selectByWebLog Table.TagMap} + AND {Query.whereFieldEquals (nameof TagMap.Empty.UrlValue) "@urlValue"}""" + [ webLogParam webLogId; SqliteParameter("@urlValue", urlValue) ] + fromData + conn /// Get all tag mappings for the given web log let findByWebLog webLogId = log.LogTrace "TagMap.findByWebLog" - Document.findByWebLog conn ser Table.TagMap webLogId + Document.findByWebLog Table.TagMap webLogId conn /// Find any tag mappings in a list of tags for the given web log let findMappingForTags (tags: string list) webLogId = log.LogTrace "TagMap.findMappingForTags" - use cmd = conn.CreateCommand () let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags - cmd.CommandText <- $"{QueryOld.selectFromTable Table.TagMap} WHERE {QueryOld.whereByWebLog} {mapSql}" - addWebLogId cmd webLogId - cmd.Parameters.AddRange mapParams - cmdToList cmd ser + Custom.list + $"{Document.Query.selectByWebLog Table.TagMap} {mapSql}" + (webLogParam webLogId :: mapParams) + fromData + conn /// Save a tag mapping - let save (tagMap: TagMap) = backgroundTask { + let save (tagMap: TagMap) = log.LogTrace "TagMap.save" - match! findById tagMap.Id tagMap.WebLogId with - | Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap - | None -> do! Document.insert conn ser Table.TagMap tagMap - } + save Table.TagMap tagMap conn /// Restore tag mappings from a backup let restore tagMaps = backgroundTask { log.LogTrace "TagMap.restore" - for tagMap in tagMaps do - do! save tagMap + for tagMap in tagMaps do do! save tagMap } interface ITagMapData with diff --git a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs index 151496e..f5d50a1 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteThemeData.fs @@ -1,74 +1,68 @@ namespace MyWebLog.Data.SQLite +open BitBadger.Sqlite.FSharp.Documents +open BitBadger.Sqlite.FSharp.Documents.WithConn 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, ser: JsonSerializer, log: ILogger) = +type SQLiteThemeData(conn : SqliteConnection, log: ILogger) = /// The JSON field for the theme ID let idField = $"data ->> '{nameof Theme.Empty.Id}'" + /// Convert a document to a theme with no template text + let withoutTemplateText (rdr: SqliteDataReader) = + let theme = fromData rdr + { theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })} + /// Remove the template text from a theme - let withoutTemplateText (it: 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 { + let all () = log.LogTrace "Theme.all" - use cmd = conn.CreateCommand() - cmd.CommandText <- $"{QueryOld.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}" - let! themes = cmdToList cmd ser - return themes |> List.map withoutTemplateText - } + Custom.list + $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}" + [] + withoutTemplateText + conn /// Does a given theme exist? - let exists (themeId: ThemeId) = backgroundTask { + let exists (themeId: ThemeId) = log.LogTrace "Theme.exists" - use cmd = conn.CreateCommand () - cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Theme} WHERE {idField} = @id" - addDocId cmd themeId - let! count = count cmd - return count > 0 - } + Exists.byId Table.Theme themeId conn /// Find a theme by its ID let findById themeId = log.LogTrace "Theme.findById" - Document.findById conn ser Table.Theme themeId + Find.byId Table.Theme themeId conn /// Find a theme by its ID (excludes the text of templates) - let findByIdWithoutText themeId = backgroundTask { + let findByIdWithoutText (themeId: ThemeId) = log.LogTrace "Theme.findByIdWithoutText" - let! theme = findById themeId - return theme |> Option.map withoutTemplateText - } + Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText conn /// 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 {Table.ThemeAsset} WHERE theme_id = @id; - DELETE FROM {Table.Theme} WHERE {QueryOld.whereById}" - addDocId cmd themeId - do! write cmd + do! Custom.nonQuery + $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}" + [ idParam themeId ] + conn return true | None -> return false } /// Save a theme - let save (theme: Theme) = backgroundTask { + let save (theme: Theme) = 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 - } + save Table.Theme theme conn interface IThemeData with member _.All() = all () @@ -84,92 +78,72 @@ open System.IO /// SQLite myWebLog theme data implementation type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) = + /// Create parameters for a theme asset ID + let assetIdParams assetId = + let (ThemeAssetId (ThemeId themeId, path)) = assetId + [ idParam themeId; sqlParam "@path" path ] + /// Get all theme assets (excludes data) - let all () = backgroundTask { + let all () = 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 - } + Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false) conn /// Delete all assets for the given theme - let deleteByTheme (themeId: ThemeId) = backgroundTask { + let deleteByTheme (themeId: ThemeId) = 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 - } + Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] conn /// Find a theme asset by its ID - let findById assetId = backgroundTask { + let findById assetId = log.LogTrace "ThemeAsset.findById" - use cmd = conn.CreateCommand () - cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" - let (ThemeAssetId (ThemeId themeId, path)) = assetId - 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 - } + Custom.single + $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path" + (assetIdParams assetId) + (Map.toThemeAsset true) + conn /// Get theme assets for the given theme (excludes data) - let findByTheme (themeId: ThemeId) = backgroundTask { + let findByTheme (themeId: ThemeId) = 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 - } + Custom.list + $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id" + [ idParam themeId ] + (Map.toThemeAsset false) + conn /// Get theme assets for the given theme - let findByThemeWithData (themeId: ThemeId) = backgroundTask { + let findByThemeWithData (themeId: ThemeId) = 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 - } + Custom.list + $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id" + [ idParam themeId ] + (Map.toThemeAsset true) + conn /// Save a theme asset 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 - addParam sideCmd "@themeId" themeId - addParam sideCmd "@path" path - let! exists = count sideCmd - - use cmd = conn.CreateCommand () - cmd.CommandText <- - if exists = 1 then - $"UPDATE {Table.ThemeAsset} - SET updated_on = @updatedOn, - data = ZEROBLOB(@dataLength) - WHERE theme_id = @themeId - AND path = @path" - else + do! Custom.nonQuery $"INSERT INTO {Table.ThemeAsset} ( theme_id, path, updated_on, data ) VALUES ( @themeId, @path, @updatedOn, ZEROBLOB(@dataLength) - )" - 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 {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" - let! rowId = sideCmd.ExecuteScalarAsync() + ) ON CONFLICT (theme_id, path) DO UPDATE + SET updated_on = @updatedOn, + data = ZEROBLOB(@dataLength)" + [ sqlParam "@updatedOn" (instantParam asset.UpdatedOn) + sqlParam "@dataLength" asset.Data.Length + yield! (assetIdParams asset.Id) ] + conn + let! rowId = + Custom.scalar + $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path" + (assetIdParams asset.Id) + (_.GetInt64(0)) + conn use dataStream = new MemoryStream(asset.Data) - use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId :?> int64) + use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId) do! dataStream.CopyToAsync blobStream } diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index 9a7cd82..e6bc5e0 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -1,6 +1,7 @@ namespace MyWebLog.Data.SQLite open System.IO +open BitBadger.Sqlite.FSharp.Documents.WithConn open Microsoft.Data.Sqlite open Microsoft.Extensions.Logging open MyWebLog @@ -9,89 +10,70 @@ open MyWebLog.Data /// SQLite myWebLog web log data implementation type SQLiteUploadData(conn: SqliteConnection, log: ILogger) = - /// Add parameters for uploaded file INSERT and UPDATE statements - let addUploadParameters (cmd: SqliteCommand) (upload: Upload) = - 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 { + let add (upload: Upload) = backgroundTask { log.LogTrace "Upload.add" - use cmd = conn.CreateCommand() - cmd.CommandText <- - $"INSERT INTO {Table.Upload} ( - id, web_log_id, path, updated_on, data - ) VALUES ( - @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) - )" - addUploadParameters cmd upload - do! write cmd - - cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" - let! rowId = cmd.ExecuteScalarAsync() - + do! Custom.nonQuery + $"INSERT INTO {Table.Upload} ( + id, web_log_id, path, updated_on, data + ) VALUES ( + @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) + )" + [ idParam upload.Id + webLogParam upload.WebLogId + sqlParam "@path" (string upload.Path) + sqlParam "@updatedOn" (instantParam upload.UpdatedOn) + sqlParam "@dataLength" upload.Data.Length ] + conn + let! rowId = + Custom.scalar $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" [ idParam upload.Id ] (_.GetInt64(0)) conn use dataStream = new MemoryStream(upload.Data) - use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId :?> int64) + use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId) do! dataStream.CopyToAsync blobStream } /// Delete an uploaded file by its ID 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 {Table.Upload} - WHERE id = @id - AND web_log_id = @webLogId" - addWebLogId cmd webLogId - 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 {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"].Value} not found""" + let! upload = + Custom.single + $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId" + [ idParam uploadId; webLogParam webLogId ] + (Map.toUpload false) + conn + match upload with + | Some up -> + do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" [ idParam up.Id ] conn + return Ok (string up.Path) + | None -> return Error $"Upload ID {string uploadId} not found" } /// Find an uploaded file by its path for the given web log - let findByPath (path: string) webLogId = backgroundTask { + let findByPath (path: string) webLogId = 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 - addParam cmd "@path" path - let! rdr = cmd.ExecuteReaderAsync() - let! isFound = rdr.ReadAsync() - return if isFound then Some (Map.toUpload true rdr) else None - } + Custom.single + $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path" + [ webLogParam webLogId; sqlParam "@path" path ] + (Map.toUpload true) + conn /// Find all uploaded files for the given web log (excludes data) - let findByWebLog webLogId = backgroundTask { + let findByWebLog 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() - return toList (Map.toUpload false) rdr - } + Custom.list + $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId" + [ webLogParam webLogId ] + (Map.toUpload false) + conn /// Find all uploaded files for the given web log - let findByWebLogWithData webLogId = backgroundTask { + let findByWebLogWithData webLogId = log.LogTrace "Upload.findByWebLogWithData" - use cmd = conn.CreateCommand () - cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId" - addWebLogId cmd webLogId - let! rdr = cmd.ExecuteReaderAsync() - return toList (Map.toUpload true) rdr - } + Custom.list + $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId" + [ webLogParam webLogId ] + (Map.toUpload true) + conn /// Restore uploads from a backup let restore uploads = backgroundTask { diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs index 7cec1a7..e308e94 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs @@ -1,79 +1,68 @@ namespace MyWebLog.Data.SQLite -open System.Threading.Tasks +open BitBadger.Sqlite.FSharp.Documents +open BitBadger.Sqlite.FSharp.Documents.WithConn open Microsoft.Data.Sqlite open Microsoft.Extensions.Logging open MyWebLog open MyWebLog.Data -open Newtonsoft.Json /// SQLite myWebLog web log data implementation -type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = +type SQLiteWebLogData(conn: SqliteConnection, log: ILogger) = /// Add a web log let add webLog = log.LogTrace "WebLog.add" - Document.insert conn ser Table.WebLog webLog + insert Table.WebLog webLog conn /// Retrieve all web logs let all () = log.LogTrace "WebLog.all" - use cmd = conn.CreateCommand() - cmd.CommandText <- QueryOld.selectFromTable Table.WebLog - cmdToList cmd ser + Find.all Table.WebLog conn /// Delete a web log by its ID - let delete webLogId = backgroundTask { + let delete webLogId = 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 {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 - } + let subQuery table = + $"""(SELECT data ->> 'Id' FROM {table} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}""" + Custom.nonQuery + $"""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 {Query.whereFieldEquals "WebLogId" "@webLogId"}; + DELETE FROM {Table.Page} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}; + DELETE FROM {Table.Category} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}; + DELETE FROM {Table.TagMap} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}; + DELETE FROM {Table.Upload} WHERE web_log_id = @id; + DELETE FROM {Table.WebLogUser} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}; + DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}""" + [ webLogParam webLogId ] + conn /// Find a web log by its host (URL base) - let findByHost (url: string) = backgroundTask { + let findByHost (url: string) = log.LogTrace "WebLog.findByHost" - use cmd = conn.CreateCommand() - cmd.CommandText <- - $"{QueryOld.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.firstByFieldEquals Table.WebLog (nameof WebLog.Empty.UrlBase) url conn /// Find a web log by its ID let findById webLogId = log.LogTrace "WebLog.findById" - Document.findById conn ser Table.WebLog webLogId + Find.byId Table.WebLog webLogId conn /// Update redirect rules for a web log let updateRedirectRules (webLog: WebLog) = log.LogTrace "WebLog.updateRedirectRules" - Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.RedirectRules) webLog.RedirectRules + Update.partialById Table.WebLog webLog.Id {| RedirectRules = webLog.RedirectRules |} conn /// Update RSS options for a web log let updateRssOptions (webLog: WebLog) = log.LogTrace "WebLog.updateRssOptions" - Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.Rss) webLog.Rss + Update.partialById Table.WebLog webLog.Id {| Rss = webLog.Rss |} conn /// Update settings for a web log let updateSettings (webLog: WebLog) = log.LogTrace "WebLog.updateSettings" - Document.update conn ser Table.WebLog webLog.Id webLog + Update.full Table.WebLog webLog.Id webLog conn 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 5029f98..35771e7 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -1,125 +1,85 @@ namespace MyWebLog.Data.SQLite +open BitBadger.Sqlite.FSharp.Documents +open BitBadger.Sqlite.FSharp.Documents.WithConn 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, ser: JsonSerializer, log: ILogger) = - - // SUPPORT FUNCTIONS - - /// Add parameters for web log user INSERT or UPDATE statements - let addWebLogUserParameters (cmd: SqliteCommand) (user: WebLogUser) = - [ cmd.Parameters.AddWithValue ("@id", string user.Id) - cmd.Parameters.AddWithValue ("@webLogId", string user.WebLogId) - cmd.Parameters.AddWithValue ("@email", user.Email) - cmd.Parameters.AddWithValue ("@firstName", user.FirstName) - cmd.Parameters.AddWithValue ("@lastName", user.LastName) - cmd.Parameters.AddWithValue ("@preferredName", user.PreferredName) - cmd.Parameters.AddWithValue ("@passwordHash", user.PasswordHash) - cmd.Parameters.AddWithValue ("@url", maybe user.Url) - cmd.Parameters.AddWithValue ("@accessLevel", string user.AccessLevel) - cmd.Parameters.AddWithValue ("@createdOn", instantParam user.CreatedOn) - cmd.Parameters.AddWithValue ("@lastSeenOn", maybeInstant user.LastSeenOn) - ] |> ignore - - // IMPLEMENTATION FUNCTIONS - - /// Add a user - let add user = - log.LogTrace "WebLogUser.add" - Document.insert conn ser Table.WebLogUser user +type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) = /// Find a user by their ID for the given web log let findById userId webLogId = log.LogTrace "WebLogUser.findById" - Document.findByIdAndWebLog conn ser Table.WebLogUser userId webLogId + Document.findByIdAndWebLog Table.WebLogUser userId webLogId conn /// 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(*) FROM {Table.Page} WHERE data ->> 'AuthorId' = @id" - addDocId cmd userId - let! pageCount = count cmd - cmd.CommandText <- cmd.CommandText.Replace($"FROM {Table.Page}", $"FROM {Table.Post}") - let! postCount = count cmd + let! pageCount = Count.byFieldEquals Table.Page (nameof Page.Empty.AuthorId) (string userId) conn + let! postCount = Count.byFieldEquals Table.Post (nameof Post.Empty.AuthorId) (string userId) conn if pageCount + postCount > 0 then return Error "User has pages or posts; cannot delete" else - do! Document.delete conn Table.WebLogUser userId + do! Delete.byId Table.WebLogUser userId conn 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 { + let findByEmail (email: string) webLogId = log.LogTrace "WebLogUser.findByEmail" - use cmd = conn.CreateCommand() - cmd.CommandText <- $" - {QueryOld.selectFromTable Table.WebLogUser} - WHERE {QueryOld.whereByWebLog} - AND data ->> '{nameof WebLogUser.Empty.Email}' = @email" - addWebLogId cmd webLogId - addParam cmd "@email" email - use! rdr = cmd.ExecuteReaderAsync() - let! isFound = rdr.ReadAsync() - return if isFound then Some (Map.fromDoc ser rdr) else None - } + Custom.single + $"""{Document.Query.selectByWebLog Table.WebLogUser} + AND {Query.whereFieldEquals (nameof WebLogUser.Empty.Email) "@email"}""" + [ webLogParam webLogId; sqlParam "@email" email ] + fromData + conn /// Get all users for the given web log let findByWebLog webLogId = backgroundTask { log.LogTrace "WebLogUser.findByWebLog" - let! users = Document.findByWebLog conn ser Table.WebLogUser webLogId + let! users = Document.findByWebLog Table.WebLogUser webLogId conn 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 { + let findNames webLogId (userIds: WebLogUserId list) = log.LogTrace "WebLogUser.findNames" - use cmd = conn.CreateCommand() let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds - cmd.CommandText <- $"{QueryOld.selectFromTable Table.WebLogUser} WHERE {QueryOld.whereByWebLog} {nameSql}" - addWebLogId cmd webLogId - cmd.Parameters.AddRange nameParams - let! users = cmdToList cmd ser - return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) - } + Custom.list + $"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}" + (webLogParam webLogId :: nameParams) + (fun rdr -> + let user = fromData rdr + { Name = string user.Id; Value = user.DisplayName }) + conn + + /// Save a user + let save user = + log.LogTrace "WebLogUser.update" + save Table.WebLogUser user conn /// Restore users from a backup let restore users = backgroundTask { log.LogTrace "WebLogUser.restore" - for user in users do - do! add user + for user in users do do! save user } /// Set a user's last seen date/time to now - let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask { + let setLastSeen userId webLogId = backgroundTask { log.LogTrace "WebLogUser.setLastSeen" - use cmd = conn.CreateCommand() - cmd.CommandText <- $" - UPDATE {Table.WebLogUser} - SET data = json_set(data, '$.{nameof WebLogUser.Empty.LastSeenOn}', @lastSeenOn) - WHERE {QueryOld.whereById} - AND {QueryOld.whereByWebLog}" - addDocId cmd userId - addWebLogId cmd webLogId - addParam cmd "@lastSeenOn" (instantParam (Noda.now ())) - do! write cmd + match! findById userId webLogId with + | Some _ -> do! Update.partialById Table.WebLogUser userId {| LastSeenOn = Noda.now () |} conn + | None -> () } - /// Update a user - 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 + member _.Add user = save user member _.Delete userId webLogId = delete userId webLogId member _.FindByEmail email webLogId = findByEmail email webLogId member _.FindById userId webLogId = findById userId webLogId @@ -127,4 +87,4 @@ type SQLiteWebLogUserData(conn: SqliteConnection, ser: JsonSerializer, log: ILog member _.FindNames webLogId userIds = findNames webLogId userIds member _.Restore users = restore users member _.SetLastSeen userId webLogId = setLastSeen userId webLogId - member _.Update user = update user + member _.Update user = save user diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index b5a85ff..4386d09 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -456,12 +456,12 @@ type SQLiteData(conn: SqliteConnection, log: ILogger, ser: JsonSeria member _.Category = SQLiteCategoryData (conn, ser, log) member _.Page = SQLitePageData (conn, log) member _.Post = SQLitePostData (conn, log) - member _.TagMap = SQLiteTagMapData (conn, ser, log) - member _.Theme = SQLiteThemeData (conn, ser, log) + member _.TagMap = SQLiteTagMapData (conn, log) + member _.Theme = SQLiteThemeData (conn, log) member _.ThemeAsset = SQLiteThemeAssetData (conn, log) member _.Upload = SQLiteUploadData (conn, log) - member _.WebLog = SQLiteWebLogData (conn, ser, log) - member _.WebLogUser = SQLiteWebLogUserData (conn, ser, log) + member _.WebLog = SQLiteWebLogData (conn, log) + member _.WebLogUser = SQLiteWebLogUserData (conn, log) member _.Serializer = ser