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

Version 2.1 #41

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

1
src/MyWebLog.Data/Postgres/PostgresTagMapData.fs
View File

@ -48,6 +48,7 @@ type PostgresTagMapData(log: ILogger) =
/// Save a tag mapping /// Save a tag mapping
let save (tagMap: TagMap) = let save (tagMap: TagMap) =
log.LogTrace "TagMap.save"
save Table.TagMap tagMap save Table.TagMap tagMap
/// Restore tag mappings from a backup /// Restore tag mappings from a backup

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

@ -65,17 +65,6 @@ open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open NodaTime.Text 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 /// Execute a command that returns no data
let write (cmd: SqliteCommand) = backgroundTask { let write (cmd: SqliteCommand) = backgroundTask {
let! _ = cmd.ExecuteNonQueryAsync() let! _ = cmd.ExecuteNonQueryAsync()
@ -85,18 +74,10 @@ let write (cmd: SqliteCommand) = backgroundTask {
/// Add a possibly-missing parameter, substituting null for None /// 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 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 /// Create a value for an Instant
let instantParam = let instantParam =
InstantPattern.General.Format InstantPattern.General.Format
/// Create an optional value for a Duration
let maybeDuration =
Option.map durationParam >> maybe
/// Create an optional value for an Instant /// Create an optional value for an Instant
let maybeInstant = let maybeInstant =
Option.map instantParam >> maybe Option.map instantParam >> maybe
@ -224,7 +205,7 @@ module Map =
let toUpload includeData rdr : Upload = let toUpload includeData rdr : Upload =
let data = let data =
if includeData then if includeData then
use dataStream = new MemoryStream () use dataStream = new MemoryStream()
use blobStream = getStream "data" rdr use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream blobStream.CopyTo dataStream
dataStream.ToArray () dataStream.ToArray ()
@ -236,78 +217,19 @@ module Map =
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = data } 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 /// Create a document ID parameter
let idParam (key: 'TKey) = let idParam (key: 'TKey) =
SqliteParameter("@id", string key) sqlParam "@id" (string key)
/// Create a web log ID parameter /// Create a web log ID parameter
let webLogParam (webLogId: WebLogId) = 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
open BitBadger.Sqlite.FSharp.Documents.WithConn open BitBadger.Sqlite.FSharp.Documents.WithConn
@ -340,17 +262,6 @@ module Document =
return int count 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 /// Find a document by its ID and web log ID
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId conn = let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId conn =
Custom.single (Query.selectByIdAndWebLog table) [ idParam key; webLogParam webLogId ] fromData<'TDoc> 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 = let findByWebLog<'TDoc> table (webLogId: WebLogId) conn =
Find.byFieldEquals<'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 /// Functions to support revisions
module Revisions = module Revisions =
@ -422,21 +294,17 @@ module Revisions =
(fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr)
conn 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 /// Update a page or post's revisions
let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask { let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then for delRev in toDelete do
for delRev in toDelete do do! Custom.nonQuery
do! Custom.nonQuery $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ]
[ idParam key; SqliteParameter("@asOf", instantParam delRev.AsOf) ] conn
conn for addRev in toAdd do
for addRev in toAdd do do! Custom.nonQuery
do! Custom.nonQuery $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" (revParams key addRev) conn $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)"
[ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" addRev.Text ]
conn
} }

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

@ -100,7 +100,7 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
for postId, cats in posts do for postId, cats in posts do
do! Update.partialById do! Update.partialById
Table.Post postId {| CategoryIds = cats |> List.filter (fun it -> it <> string catId) |} conn 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 return if children = 0L then CategoryDeleted else ReassignedChildCategories
| None -> return CategoryNotFound | None -> return CategoryNotFound
} }

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

@ -97,7 +97,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
log.LogTrace "Post.findCurrentPermalink" log.LogTrace "Post.findCurrentPermalink"
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
Custom.single Custom.single
$"SELECT data ->> '{linkName}' $"SELECT data ->> '{linkName}' AS permalink
FROM {Table.Post} FROM {Table.Post}
WHERE {Document.Query.whereByWebLog} AND {linkSql}" WHERE {Document.Query.whereByWebLog} AND {linkSql}"
(webLogParam webLogId :: linkParams) (webLogParam webLogId :: linkParams)

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

