First cut of SQLite doc library

This commit is contained in:
Daniel J. Summers 2023-12-19 21:24:13 -05:00
parent bb4252f3c1
commit f461b10ebc
10 changed files with 221 additions and 455 deletions

View File

@ -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

View File

@ -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
}

View File

@ -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
}

View File

@ -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)

View File

@ -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

View File

@ -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
}

View File

@ -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 {

View File

@ -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

View File

@ -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

View File

@ -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