Version 2.1 #41
@ -23,8 +23,12 @@ type PostgresWebLogData(log: ILogger) =
|
||||
log.LogTrace "WebLog.delete"
|
||||
Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PostComment}
|
||||
WHERE data ->> '{nameof Comment.Empty.PostId}' IN
|
||||
(SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|
||||
WHERE data ->> '{nameof Comment.Empty.PostId}'
|
||||
IN (SELECT id FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|
||||
DELETE FROM {Table.PostRevision}
|
||||
WHERE post_id IN (SELECT data ->> 'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|
||||
DELETE FROM {Table.PageRevision}
|
||||
WHERE page_id IN (SELECT data ->> 'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
|
||||
{Query.Delete.byContains Table.Post};
|
||||
{Query.Delete.byContains Table.Page};
|
||||
{Query.Delete.byContains Table.Category};
|
||||
|
||||
@ -168,16 +168,6 @@ module Map =
|
||||
/// Get a string value from a data reader
|
||||
let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col)
|
||||
|
||||
/// Parse a Duration from the given value
|
||||
let parseDuration value =
|
||||
match DurationPattern.Roundtrip.Parse value with
|
||||
| it when it.Success -> it.Value
|
||||
| it -> raise it.Exception
|
||||
|
||||
/// Get a Duration value from a data reader
|
||||
let getDuration col rdr =
|
||||
getString col rdr |> parseDuration
|
||||
|
||||
/// Parse an Instant from the given value
|
||||
let parseInstant value =
|
||||
match InstantPattern.General.Parse value with
|
||||
@ -211,29 +201,10 @@ module Map =
|
||||
let tryString col (rdr: SqliteDataReader) =
|
||||
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
|
||||
|
||||
/// Get a possibly null Duration value from a data reader
|
||||
let tryDuration col rdr =
|
||||
tryString col rdr |> Option.map parseDuration
|
||||
|
||||
/// Get a possibly null Instant value from a data reader
|
||||
let tryInstant col rdr =
|
||||
tryString col rdr |> Option.map parseInstant
|
||||
|
||||
/// Get a possibly null timespan value from a data reader
|
||||
let tryTimeSpan col (rdr: SqliteDataReader) =
|
||||
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
|
||||
|
||||
/// Map an id field to a category ID
|
||||
let toCategoryId rdr = getString "id" rdr |> CategoryId
|
||||
|
||||
/// Create a custom feed from the current row in the given data reader
|
||||
let toCustomFeed ser rdr : CustomFeed =
|
||||
{ Id = getString "id" rdr |> CustomFeedId
|
||||
Source = getString "source" rdr |> CustomFeedSource.Parse
|
||||
Path = getString "path" rdr |> Permalink
|
||||
Podcast = tryString "podcast" rdr |> Option.map (Utils.deserialize ser)
|
||||
}
|
||||
|
||||
/// Create a permalink from the current row in the given data reader
|
||||
let toPermalink rdr = getString "permalink" rdr |> Permalink
|
||||
|
||||
@ -242,22 +213,6 @@ module Map =
|
||||
{ AsOf = getInstant "as_of" rdr
|
||||
Text = getString "revision_text" rdr |> MarkupText.Parse }
|
||||
|
||||
/// Create a tag mapping from the current row in the given data reader
|
||||
let toTagMap rdr : TagMap =
|
||||
{ Id = getString "id" rdr |> TagMapId
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
Tag = getString "tag" rdr
|
||||
UrlValue = getString "url_value" rdr
|
||||
}
|
||||
|
||||
/// Create a theme from the current row in the given data reader (excludes templates)
|
||||
let toTheme rdr : Theme =
|
||||
{ Theme.Empty with
|
||||
Id = getString "id" rdr |> ThemeId
|
||||
Name = getString "name" rdr
|
||||
Version = getString "version" rdr
|
||||
}
|
||||
|
||||
/// Create a theme asset from the current row in the given data reader
|
||||
let toThemeAsset includeData rdr : ThemeAsset =
|
||||
let assetData =
|
||||
@ -272,12 +227,6 @@ module Map =
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Data = assetData }
|
||||
|
||||
/// Create a theme template from the current row in the given data reader
|
||||
let toThemeTemplate includeText rdr : ThemeTemplate =
|
||||
{ Name = getString "name" rdr
|
||||
Text = if includeText then getString "template" rdr else ""
|
||||
}
|
||||
|
||||
/// Create an uploaded file from the current row in the given data reader
|
||||
let toUpload includeData rdr : Upload =
|
||||
let data =
|
||||
@ -294,46 +243,6 @@ module Map =
|
||||
UpdatedOn = getInstant "updated_on" rdr
|
||||
Data = data }
|
||||
|
||||
/// Create a web log from the current row in the given data reader
|
||||
let toWebLog ser rdr : WebLog =
|
||||
{ Id = getString "id" rdr |> WebLogId
|
||||
Name = getString "name" rdr
|
||||
Slug = getString "slug" rdr
|
||||
Subtitle = tryString "subtitle" rdr
|
||||
DefaultPage = getString "default_page" rdr
|
||||
PostsPerPage = getInt "posts_per_page" rdr
|
||||
ThemeId = getString "theme_id" rdr |> ThemeId
|
||||
UrlBase = getString "url_base" rdr
|
||||
TimeZone = getString "time_zone" rdr
|
||||
AutoHtmx = getBoolean "auto_htmx" rdr
|
||||
Uploads = getString "uploads" rdr |> UploadDestination.Parse
|
||||
Rss = {
|
||||
IsFeedEnabled = getBoolean "is_feed_enabled" rdr
|
||||
FeedName = getString "feed_name" rdr
|
||||
ItemsInFeed = tryInt "items_in_feed" rdr
|
||||
IsCategoryEnabled = getBoolean "is_category_enabled" rdr
|
||||
IsTagEnabled = getBoolean "is_tag_enabled" rdr
|
||||
Copyright = tryString "copyright" rdr
|
||||
CustomFeeds = []
|
||||
}
|
||||
RedirectRules = getString "redirect_rules" rdr |> Utils.deserialize ser
|
||||
}
|
||||
|
||||
/// Create a web log user from the current row in the given data reader
|
||||
let toWebLogUser rdr : WebLogUser =
|
||||
{ Id = getString "id" rdr |> WebLogUserId
|
||||
WebLogId = getString "web_log_id" rdr |> WebLogId
|
||||
Email = getString "email" rdr
|
||||
FirstName = getString "first_name" rdr
|
||||
LastName = getString "last_name" rdr
|
||||
PreferredName = getString "preferred_name" rdr
|
||||
PasswordHash = getString "password_hash" rdr
|
||||
Url = tryString "url" rdr
|
||||
AccessLevel = getString "access_level" rdr |> AccessLevel.Parse
|
||||
CreatedOn = getInstant "created_on" rdr
|
||||
LastSeenOn = tryInstant "last_seen_on" rdr
|
||||
}
|
||||
|
||||
/// 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)
|
||||
@ -409,6 +318,16 @@ module Document =
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a document by its ID
|
||||
let findById<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"{Query.selectFromTable table} WHERE {Query.whereById}"
|
||||
addDocId cmd key
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<'TDoc> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Find a document by its ID and web log ID
|
||||
let findByIdAndWebLog<'TKey, 'TDoc> (conn: SqliteConnection) ser table (key: 'TKey) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
@ -444,6 +363,17 @@ module Document =
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update a field in a document by its ID
|
||||
let updateField<'TKey, 'TValue> (conn: SqliteConnection) ser table (key: 'TKey) jsonField
|
||||
(value: 'TValue) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
$"UPDATE %s{table} SET data = json_set(data, '$.{jsonField}', json(@it)) WHERE {Query.whereById}"
|
||||
addDocId cmd key
|
||||
addParam cmd "@it" (Utils.serialize ser value)
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Delete a document by its ID
|
||||
let delete<'TKey> (conn: SqliteConnection) table (key: 'TKey) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
|
||||
@ -186,14 +186,7 @@ type SQLitePageData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
log.LogTrace "Page.updatePriorPermalinks"
|
||||
match! findById pageId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Page}
|
||||
SET data = json_set(data, '$.{nameof Page.Empty.PriorPermalinks}', json(@links))
|
||||
WHERE {Query.whereById}"
|
||||
addDocId cmd pageId
|
||||
addParam cmd "@links" (Utils.serialize ser permalinks)
|
||||
do! write cmd
|
||||
do! Document.updateField conn ser Table.Page pageId (nameof Page.Empty.PriorPermalinks) permalinks
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
@ -224,14 +224,7 @@ type SQLitePostData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
|
||||
match! findById postId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.Post}
|
||||
SET data = json_set(data, '$.{nameof Post.Empty.PriorPermalinks}', json(@links))
|
||||
WHERE {Query.whereById}"
|
||||
addDocId cmd postId
|
||||
addParam cmd "@links" (Utils.serialize ser permalinks)
|
||||
do! write cmd
|
||||
do! Document.updateField conn ser Table.Post postId (nameof Post.Empty.PriorPermalinks) permalinks
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
@ -1,77 +1,62 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
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) =
|
||||
type SQLiteThemeData(conn : SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// The JSON field for the theme ID
|
||||
let idField = $"data ->> '{nameof Theme.Empty.Id}'"
|
||||
|
||||
/// Remove the template text from a 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 {
|
||||
log.LogTrace "Theme.all"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let themes = toList Map.toTheme rdr
|
||||
do! rdr.CloseAsync ()
|
||||
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let templates =
|
||||
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|
||||
|> List.ofSeq
|
||||
return
|
||||
themes
|
||||
|> List.map (fun t ->
|
||||
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
|
||||
cmd.CommandText <- $"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
|
||||
let! themes = cmdToList<Theme> cmd ser
|
||||
return themes |> List.map withoutTemplateText
|
||||
}
|
||||
|
||||
/// Does a given theme exist?
|
||||
let exists (themeId: ThemeId) = backgroundTask {
|
||||
log.LogTrace "Theme.exists"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
|
||||
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
|
||||
let findById (themeId: ThemeId) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let theme = Map.toTheme rdr
|
||||
let templateCmd = conn.CreateCommand ()
|
||||
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
|
||||
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
|
||||
use! templateRdr = templateCmd.ExecuteReaderAsync ()
|
||||
return Some { theme with Templates = toList (Map.toThemeTemplate true) templateRdr }
|
||||
else
|
||||
return None
|
||||
}
|
||||
let findById themeId =
|
||||
log.LogTrace "Theme.findById"
|
||||
Document.findById<ThemeId, Theme> conn ser Table.Theme themeId
|
||||
|
||||
/// Find a theme by its ID (excludes the text of templates)
|
||||
let findByIdWithoutText themeId = backgroundTask {
|
||||
match! findById themeId with
|
||||
| Some theme ->
|
||||
return Some {
|
||||
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
|
||||
}
|
||||
| None -> return None
|
||||
log.LogTrace "Theme.findByIdWithoutText"
|
||||
let! theme = findById themeId
|
||||
return theme |> Option.map withoutTemplateText
|
||||
}
|
||||
|
||||
/// 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 theme_asset WHERE theme_id = @id;
|
||||
DELETE FROM theme_template WHERE theme_id = @id;
|
||||
DELETE FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string themeId) |> ignore
|
||||
cmd.CommandText <- $"
|
||||
DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
|
||||
DELETE FROM {Table.Theme} WHERE {Query.whereById}"
|
||||
addDocId cmd themeId
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
@ -79,58 +64,10 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||
|
||||
/// Save a theme
|
||||
let save (theme: Theme) = backgroundTask {
|
||||
use cmd = conn.CreateCommand()
|
||||
let! oldTheme = findById theme.Id
|
||||
cmd.CommandText <-
|
||||
match oldTheme with
|
||||
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
|
||||
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
|
||||
[ cmd.Parameters.AddWithValue ("@id", string theme.Id)
|
||||
cmd.Parameters.AddWithValue ("@name", theme.Name)
|
||||
cmd.Parameters.AddWithValue ("@version", theme.Version)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
|
||||
let toDelete, toAdd =
|
||||
Utils.diffLists (oldTheme |> Option.map _.Templates |> Option.defaultValue []) theme.Templates _.Name
|
||||
let toUpdate =
|
||||
theme.Templates
|
||||
|> List.filter (fun t ->
|
||||
not (toDelete |> List.exists (fun d -> d.Name = t.Name))
|
||||
&& not (toAdd |> List.exists (fun a -> a.Name = t.Name)))
|
||||
cmd.CommandText <-
|
||||
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
|
||||
cmd.Parameters.Clear ()
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", string theme.Id)
|
||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
||||
cmd.Parameters.Add ("@template", SqliteType.Text)
|
||||
] |> ignore
|
||||
toUpdate
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- template.Name
|
||||
cmd.Parameters["@template"].Value <- template.Text
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
|
||||
toAdd
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- template.Name
|
||||
cmd.Parameters["@template"].Value <- template.Text
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
|
||||
cmd.Parameters.Remove cmd.Parameters["@template"]
|
||||
toDelete
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name"].Value <- template.Name
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
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
|
||||
}
|
||||
|
||||
interface IThemeData with
|
||||
@ -145,91 +82,94 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||
open System.IO
|
||||
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeAssetData (conn : SqliteConnection) =
|
||||
type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
|
||||
|
||||
/// Get all theme assets (excludes data)
|
||||
let all () = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.all"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
|
||||
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
|
||||
let deleteByTheme (themeId: ThemeId) = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.deleteByTheme"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
|
||||
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
|
||||
let findById assetId = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.findById"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
cmd.Parameters.AddWithValue ("@path", path)
|
||||
] |> ignore
|
||||
addParam cmd "@themeId" themeId
|
||||
addParam cmd "@path" path
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.toThemeAsset true rdr) else None
|
||||
}
|
||||
|
||||
/// Get theme assets for the given theme (excludes data)
|
||||
let findByTheme (themeId: ThemeId) = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.findByTheme"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
|
||||
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
|
||||
}
|
||||
|
||||
/// Get theme assets for the given theme
|
||||
let findByThemeWithData (themeId: ThemeId) = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.findByThemeWithData"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", string themeId) |> ignore
|
||||
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
|
||||
}
|
||||
|
||||
/// Save a theme asset
|
||||
let save (asset: ThemeAsset) = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.save"
|
||||
use sideCmd = conn.CreateCommand()
|
||||
sideCmd.CommandText <-
|
||||
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
sideCmd.CommandText <- $"SELECT COUNT(*) FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
|
||||
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
sideCmd.Parameters.AddWithValue ("@path", path)
|
||||
] |> ignore
|
||||
addParam sideCmd "@themeId" themeId
|
||||
addParam sideCmd "@path" path
|
||||
let! exists = count sideCmd
|
||||
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
if exists = 1 then
|
||||
"UPDATE theme_asset
|
||||
$"UPDATE {Table.ThemeAsset}
|
||||
SET updated_on = @updatedOn,
|
||||
data = ZEROBLOB(@dataLength)
|
||||
WHERE theme_id = @themeId
|
||||
AND path = @path"
|
||||
else
|
||||
"INSERT INTO theme_asset (
|
||||
$"INSERT INTO {Table.ThemeAsset} (
|
||||
theme_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
)"
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
cmd.Parameters.AddWithValue ("@path", path)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", instantParam asset.UpdatedOn)
|
||||
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
|
||||
] |> ignore
|
||||
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 theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
sideCmd.CommandText <- $"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
|
||||
let! rowId = sideCmd.ExecuteScalarAsync()
|
||||
|
||||
use dataStream = new MemoryStream(asset.Data)
|
||||
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
|
||||
use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId :?> int64)
|
||||
do! dataStream.CopyToAsync blobStream
|
||||
}
|
||||
|
||||
|
||||
@ -2,26 +2,27 @@ namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.IO
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog web log data implementation
|
||||
type SQLiteUploadData(conn: SqliteConnection) =
|
||||
type SQLiteUploadData(conn: SqliteConnection, log: ILogger) =
|
||||
|
||||
/// Add parameters for uploaded file INSERT and UPDATE statements
|
||||
let addUploadParameters (cmd: SqliteCommand) (upload: Upload) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string upload.Id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string upload.WebLogId)
|
||||
cmd.Parameters.AddWithValue ("@path", string upload.Path)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
|
||||
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
|
||||
] |> ignore
|
||||
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 {
|
||||
log.LogTrace "Upload.add"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO upload (
|
||||
$"INSERT INTO {Table.Upload} (
|
||||
id, web_log_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@id, @webLogId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
@ -29,49 +30,54 @@ type SQLiteUploadData(conn: SqliteConnection) =
|
||||
addUploadParameters cmd upload
|
||||
do! write cmd
|
||||
|
||||
cmd.CommandText <- "SELECT ROWID FROM upload WHERE id = @id"
|
||||
cmd.CommandText <- $"SELECT ROWID FROM {Table.Upload} WHERE id = @id"
|
||||
let! rowId = cmd.ExecuteScalarAsync()
|
||||
|
||||
use dataStream = new MemoryStream(upload.Data)
|
||||
use blobStream = new SqliteBlob (conn, "upload", "data", rowId :?> int64)
|
||||
use blobStream = new SqliteBlob(conn, Table.Upload, "data", rowId :?> int64)
|
||||
do! dataStream.CopyToAsync blobStream
|
||||
}
|
||||
|
||||
/// Delete an uploaded file by its ID
|
||||
let delete uploadId webLogId = backgroundTask {
|
||||
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 upload
|
||||
$"SELECT id, web_log_id, path, updated_on
|
||||
FROM {Table.Upload}
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@id", string uploadId) |> ignore
|
||||
addDocId cmd uploadId
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
if (rdr.Read ()) then
|
||||
let! isFound = rdr.ReadAsync()
|
||||
if isFound then
|
||||
let upload = Map.toUpload false rdr
|
||||
do! rdr.CloseAsync()
|
||||
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|
||||
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"]} not found"""
|
||||
return Error $"""Upload ID {cmd.Parameters["@id"].Value} not found"""
|
||||
}
|
||||
|
||||
/// Find an uploaded file by its path for the given web log
|
||||
let findByPath (path: string) webLogId = backgroundTask {
|
||||
log.LogTrace "Upload.findByPath"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId AND path = @path"
|
||||
cmd.CommandText <- $"SELECT *, ROWID FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@path", path) |> ignore
|
||||
addParam cmd "@path" path
|
||||
let! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toUpload true rdr) else None
|
||||
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)
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "Upload.findByWebLog"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
|
||||
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
|
||||
@ -79,8 +85,9 @@ type SQLiteUploadData(conn: SqliteConnection) =
|
||||
|
||||
/// Find all uploaded files for the given web log
|
||||
let findByWebLogWithData webLogId = backgroundTask {
|
||||
log.LogTrace "Upload.findByWebLogWithData"
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM upload WHERE web_log_id = @webLogId"
|
||||
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
|
||||
@ -88,6 +95,7 @@ type SQLiteUploadData(conn: SqliteConnection) =
|
||||
|
||||
/// Restore uploads from a backup
|
||||
let restore uploads = backgroundTask {
|
||||
log.LogTrace "Upload.restore"
|
||||
for upload in uploads do do! add upload
|
||||
}
|
||||
|
||||
|
||||
@ -2,263 +2,78 @@ namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Newtonsoft.Json
|
||||
|
||||
// The web log podcast insert loop is not statically compilable; this is OK
|
||||
#nowarn "3511"
|
||||
|
||||
/// SQLite myWebLog web log data implementation
|
||||
type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
|
||||
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
|
||||
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
|
||||
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
|
||||
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
|
||||
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
|
||||
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
|
||||
] |> ignore
|
||||
|
||||
/// Add parameters for web log INSERT or UPDATE statements
|
||||
let addWebLogParameters (cmd: SqliteCommand) (webLog: WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string webLog.Id)
|
||||
cmd.Parameters.AddWithValue ("@name", webLog.Name)
|
||||
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
|
||||
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
|
||||
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
|
||||
cmd.Parameters.AddWithValue ("@themeId", string webLog.ThemeId)
|
||||
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
|
||||
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
|
||||
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
|
||||
cmd.Parameters.AddWithValue ("@uploads", string webLog.Uploads)
|
||||
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules)
|
||||
] |> ignore
|
||||
addWebLogRssParameters cmd webLog
|
||||
|
||||
/// Add parameters for custom feed INSERT or UPDATE statements
|
||||
let addCustomFeedParameters (cmd: SqliteCommand) (webLogId: WebLogId) (feed: CustomFeed) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", string feed.Id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", string webLogId)
|
||||
cmd.Parameters.AddWithValue ("@source", string feed.Source)
|
||||
cmd.Parameters.AddWithValue ("@path", string feed.Path)
|
||||
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
|
||||
Some (Utils.serialize ser feed.Podcast)
|
||||
else None))
|
||||
] |> ignore
|
||||
|
||||
/// Shorthand to map a data reader to a custom feed
|
||||
let toCustomFeed =
|
||||
Map.toCustomFeed ser
|
||||
|
||||
/// Get the current custom feeds for a web log
|
||||
let getCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_feed WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLog.Id
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList toCustomFeed rdr
|
||||
}
|
||||
|
||||
/// Append custom feeds to a web log
|
||||
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
||||
}
|
||||
|
||||
/// Update the custom feeds for a web log
|
||||
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds string
|
||||
let toId (feed : CustomFeed) = feed.Id
|
||||
let toUpdate =
|
||||
webLog.Rss.CustomFeeds
|
||||
|> List.filter (fun f ->
|
||||
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
||||
toDelete
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <- "DELETE FROM web_log_feed WHERE id = @id"
|
||||
cmd.Parameters["@id"].Value <- string it.Id
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.Parameters.Clear ()
|
||||
toAdd
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO web_log_feed (
|
||||
id, web_log_id, source, path, podcast
|
||||
) VALUES (
|
||||
@id, @webLogId, @source, @path, @podcast
|
||||
)"
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.Id it
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
toUpdate
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"UPDATE web_log_feed
|
||||
SET source = @source,
|
||||
path = @path,
|
||||
podcast = @podcast
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.Id it
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
type SQLiteWebLogData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
/// Add a web log
|
||||
let add webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO web_log (
|
||||
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
||||
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright,
|
||||
redirect_rules
|
||||
) VALUES (
|
||||
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
||||
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright,
|
||||
@redirectRules
|
||||
)"
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
let add webLog =
|
||||
log.LogTrace "WebLog.add"
|
||||
Document.insert<WebLog> conn ser Table.WebLog webLog
|
||||
|
||||
/// Retrieve all web logs
|
||||
let all () = backgroundTask {
|
||||
let all () =
|
||||
log.LogTrace "WebLog.all"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM web_log"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! webLogs =
|
||||
toList (Map.toWebLog ser) rdr
|
||||
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray webLogs
|
||||
}
|
||||
cmd.CommandText <- Query.selectFromTable Table.WebLog
|
||||
cmdToList<WebLog> cmd ser
|
||||
|
||||
/// Delete a web log by its ID
|
||||
let delete webLogId = backgroundTask {
|
||||
log.LogTrace "WebLog.delete"
|
||||
let idField = "data ->> 'WebLogId'"
|
||||
let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {idField} = @webLogId)"
|
||||
use cmd = conn.CreateCommand()
|
||||
addWebLogId cmd webLogId
|
||||
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||
let postSubQuery = subQuery "post"
|
||||
let pageSubQuery = subQuery "page"
|
||||
cmd.CommandText <- $"
|
||||
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||
DELETE FROM upload WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log WHERE id = @webLogId"
|
||||
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
|
||||
}
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
let findByHost (url: string) = backgroundTask {
|
||||
log.LogTrace "WebLog.findByHost"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
|
||||
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
|
||||
cmd.CommandText <-
|
||||
$"{Query.selectFromTable Table.WebLog} WHERE data ->> '{nameof WebLog.Empty.UrlBase}' = @urlBase"
|
||||
addParam cmd "@urlBase" url
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<WebLog> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Find a web log by its ID
|
||||
let findById webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog ser rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
}
|
||||
let findById webLogId =
|
||||
log.LogTrace "WebLog.findById"
|
||||
Document.findById<WebLogId, WebLog> conn ser Table.WebLog webLogId
|
||||
|
||||
/// Update redirect rules for a web log
|
||||
let updateRedirectRules webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "UPDATE web_log SET redirect_rules = @redirectRules WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@redirectRules", Utils.serialize ser webLog.RedirectRules) |> ignore
|
||||
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
let updateRedirectRules (webLog: WebLog) =
|
||||
log.LogTrace "WebLog.updateRedirectRules"
|
||||
Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.RedirectRules) webLog.RedirectRules
|
||||
|
||||
/// Update RSS options for a web log
|
||||
let updateRssOptions webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"UPDATE web_log
|
||||
SET is_feed_enabled = @isFeedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
is_category_enabled = @isCategoryEnabled,
|
||||
is_tag_enabled = @isTagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"
|
||||
addWebLogRssParameters cmd webLog
|
||||
cmd.Parameters.AddWithValue ("@id", string webLog.Id) |> ignore
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
let updateRssOptions (webLog: WebLog) =
|
||||
log.LogTrace "WebLog.updateRssOptions"
|
||||
Document.updateField conn ser Table.WebLog webLog.Id (nameof WebLog.Empty.Rss) webLog.Rss
|
||||
|
||||
/// Update settings for a web log
|
||||
let updateSettings webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"UPDATE web_log
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
subtitle = @subtitle,
|
||||
default_page = @defaultPage,
|
||||
posts_per_page = @postsPerPage,
|
||||
theme_id = @themeId,
|
||||
url_base = @urlBase,
|
||||
time_zone = @timeZone,
|
||||
auto_htmx = @autoHtmx,
|
||||
uploads = @uploads,
|
||||
is_feed_enabled = @isFeedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
is_category_enabled = @isCategoryEnabled,
|
||||
is_tag_enabled = @isTagEnabled,
|
||||
copyright = @copyright,
|
||||
redirect_rules = @redirectRules
|
||||
WHERE id = @id"
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
}
|
||||
let updateSettings (webLog: WebLog) =
|
||||
log.LogTrace "WebLog.updateSettings"
|
||||
Document.update conn ser Table.WebLog webLog.Id webLog
|
||||
|
||||
interface IWebLogData with
|
||||
member _.Add webLog = add webLog
|
||||
|
||||
@ -1,11 +1,13 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
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) =
|
||||
type SQLiteWebLogUserData(conn: SqliteConnection, ser: JsonSerializer, log: ILogger) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
@ -27,119 +29,94 @@ type SQLiteWebLogUserData(conn: SqliteConnection) =
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a user
|
||||
let add user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"INSERT INTO web_log_user (
|
||||
id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
|
||||
created_on, last_seen_on
|
||||
) VALUES (
|
||||
@id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
|
||||
@createdOn, @lastSeenOn
|
||||
)"
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
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
|
||||
let findById (userId: WebLogUserId) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", string userId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return verifyWebLog<WebLogUser> webLogId (_.WebLogId) Map.toWebLogUser rdr
|
||||
}
|
||||
let findById userId webLogId =
|
||||
log.LogTrace "WebLogUser.findById"
|
||||
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> conn ser Table.WebLogUser userId webLogId
|
||||
|
||||
/// 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(id) FROM page WHERE author_id = @userId"
|
||||
cmd.Parameters.AddWithValue ("@userId", string userId) |> ignore
|
||||
cmd.CommandText <- $"SELECT COUNT(*) FROM {Table.Page} WHERE data ->> 'AuthorId' = @id"
|
||||
addDocId cmd userId
|
||||
let! pageCount = count cmd
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
|
||||
cmd.CommandText <- cmd.CommandText.Replace($"FROM {Table.Page}", $"FROM {Table.Post}")
|
||||
let! postCount = count cmd
|
||||
if pageCount + postCount > 0 then
|
||||
return Error "User has pages or posts; cannot delete"
|
||||
else
|
||||
cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId"
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
do! Document.delete conn Table.WebLogUser userId
|
||||
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 {
|
||||
log.LogTrace "WebLogUser.findByEmail"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
|
||||
cmd.CommandText <- $"
|
||||
{Query.selectFromTable Table.WebLogUser}
|
||||
WHERE {Query.whereByWebLog}
|
||||
AND data ->> '{nameof WebLogUser.Empty.Email}' = @email"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@email", email) |> ignore
|
||||
addParam cmd "@email" email
|
||||
use! rdr = cmd.ExecuteReaderAsync()
|
||||
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
|
||||
let! isFound = rdr.ReadAsync()
|
||||
return if isFound then Some (Map.fromDoc<WebLogUser> ser rdr) else None
|
||||
}
|
||||
|
||||
/// Get all users for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toWebLogUser rdr
|
||||
log.LogTrace "WebLogUser.findByWebLog"
|
||||
let! users = Document.findByWebLog<WebLogUser> conn ser Table.WebLogUser webLogId
|
||||
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 {
|
||||
log.LogTrace "WebLogUser.findNames"
|
||||
use cmd = conn.CreateCommand()
|
||||
let nameSql, nameParams = inClause "AND id" "id" string userIds
|
||||
cmd.CommandText <- $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {nameSql}"
|
||||
let nameSql, nameParams = inClause "AND data ->> 'Id'" "id" string userIds
|
||||
cmd.CommandText <- $"{Query.selectFromTable Table.WebLogUser} WHERE {Query.whereByWebLog} {nameSql}"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddRange nameParams
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toWebLogUser rdr |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
|
||||
let! users = cmdToList<WebLogUser> cmd ser
|
||||
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
|
||||
}
|
||||
|
||||
/// Restore users from a backup
|
||||
let restore users = backgroundTask {
|
||||
log.LogTrace "WebLogUser.restore"
|
||||
for user in users do
|
||||
do! add user
|
||||
}
|
||||
|
||||
/// Set a user's last seen date/time to now
|
||||
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
|
||||
log.LogTrace "WebLogUser.setLastSeen"
|
||||
use cmd = conn.CreateCommand()
|
||||
cmd.CommandText <-
|
||||
"UPDATE web_log_user
|
||||
SET last_seen_on = @lastSeenOn
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
cmd.CommandText <- $"
|
||||
UPDATE {Table.WebLogUser}
|
||||
SET data = json_set(data, '$.{nameof WebLogUser.Empty.LastSeenOn}', @lastSeenOn)
|
||||
WHERE {Query.whereById}
|
||||
AND {Query.whereByWebLog}"
|
||||
addDocId cmd userId
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@id", string userId)
|
||||
cmd.Parameters.AddWithValue ("@lastSeenOn", instantParam (Noda.now ()))
|
||||
] |> ignore
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
()
|
||||
addParam cmd "@lastSeenOn" (instantParam (Noda.now ()))
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update a user
|
||||
let update user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"UPDATE web_log_user
|
||||
SET email = @email,
|
||||
first_name = @firstName,
|
||||
last_name = @lastName,
|
||||
preferred_name = @preferredName,
|
||||
password_hash = @passwordHash,
|
||||
url = @url,
|
||||
access_level = @accessLevel,
|
||||
created_on = @createdOn,
|
||||
last_seen_on = @lastSeenOn
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
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
|
||||
|
||||
@ -474,11 +474,11 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
member _.Page = SQLitePageData (conn, ser, log)
|
||||
member _.Post = SQLitePostData (conn, ser, log)
|
||||
member _.TagMap = SQLiteTagMapData (conn, ser, log)
|
||||
member _.Theme = SQLiteThemeData conn
|
||||
member _.ThemeAsset = SQLiteThemeAssetData conn
|
||||
member _.Upload = SQLiteUploadData conn
|
||||
member _.WebLog = SQLiteWebLogData (conn, ser)
|
||||
member _.WebLogUser = SQLiteWebLogUserData conn
|
||||
member _.Theme = SQLiteThemeData (conn, ser, log)
|
||||
member _.ThemeAsset = SQLiteThemeAssetData (conn, log)
|
||||
member _.Upload = SQLiteUploadData (conn, log)
|
||||
member _.WebLog = SQLiteWebLogData (conn, ser, log)
|
||||
member _.WebLogUser = SQLiteWebLogUserData (conn, ser, log)
|
||||
|
||||
member _.Serializer = ser
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user