@ -1,72 +1,64 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open BitBadger.Sqlite.FSharp.Documents
open BitBadger.Sqlite.FSharp.Documents.WithConn
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog tag mapping data implementation /// 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 /// Find a tag mapping by its ID for the given web log
let findById tagMapId webLogId = let findById tagMapId webLogId =
log.LogTrace "TagMap.findById" 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 /// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask { let delete tagMapId webLogId = backgroundTask {
log.LogTrace "TagMap.delete" log.LogTrace "TagMap.delete"
match! findById tagMapId webLogId with match! findById tagMapId webLogId with
| Some _ -> | Some _ ->
do! Document.delete conn Table.TagMap tagMapId do! Delete.byId Table.TagMap tagMapId conn
return true return true
| None -> return false | None -> return false
} }
/// Find a tag mapping by its URL value for the given web log /// 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" log.LogTrace "TagMap.findByUrlValue"
use cmd = conn.CreateCommand() Custom.single
cmd.CommandText <- $" $"""{Document.Query.selectByWebLog Table.TagMap}
{QueryOld.selectFromTable Table.TagMap} AND {Query.whereFieldEquals (nameof TagMap.Empty.UrlValue) "@urlValue"}"""
WHERE {QueryOld.whereByWebLog} [ webLogParam webLogId; SqliteParameter("@urlValue", urlValue) ]
AND data ->> '{nameof TagMap.Empty.UrlValue}' = @urlValue" fromData<TagMap>
addWebLogId cmd webLogId conn
addParam cmd "@urlValue" urlValue
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<TagMap> ser rdr) else None
}
/// Get all tag mappings for the given web log /// Get all tag mappings for the given web log
let findByWebLog webLogId = let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog" 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 /// Find any tag mappings in a list of tags for the given web log
let findMappingForTags (tags: string list) webLogId = let findMappingForTags (tags: string list) webLogId =
log.LogTrace "TagMap.findMappingForTags" log.LogTrace "TagMap.findMappingForTags"
use cmd = conn.CreateCommand ()
let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
cmd.CommandText <- $"{QueryOld.selectFromTable Table.TagMap} WHERE {QueryOld.whereByWebLog} {mapSql}" Custom.list
addWebLogId cmd webLogId $"{Document.Query.selectByWebLog Table.TagMap} {mapSql}"
cmd.Parameters.AddRange mapParams (webLogParam webLogId :: mapParams)
cmdToList<TagMap> cmd ser fromData<TagMap>
conn
/// Save a tag mapping /// Save a tag mapping
let save (tagMap: TagMap) = backgroundTask { let save (tagMap: TagMap) =
log.LogTrace "TagMap.save" log.LogTrace "TagMap.save"
match! findById tagMap.Id tagMap.WebLogId with save Table.TagMap tagMap conn
| Some _ -> do! Document.update conn ser Table.TagMap tagMap.Id tagMap
| None -> do! Document.insert conn ser Table.TagMap tagMap
}
/// Restore tag mappings from a backup /// Restore tag mappings from a backup
let restore tagMaps = backgroundTask { let restore tagMaps = backgroundTask {
log.LogTrace "TagMap.restore" log.LogTrace "TagMap.restore"
for tagMap in tagMaps do for tagMap in tagMaps do do! save tagMap
do! save tagMap
} }
interface ITagMapData with interface ITagMapData with

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

@ -1,74 +1,68 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open BitBadger.Sqlite.FSharp.Documents
open BitBadger.Sqlite.FSharp.Documents.WithConn
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeData(conn : SqliteConnection, ser: JsonSerializer, log: ILogger) = type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
/// The JSON field for the theme ID /// The JSON field for the theme ID
let idField = $"data ->> '{nameof Theme.Empty.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 /// 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 = "" }) } { it with Templates = it.Templates |> List.map (fun t -> { t with Text = "" }) }
/// Retrieve all themes (except 'admin'; excludes template text) /// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask { let all () =
log.LogTrace "Theme.all" log.LogTrace "Theme.all"
use cmd = conn.CreateCommand() Custom.list
cmd.CommandText <- $"{QueryOld.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}" $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
let! themes = cmdToList<Theme> cmd ser []
return themes |> List.map withoutTemplateText withoutTemplateText
} conn
/// Does a given theme exist? /// Does a given theme exist?
let exists (themeId: ThemeId) = backgroundTask { let exists (themeId: ThemeId) =
log.LogTrace "Theme.exists" log.LogTrace "Theme.exists"
use cmd = conn.CreateCommand () Exists.byId Table.Theme themeId conn
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 /// Find a theme by its ID
let findById themeId = let findById themeId =
log.LogTrace "Theme.findById" 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) /// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId = backgroundTask { let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText" log.LogTrace "Theme.findByIdWithoutText"
let! theme = findById themeId Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText conn
return theme |> Option.map withoutTemplateText
}
/// Delete a theme by its ID /// Delete a theme by its ID
let delete themeId = backgroundTask { let delete themeId = backgroundTask {
log.LogTrace "Theme.delete" log.LogTrace "Theme.delete"
match! findByIdWithoutText themeId with match! findByIdWithoutText themeId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() do! Custom.nonQuery
cmd.CommandText <- $" $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}"
DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; [ idParam themeId ]
DELETE FROM {Table.Theme} WHERE {QueryOld.whereById}" conn
addDocId cmd themeId
do! write cmd
return true return true
| None -> return false | None -> return false
} }
/// Save a theme /// Save a theme
let save (theme: Theme) = backgroundTask { let save (theme: Theme) =
log.LogTrace "Theme.save" log.LogTrace "Theme.save"
match! findById theme.Id with save Table.Theme theme conn
| Some _ -> do! Document.update conn ser Table.Theme theme.Id theme
| None -> do! Document.insert conn ser Table.Theme theme
}
interface IThemeData with interface IThemeData with
member _.All() = all () member _.All() = all ()
@ -84,92 +78,72 @@ open System.IO
/// SQLite myWebLog theme data implementation /// SQLite myWebLog theme data implementation
type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) = 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) /// Get all theme assets (excludes data)
let all () = backgroundTask { let all () =
log.LogTrace "ThemeAsset.all" log.LogTrace "ThemeAsset.all"
use cmd = conn.CreateCommand() Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false) conn
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 /// Delete all assets for the given theme
let deleteByTheme (themeId: ThemeId) = backgroundTask { let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme" log.LogTrace "ThemeAsset.deleteByTheme"
use cmd = conn.CreateCommand() Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] conn
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 /// Find a theme asset by its ID
let findById assetId = backgroundTask { let findById assetId =
log.LogTrace "ThemeAsset.findById" log.LogTrace "ThemeAsset.findById"
use cmd = conn.CreateCommand () Custom.single
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path" $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = assetId (assetIdParams assetId)
addParam cmd "@themeId" themeId (Map.toThemeAsset true)
addParam cmd "@path" path conn
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) /// Get theme assets for the given theme (excludes data)
let findByTheme (themeId: ThemeId) = backgroundTask { let findByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByTheme" log.LogTrace "ThemeAsset.findByTheme"
use cmd = conn.CreateCommand() Custom.list
cmd.CommandText <- $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId" $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id"
addParam cmd "@themeId" (string themeId) [ idParam themeId ]
use! rdr = cmd.ExecuteReaderAsync() (Map.toThemeAsset false)
return toList (Map.toThemeAsset false) rdr conn
}
/// Get theme assets for the given theme /// Get theme assets for the given theme
let findByThemeWithData (themeId: ThemeId) = backgroundTask { let findByThemeWithData (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByThemeWithData" log.LogTrace "ThemeAsset.findByThemeWithData"
use cmd = conn.CreateCommand() Custom.list
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId" $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id"
addParam cmd "@themeId" (string themeId) [ idParam themeId ]
use! rdr = cmd.ExecuteReaderAsync () (Map.toThemeAsset true)
return toList (Map.toThemeAsset true) rdr conn
}
/// Save a theme asset /// Save a theme asset
let save (asset: ThemeAsset) = backgroundTask { let save (asset: ThemeAsset) = backgroundTask {
log.LogTrace "ThemeAsset.save" log.LogTrace "ThemeAsset.save"
use sideCmd = conn.CreateCommand() do! Custom.nonQuery
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
$"INSERT INTO {Table.ThemeAsset} ( $"INSERT INTO {Table.ThemeAsset} (
theme_id, path, updated_on, data theme_id, path, updated_on, data
) VALUES ( ) VALUES (
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength) @themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
)" ) ON CONFLICT (theme_id, path) DO UPDATE
addParam cmd "@themeId" themeId SET updated_on = @updatedOn,
addParam cmd "@path" path data = ZEROBLOB(@dataLength)"
addParam cmd "@updatedOn" (instantParam asset.UpdatedOn) [ sqlParam "@updatedOn" (instantParam asset.UpdatedOn)
addParam cmd "@dataLength" asset.Data.Length sqlParam "@dataLength" asset.Data.Length
do! write cmd yield! (assetIdParams asset.Id) ]
conn
sideCmd.CommandText <- $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync()
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 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 do! dataStream.CopyToAsync blobStream
} }

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

@ -1,6 +1,7 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open System.IO open System.IO
open BitBadger.Sqlite.FSharp.Documents.WithConn
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
@ -9,89 +10,70 @@ open MyWebLog.Data
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteUploadData(conn: SqliteConnection, log: ILogger) = 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 /// Save an uploaded file
let add upload = backgroundTask { let add (upload: Upload) = backgroundTask {
log.LogTrace "Upload.add" log.LogTrace "Upload.add"
use cmd = conn.CreateCommand() do! Custom.nonQuery
cmd.CommandText <- $"INSERT INTO {Table.Upload} (
$"INSERT INTO {Table.Upload} ( id, web_log_id, path, updated_on, data
id, web_log_id, path, updated_on, data ) VALUES (
) VALUES ( @id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength) )"
)" [ idParam upload.Id
addUploadParameters cmd upload webLogParam upload.WebLogId
do! write cmd sqlParam "@path" (string upload.Path)
sqlParam "@updatedOn" (instantParam upload.UpdatedOn)
cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" sqlParam "@dataLength" upload.Data.Length ]
let! rowId = cmd.ExecuteScalarAsync() 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 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 do! dataStream.CopyToAsync blobStream
} }
/// Delete an uploaded file by its ID /// Delete an uploaded file by its ID
let delete (uploadId: UploadId) webLogId = backgroundTask { let delete (uploadId: UploadId) webLogId = backgroundTask {
log.LogTrace "Upload.delete" log.LogTrace "Upload.delete"
use cmd = conn.CreateCommand() let! upload =
cmd.CommandText <- Custom.single
$"SELECT id, web_log_id, path, updated_on $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
FROM {Table.Upload} [ idParam uploadId; webLogParam webLogId ]
WHERE id = @id (Map.toUpload false)
AND web_log_id = @webLogId" conn
addWebLogId cmd webLogId match upload with
addDocId cmd uploadId | Some up ->
let! rdr = cmd.ExecuteReaderAsync() do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" [ idParam up.Id ] conn
let! isFound = rdr.ReadAsync() return Ok (string up.Path)
if isFound then | None -> return Error $"Upload ID {string uploadId} not found"
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"""
} }
/// Find an uploaded file by its path for the given web log /// Find an uploaded file by its path for the given web log
let findByPath (path: string) webLogId = backgroundTask { let findByPath (path: string) webLogId =
log.LogTrace "Upload.findByPath" log.LogTrace "Upload.findByPath"
use cmd = conn.CreateCommand() Custom.single
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path" $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
addWebLogId cmd webLogId [ webLogParam webLogId; sqlParam "@path" path ]
addParam cmd "@path" path (Map.toUpload true)
let! rdr = cmd.ExecuteReaderAsync() conn
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.toUpload true rdr) else None
}
/// Find all uploaded files for the given web log (excludes data) /// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId =
log.LogTrace "Upload.findByWebLog" log.LogTrace "Upload.findByWebLog"
use cmd = conn.CreateCommand() Custom.list
cmd.CommandText <- $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId" $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId [ webLogParam webLogId ]
let! rdr = cmd.ExecuteReaderAsync() (Map.toUpload false)
return toList (Map.toUpload false) rdr conn
}
/// Find all uploaded files for the given web log /// Find all uploaded files for the given web log
let findByWebLogWithData webLogId = backgroundTask { let findByWebLogWithData webLogId =
log.LogTrace "Upload.findByWebLogWithData" log.LogTrace "Upload.findByWebLogWithData"
use cmd = conn.CreateCommand () Custom.list
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId" $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId [ webLogParam webLogId ]
let! rdr = cmd.ExecuteReaderAsync() (Map.toUpload true)
return toList (Map.toUpload true) rdr conn
}
/// Restore uploads from a backup /// Restore uploads from a backup
let restore uploads = backgroundTask { let restore uploads = backgroundTask {

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

@ -1,79 +1,68 @@
namespace MyWebLog.Data.SQLite 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.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog web log data implementation /// SQLite myWebLog web log data implementation
type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = type SQLiteWebLogData(conn: SqliteConnection, log: ILogger) =
/// Add a web log /// Add a web log
let add webLog = let add webLog =
log.LogTrace "WebLog.add" log.LogTrace "WebLog.add"
Document.insert<WebLog> conn ser Table.WebLog webLog insert<WebLog> Table.WebLog webLog conn
/// Retrieve all web logs /// Retrieve all web logs
let all () = let all () =
log.LogTrace "WebLog.all" log.LogTrace "WebLog.all"
use cmd = conn.CreateCommand() Find.all<WebLog> Table.WebLog conn
cmd.CommandText <- QueryOld.selectFromTable Table.WebLog
cmdToList<WebLog> cmd ser
/// Delete a web log by its ID /// Delete a web log by its ID
let delete webLogId = backgroundTask { let delete webLogId =
log.LogTrace "WebLog.delete" log.LogTrace "WebLog.delete"
let idField = "data ->> 'WebLogId'" let subQuery table =
let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {idField} = @webLogId)" $"""(SELECT data ->> 'Id' FROM {table} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}"""
use cmd = conn.CreateCommand() Custom.nonQuery
cmd.CommandText <- $" $"""DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
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.PostRevision} WHERE post_id IN {subQuery Table.Post}; DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page}; DELETE FROM {Table.Post} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
DELETE FROM {Table.Post} WHERE {idField} = @webLogId; DELETE FROM {Table.Page} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
DELETE FROM {Table.Page} WHERE {idField} = @webLogId; DELETE FROM {Table.Category} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
DELETE FROM {Table.Category} WHERE {idField} = @webLogId; DELETE FROM {Table.TagMap} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
DELETE FROM {Table.TagMap} WHERE {idField} = @webLogId; DELETE FROM {Table.Upload} WHERE web_log_id = @id;
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId; DELETE FROM {Table.WebLogUser} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
DELETE FROM {Table.WebLogUser} WHERE {idField} = @webLogId; DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
DELETE FROM {Table.WebLog} WHERE id = @webLogId" [ webLogParam webLogId ]
addWebLogId cmd webLogId conn
do! write cmd
}
/// Find a web log by its host (URL base) /// Find a web log by its host (URL base)
let findByHost (url: string) = backgroundTask { let findByHost (url: string) =
log.LogTrace "WebLog.findByHost" log.LogTrace "WebLog.findByHost"
use cmd = conn.CreateCommand() Find.firstByFieldEquals<WebLog> Table.WebLog (nameof WebLog.Empty.UrlBase) url conn
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 a web log by its ID /// Find a web log by its ID
let findById webLogId = let findById webLogId =
log.LogTrace "WebLog.findById" 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 /// Update redirect rules for a web log
let updateRedirectRules (webLog: WebLog) = let updateRedirectRules (webLog: WebLog) =
log.LogTrace "WebLog.updateRedirectRules" 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 /// Update RSS options for a web log
let updateRssOptions (webLog: WebLog) = let updateRssOptions (webLog: WebLog) =
log.LogTrace "WebLog.updateRssOptions" 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 /// Update settings for a web log
let updateSettings (webLog: WebLog) = let updateSettings (webLog: WebLog) =
log.LogTrace "WebLog.updateSettings" log.LogTrace "WebLog.updateSettings"
Document.update conn ser Table.WebLog webLog.Id webLog Update.full Table.WebLog webLog.Id webLog conn
interface IWebLogData with interface IWebLogData with
member _.Add webLog = add webLog member _.Add webLog = add webLog

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

@ -1,125 +1,85 @@
namespace MyWebLog.Data.SQLite namespace MyWebLog.Data.SQLite
open BitBadger.Sqlite.FSharp.Documents
open BitBadger.Sqlite.FSharp.Documents.WithConn
open Microsoft.Data.Sqlite open Microsoft.Data.Sqlite
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open MyWebLog open MyWebLog
open MyWebLog.Data open MyWebLog.Data
open Newtonsoft.Json
/// SQLite myWebLog user data implementation /// SQLite myWebLog user data implementation
type SQLiteWebLogUserData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) = type SQLiteWebLogUserData(conn: SqliteConnection, 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
/// Find a user by their ID for the given web log /// Find a user by their ID for the given web log
let findById userId webLogId = let findById userId webLogId =
log.LogTrace "WebLogUser.findById" 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 /// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask { let delete userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.delete" log.LogTrace "WebLogUser.delete"
match! findById userId webLogId with match! findById userId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand() let! pageCount = Count.byFieldEquals Table.Page (nameof Page.Empty.AuthorId) (string userId) conn
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Page} WHERE data ->> 'AuthorId' = @id" let! postCount = Count.byFieldEquals Table.Post (nameof Post.Empty.AuthorId) (string userId) conn
addDocId cmd userId
let! pageCount = count cmd
cmd.CommandText <- cmd.CommandText.Replace($"FROM {Table.Page}", $"FROM {Table.Post}")
let! postCount = count cmd
if pageCount + postCount > 0 then if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete" return Error "User has pages or posts; cannot delete"
else else
do! Document.delete conn Table.WebLogUser userId do! Delete.byId Table.WebLogUser userId conn
return Ok true return Ok true
| None -> return Error "User does not exist" | None -> return Error "User does not exist"
} }
/// Find a user by their e-mail address for the given web log /// Find a user by their e-mail address for the given web log
let findByEmail (email: string) webLogId = backgroundTask { let findByEmail (email: string) webLogId =
log.LogTrace "WebLogUser.findByEmail" log.LogTrace "WebLogUser.findByEmail"
use cmd = conn.CreateCommand() Custom.single
cmd.CommandText <- $" $"""{Document.Query.selectByWebLog Table.WebLogUser}
{QueryOld.selectFromTable Table.WebLogUser} AND {Query.whereFieldEquals (nameof WebLogUser.Empty.Email) "@email"}"""
WHERE {QueryOld.whereByWebLog} [ webLogParam webLogId; sqlParam "@email" email ]
AND data ->> '{nameof WebLogUser.Empty.Email}' = @email" fromData<WebLogUser>
addWebLogId cmd webLogId conn
addParam cmd "@email" email
use! rdr = cmd.ExecuteReaderAsync()
let! isFound = rdr.ReadAsync()
return if isFound then Some (Map.fromDoc<WebLogUser> ser rdr) else None
}
/// Get all users for the given web log /// Get all users for the given web log
let findByWebLog webLogId = backgroundTask { let findByWebLog webLogId = backgroundTask {
log.LogTrace "WebLogUser.findByWebLog" 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() return users |> List.sortBy _.PreferredName.ToLowerInvariant()
} }
/// Find the names of users by their IDs for the given web log /// Find the names of users by their IDs for the given web log
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask { let findNames webLogId (userIds: WebLogUserId list) =
log.LogTrace "WebLogUser.findNames" log.LogTrace "WebLogUser.findNames"
use cmd = conn.CreateCommand()
let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds
cmd.CommandText <- $"{QueryOld.selectFromTable Table.WebLogUser} WHERE {QueryOld.whereByWebLog} {nameSql}" Custom.list
addWebLogId cmd webLogId $"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}"
cmd.Parameters.AddRange nameParams (webLogParam webLogId :: nameParams)
let! users = cmdToList<WebLogUser> cmd ser (fun rdr ->
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName }) 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 /// Restore users from a backup
let restore users = backgroundTask { let restore users = backgroundTask {
log.LogTrace "WebLogUser.restore" log.LogTrace "WebLogUser.restore"
for user in users do for user in users do do! save user
do! add user
} }
/// Set a user's last seen date/time to now /// Set a user's last seen date/time to now
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask { let setLastSeen userId webLogId = backgroundTask {
log.LogTrace "WebLogUser.setLastSeen" log.LogTrace "WebLogUser.setLastSeen"
use cmd = conn.CreateCommand() match! findById userId webLogId with
cmd.CommandText <- $" | Some _ -> do! Update.partialById Table.WebLogUser userId {| LastSeenOn = Noda.now () |} conn
UPDATE {Table.WebLogUser} | None -> ()
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
} }
/// Update a user
let update (user: WebLogUser) =
log.LogTrace "WebLogUser.update"
Document.update conn ser Table.WebLogUser user.Id user
interface IWebLogUserData with interface IWebLogUserData with
member _.Add user = add user member _.Add user = save user
member _.Delete userId webLogId = delete userId webLogId member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId 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 _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = update user member _.Update user = save user

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

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