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
|
||||
|
|
@ -224,7 +205,7 @@ module Map =
|
|||
let toUpload includeData rdr : Upload =
|
||||
let data =
|
||||
if includeData then
|
||||
use dataStream = new MemoryStream ()
|
||||
use dataStream = new MemoryStream()
|
||||
use blobStream = getStream "data" rdr
|
||||
blobStream.CopyTo dataStream
|
||||
dataStream.ToArray ()
|
||||
|
|
@ -235,79 +216,20 @@ module Map =
|
|||
Path = getString "path" rdr |> Permalink
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Data = data }
|
||||
|
||||
/// Map from a document to a domain type, specifying the field name for the document
|
||||
let fromData<'T> ser rdr fieldName : 'T =
|
||||
Utils.deserialize<'T> ser (getString fieldName rdr)
|
||||
|
||||
/// Map from a document to a domain type
|
||||
let fromDoc<'T> ser rdr : 'T =
|
||||
fromData<'T> ser rdr "data"
|
||||
|
||||
/// Create a list of items for the results of the given command
|
||||
let cmdToList<'TDoc> (cmd: SqliteCommand) ser = backgroundTask {
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let mutable it: 'TDoc list = []
|
||||
while! rdr.ReadAsync() do
|
||||
it <- Map.fromDoc ser rdr :: it
|
||||
return List.rev it
|
||||
}
|
||||
|
||||
/// Queries to assist with document manipulation
|
||||
[<Obsolete("change me")>]
|
||||
module QueryOld =
|
||||
/// Create a named parameter
|
||||
let sqlParam name (value: obj) =
|
||||
SqliteParameter(name, value)
|
||||
|
||||
/// Fragment to add an ID condition to a WHERE clause (parameter @id)
|
||||
let whereById =
|
||||
"data ->> 'Id' = @id"
|
||||
|
||||
/// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
|
||||
let whereByWebLog =
|
||||
"data ->> 'WebLogId' = @webLogId"
|
||||
|
||||
/// A SELECT/FROM pair for the given table
|
||||
let selectFromTable table =
|
||||
$"SELECT data FROM %s{table}"
|
||||
|
||||
/// An INSERT statement for a document (parameter @data)
|
||||
let insert table =
|
||||
$"INSERT INTO %s{table} VALUES (@data)"
|
||||
|
||||
/// A SELECT query to count documents for a given web log ID
|
||||
let countByWebLog table =
|
||||
$"SELECT COUNT(*) FROM %s{table} WHERE {whereByWebLog}"
|
||||
|
||||
/// An UPDATE query to update a full document by its ID (parameters @data and @id)
|
||||
let updateById table =
|
||||
$"UPDATE %s{table} SET data = @data WHERE {whereById}"
|
||||
|
||||
/// A DELETE query to delete a document by its ID (parameter @id)
|
||||
let deleteById table =
|
||||
$"DELETE FROM %s{table} WHERE {whereById}"
|
||||
|
||||
|
||||
/// Create a document ID parameter
|
||||
let idParam (key: 'TKey) =
|
||||
SqliteParameter("@id", string key)
|
||||
sqlParam "@id" (string key)
|
||||
|
||||
/// Create a web log ID parameter
|
||||
let webLogParam (webLogId: WebLogId) =
|
||||
SqliteParameter("@webLogId", string webLogId)
|
||||
sqlParam "@webLogId" (string webLogId)
|
||||
|
||||
let addParam (cmd: SqliteCommand) name (value: obj) =
|
||||
cmd.Parameters.AddWithValue(name, value) |> ignore
|
||||
|
||||
/// Add an ID parameter for a document
|
||||
let addDocId<'TKey> (cmd: SqliteCommand) (id: 'TKey) =
|
||||
addParam cmd "@id" (string id)
|
||||
|
||||
/// Add a document parameter
|
||||
let addDocParam<'TDoc> (cmd: SqliteCommand) (doc: 'TDoc) ser =
|
||||
addParam cmd "@data" (Utils.serialize ser doc)
|
||||
|
||||
/// Add a web log ID parameter
|
||||
let addWebLogId (cmd: SqliteCommand) (webLogId: WebLogId) =
|
||||
addParam cmd "@webLogId" (string webLogId)
|
||||
|
||||
open BitBadger.Sqlite.FSharp.Documents
|
||||
open BitBadger.Sqlite.FSharp.Documents.WithConn
|
||||
|
|
@ -340,17 +262,6 @@ module Document =
|
|||
return int count
|
||||
}
|
||||
|
||||
/// Find a document by its ID
|
||||
[<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
|
||||
|
|
@ -358,46 +269,7 @@ module Document =
|
|||
/// Find documents for the given web log
|
||||
let findByWebLog<'TDoc> table (webLogId: WebLogId) conn =
|
||||
Find.byFieldEquals<'TDoc> table "WebLogId" webLogId conn
|
||||
|
||||
/// Insert a document
|
||||
[<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) ]
|
||||
conn
|
||||
for addRev in toAdd do
|
||||
do! Custom.nonQuery $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" (revParams key addRev) conn
|
||||
for delRev in toDelete do
|
||||
do! Custom.nonQuery
|
||||
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
|
||||
[ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ]
|
||||
conn
|
||||
for addRev in toAdd do
|
||||
do! Custom.nonQuery
|
||||
$"INSERT INTO {revTable} VALUES (@id, @asOf, @text)"
|
||||
[ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" addRev.Text ]
|
||||
conn
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 <-
|
||||
$"INSERT INTO {Table.Upload} (
|
||||
id, web_log_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
)"
|
||||
addUploadParameters cmd upload
|
||||
do! write cmd
|
||||
|
||||
cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id"
|
||||
let! rowId = cmd.ExecuteScalarAsync()
|
||||
|
||||
do! Custom.nonQuery
|
||||
$"INSERT INTO {Table.Upload} (
|
||||
id, web_log_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
)"
|
||||
[ idParam upload.Id
|
||||
webLogParam upload.WebLogId
|
||||
sqlParam "@path" (string upload.Path)
|
||||
sqlParam "@updatedOn" (instantParam upload.UpdatedOn)
|
||||
sqlParam "@dataLength" upload.Data.Length ]
|
||||
conn
|
||||
let! rowId =
|
||||
Custom.scalar $"SELECT ROWID FROM {Table.Upload} WHERE id = @id" [ idParam upload.Id ] (_.GetInt64(0)) conn
|
||||
use dataStream = new MemoryStream(upload.Data)
|
||||
use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId :?> int64)
|
||||
use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId)
|
||||
do! dataStream.CopyToAsync blobStream
|
||||
}
|
||||
|
||||
/// Delete an uploaded file by its ID
|
||||
let delete (uploadId: UploadId) webLogId = backgroundTask {
|
||||
log.LogTrace "Upload.delete"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"SELECT id, web_log_id, path, updated_on
|
||||
FROM {Table.Upload}
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
addDocId cmd uploadId
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
let! isFound = rdr.ReadAsync()
|
||||
if isFound then
|
||||
let upload = Map.toUpload false rdr
|
||||
do! rdr.CloseAsync()
|
||||
cmd.CommandText <- $"DELETE FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
|
||||
do! write cmd
|
||||
return Ok (string upload.Path)
|
||||
else
|
||||
return Error $"""Upload ID {cmd.Parameters["@id"].Value} not found"""
|
||||
let! upload =
|
||||
Custom.single
|
||||
$"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
|
||||
[ idParam uploadId; webLogParam webLogId ]
|
||||
(Map.toUpload false)
|
||||
conn
|
||||
match upload with
|
||||
| Some up ->
|
||||
do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" [ idParam up.Id ] conn
|
||||
return Ok (string up.Path)
|
||||
| None -> return Error $"Upload ID {string uploadId} not found"
|
||||
}
|
||||
|
||||
/// Find an uploaded file by its path for the given web log
|
||||
let findByPath (path: string) webLogId = backgroundTask {
|
||||
let findByPath (path: string) webLogId =
|
||||
log.LogTrace "Upload.findByPath"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|
||||
addWebLogId cmd webLogId
|
||||
addParam cmd "@path" path
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.toUpload true rdr) else None
|
||||
}
|
||||
Custom.single
|
||||
$"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|
||||
[ webLogParam webLogId; sqlParam "@path" path ]
|
||||
(Map.toUpload true)
|
||||
conn
|
||||
|
||||
/// Find all uploaded files for the given web log (excludes data)
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "Upload.findByWebLog"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
return toList (Map.toUpload false) rdr
|
||||
}
|
||||
Custom.list
|
||||
$"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
|
||||
[ webLogParam webLogId ]
|
||||
(Map.toUpload false)
|
||||
conn
|
||||
|
||||
/// Find all uploaded files for the given web log
|
||||
let findByWebLogWithData webLogId = backgroundTask {
|
||||
let findByWebLogWithData webLogId =
|
||||
log.LogTrace "Upload.findByWebLogWithData"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
return toList (Map.toUpload true) rdr
|
||||
}
|
||||
Custom.list
|
||||
$"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId"
|
||||
[ webLogParam webLogId ]
|
||||
(Map.toUpload true)
|
||||
conn
|
||||
|
||||
/// Restore uploads from a backup
|
||||
let restore uploads = backgroundTask {
|
||||
|
|
|
|||
|
|
@ -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};
|
||||
DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
|
||||
DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
|
||||
DELETE FROM {Table.Post} WHERE {idField} = @webLogId;
|
||||
DELETE FROM {Table.Page} WHERE {idField} = @webLogId;
|
||||
DELETE FROM {Table.Category} WHERE {idField} = @webLogId;
|
||||
DELETE FROM {Table.TagMap} WHERE {idField} = @webLogId;
|
||||
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
|
||||
DELETE FROM {Table.WebLogUser} WHERE {idField} = @webLogId;
|
||||
DELETE FROM {Table.WebLog} WHERE id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
do! write cmd
|
||||
}
|
||||
let subQuery table =
|
||||
$"""(SELECT data ->> 'Id' FROM {table} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"}"""
|
||||
Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
|
||||
DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
|
||||
DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
|
||||
DELETE FROM {Table.Post} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
|
||||
DELETE FROM {Table.Page} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
|
||||
DELETE FROM {Table.Category} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
|
||||
DELETE FROM {Table.TagMap} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
|
||||
DELETE FROM {Table.Upload} WHERE web_log_id = @id;
|
||||
DELETE FROM {Table.WebLogUser} WHERE {Query.whereFieldEquals "WebLogId" "@webLogId"};
|
||||
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
|
||||
[ webLogParam webLogId ]
|
||||
conn
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
let findByHost (url: string) = backgroundTask {
|
||||
let findByHost (url: string) =
|
||||
log.LogTrace "WebLog.findByHost"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"{QueryOld.selectFromTable Table.WebLog} WHERE data ->> '{nameof WebLog.Empty.UrlBase}' = @urlBase"
|
||||
addParam cmd "@urlBase" url
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<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…
Reference in New Issue
Block a user