Version 2.1 #41
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
| @ -236,78 +217,19 @@ module Map = | ||||
|           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 | ||||
| [<Obsolete("change me")>] | ||||
| module QueryOld = | ||||
|      | ||||
|     /// 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 named parameter | ||||
| let sqlParam name (value: obj) = | ||||
|     SqliteParameter(name, value) | ||||
|      | ||||
| /// 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 | ||||
|     [<Obsolete("replace this")>] | ||||
|     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 | ||||
| @ -359,45 +270,6 @@ module Document = | ||||
|     let findByWebLog<'TDoc> table (webLogId: WebLogId) conn = | ||||
|         Find.byFieldEquals<'TDoc> table "WebLogId" webLogId conn | ||||
| 
 | ||||
|     /// Insert a document | ||||
|     [<Obsolete("replace this")>] | ||||
|     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 | ||||
|     [<Obsolete("replace this")>] | ||||
|     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 | ||||
|     [<Obsolete("replace this")>] | ||||
|     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 | ||||
|     [<Obsolete("replace this")>] | ||||
|     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) ] | ||||
|                     [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ] | ||||
|                     conn | ||||
|         for addRev in toAdd do | ||||
|                 do! Custom.nonQuery $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" (revParams key addRev) conn | ||||
|             do! Custom.nonQuery | ||||
|                     $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" | ||||
|                     [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" addRev.Text ] | ||||
|                     conn | ||||
|     } | ||||
|  | ||||
| @ -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 | ||||
|     } | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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<TagMapId, TagMap> conn ser Table.TagMap tagMapId webLogId | ||||
|         Document.findByIdAndWebLog<TagMapId, TagMap> 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<TagMap> 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<TagMap> | ||||
|             conn | ||||
|      | ||||
|     /// Get all tag mappings for the given web log | ||||
|     let findByWebLog webLogId = | ||||
|         log.LogTrace "TagMap.findByWebLog" | ||||
|         Document.findByWebLog<TagMap> conn ser Table.TagMap webLogId | ||||
|         Document.findByWebLog<TagMap> 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<TagMap> cmd ser | ||||
|         Custom.list | ||||
|             $"{Document.Query.selectByWebLog Table.TagMap} {mapSql}" | ||||
|             (webLogParam webLogId :: mapParams) | ||||
|             fromData<TagMap> | ||||
|             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 | ||||
|  | ||||
| @ -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<Theme> 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<Theme> 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<ThemeId, Theme> conn ser Table.Theme themeId | ||||
|         Find.byId<ThemeId, Theme> 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 | ||||
|     } | ||||
|      | ||||
|  | ||||
| @ -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 <- | ||||
|         do! Custom.nonQuery | ||||
|                 $"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() | ||||
|          | ||||
|                 [ 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 { | ||||
|  | ||||
| @ -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<WebLog> conn ser Table.WebLog webLog | ||||
|         insert<WebLog> 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<WebLog> cmd ser | ||||
|         Find.all<WebLog> 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}; | ||||
|         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 {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 | ||||
|     } | ||||
|                 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<WebLog> ser rdr) else None | ||||
|     } | ||||
|         Find.firstByFieldEquals<WebLog> Table.WebLog (nameof WebLog.Empty.UrlBase) url conn | ||||
|      | ||||
|     /// Find a web log by its ID | ||||
|     let findById webLogId = | ||||
|         log.LogTrace "WebLog.findById" | ||||
|         Document.findById<WebLogId, WebLog> conn ser Table.WebLog webLogId | ||||
|         Find.byId<WebLogId, WebLog> 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 | ||||
|  | ||||
| @ -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<WebLogUser> 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<WebLogUserId, WebLogUser> conn ser Table.WebLogUser userId webLogId | ||||
|         Document.findByIdAndWebLog<WebLogUserId, WebLogUser> 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<WebLogUser> 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<WebLogUser> | ||||
|             conn | ||||
|      | ||||
|     /// Get all users for the given web log | ||||
|     let findByWebLog webLogId = backgroundTask { | ||||
|         log.LogTrace "WebLogUser.findByWebLog" | ||||
|         let! users = Document.findByWebLog<WebLogUser> conn ser Table.WebLogUser webLogId | ||||
|         let! users = Document.findByWebLog<WebLogUser> 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<WebLogUser> 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<WebLogUser> rdr | ||||
|                 { Name = string user.Id; Value = user.DisplayName }) | ||||
|             conn | ||||
|      | ||||
|     /// Save a user | ||||
|     let save user = | ||||
|         log.LogTrace "WebLogUser.update" | ||||
|         save<WebLogUser> 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 | ||||
|  | ||||
| @ -456,12 +456,12 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, 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 | ||||
|          | ||||
|  | ||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user