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

Version 2.1 (#41)

Browse Source 
- Add full chapter support (#6)
- Add built-in redirect functionality (#39)
- Support building Docker containers for release (#38)
- Support canonical domain configuration (#37)
- Add unit tests for domain/models and integration tests for all three data stores
- Convert SQLite storage to use JSON documents, similar to PostgreSQL
- Convert admin templates to Giraffe View Engine (from Liquid)
- Add .NET 8 support
This commit was merged in pull request #41.
This commit is contained in:
Daniel J. Summers
2024-03-26 20:13:28 -04:00
committed by GitHub
parent 7b325dc19e
commit f1a7e55f3e
116 changed files with 14807 additions and 8249 deletions
Download Patch File Download Diff File Expand all files Collapse all files

94
src/MyWebLog.Data/Postgres/PostgresCache.fs
View File

@@ -2,38 +2,37 @@ namespace MyWebLog.Data.Postgres
open System.Threading
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql.FSharp
/// Helper types and functions for the cache
[<AutoOpen>]
module private Helpers =
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
type Entry = {
/// The ID of the cache entry
Id: string
/// The value to be cached
Payload: byte array
/// When this entry will expire
ExpireAt: Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration: Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration: Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
let sync<'T> (it: Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
let getNow () = SystemClock.Instance.GetCurrentInstant()
/// Create a parameter for the expire-at time
let expireParam =
@@ -49,9 +48,11 @@ type DistributedCache () =
task {
let! exists =
Custom.scalar
$"SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS {existsName}" [] Map.toExists
"SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS it"
[]
toExists
if not exists then
do! Custom.nonQuery
"CREATE TABLE session (
@@ -69,13 +70,15 @@ type DistributedCache () =
let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key
let! tryEntry =
Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
(fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
Custom.single
"SELECT * FROM session WHERE id = @id"
[ idParam ]
(fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
match tryEntry with
| Some entry ->
let now = getNow ()
@@ -88,8 +91,9 @@ type DistributedCache () =
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id"
[ expireParam item.ExpireAt; idParam ]
do! Custom.nonQuery
"UPDATE session SET expire_at = @expireAt WHERE id = @id"
[ expireParam item.ExpireAt; idParam ]
()
return if item.ExpireAt > now then Some entry else None
| None -> return None
@@ -101,17 +105,17 @@ type DistributedCache () =
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
if lastPurge.Plus(Duration.FromMinutes 30L) < now then
do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key =
Delete.byId "session" key
Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload =
let saveEntry (opts: DistributedCacheEntryOptions) key payload =
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
@@ -121,7 +125,7 @@ type DistributedCache () =
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
let exp = now.Plus(Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 1 hour sliding expiration
@@ -146,7 +150,7 @@ type DistributedCache () =
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
let get key (_: CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
@@ -155,29 +159,29 @@ type DistributedCache () =
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let refresh key (cancelToken: CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
let remove key (_: CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
let set key value options (_: CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member _.Get key = get key CancellationToken.None |> sync
member _.GetAsync (key, token) = get key token
member _.GetAsync(key, token) = get key token
member _.Refresh key = refresh key CancellationToken.None |> sync
member _.RefreshAsync (key, token) = refresh key token
member _.RefreshAsync(key, token) = refresh key token
member _.Remove key = remove key CancellationToken.None |> sync
member _.RemoveAsync (key, token) = remove key token
member _.Set (key, value, options) = set key value options CancellationToken.None |> sync
member _.SetAsync (key, value, options, token) = set key value options token
member _.RemoveAsync(key, token) = remove key token
member _.Set(key, value, options) = set key value options CancellationToken.None |> sync
member _.SetAsync(key, value, options, token) = set key value options token

88
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@@ -1,13 +1,14 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog category data implementation
type PostgresCategoryData (log : ILogger) =
type PostgresCategoryData(log: ILogger) =
/// Count all categories for the given web log
let countAll webLogId =
@@ -17,14 +18,20 @@ type PostgresCategoryData (log : ILogger) =
/// Count all top-level categories for the given web log
let countTopLevel webLogId =
log.LogTrace "Category.countTopLevel"
Count.byContains Table.Category {| webLogDoc webLogId with ParentId = None |}
Custom.scalar
$"""{Query.Count.byContains Table.Category}
AND {Query.whereByField (Field.NEX (nameof Category.Empty.ParentId)) ""}"""
[ webLogContains webLogId ]
toCount
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
let findAllForView webLogId = backgroundTask {
log.LogTrace "Category.findAllForView"
let! cats =
Custom.list $"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.empty.Name}')"
[ webLogContains webLogId ] fromData<Category>
Custom.list
$"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')"
[ webLogContains webLogId ]
fromData<Category>
let ordered = Utils.orderByHierarchy cats None None []
let counts =
ordered
@@ -33,20 +40,18 @@ type PostgresCategoryData (log : ILogger) =
let catIdSql, catIdParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id
|> arrayContains (nameof Post.Empty.CategoryIds) id
let postCount =
Custom.scalar
$"""SELECT COUNT(DISTINCT id) AS {countName}
$"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS it
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}"""
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catIdParams
] Map.toCount
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catIdParams ]
toCount
|> Async.AwaitTask
|> Async.RunSynchronously
it.Id, postCount)
@@ -58,71 +63,72 @@ type PostgresCategoryData (log : ILogger) =
PostCount = counts
|> List.tryFind (fun c -> fst c = cat.Id)
|> Option.map snd
|> Option.defaultValue 0
})
|> Option.defaultValue 0 })
|> Array.ofSeq
}
/// Find a category by its ID for the given web log
let findById catId webLogId =
log.LogTrace "Category.findById"
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId CategoryId.toString webLogId
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId
/// Find all categories for the given web log
let findByWebLog webLogId =
log.LogTrace "Category.findByWebLog"
Document.findByWebLog<Category> Table.Category webLogId
/// Create parameters for a category insert / update
let catParameters (cat : Category) =
Query.docParameters (CategoryId.toString cat.Id) cat
/// Delete a category
let delete catId webLogId = backgroundTask {
log.LogTrace "Category.delete"
match! findById catId webLogId with
| Some cat ->
// Reassign any children to the category's parent category
let! children = Find.byContains<Category> Table.Category {| ParentId = CategoryId.toString catId |}
let! children = Find.byContains<Category> Table.Category {| ParentId = catId |}
let hasChildren = not (List.isEmpty children)
if hasChildren then
let childQuery, childParams =
if cat.ParentId.IsSome then
Query.Patch.byId Table.Category,
children
|> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ])
else
Query.RemoveFields.byId Table.Category,
children
|> List.map (fun child ->
[ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ])
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Category,
children |> List.map (fun child -> [
"@id", Sql.string (CategoryId.toString child.Id)
"@data", Query.jsonbDocParam {| ParentId = cat.ParentId |}
])
]
|> Sql.executeTransactionAsync [ childQuery, childParams ]
()
// Delete the category off all posts where it is assigned
let! posts =
Custom.list $"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.empty.CategoryIds}' @> @id"
[ "@id", Query.jsonbDocParam [| CategoryId.toString catId |] ] fromData<Post>
Custom.list
$"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id"
[ jsonParam "@id" [| string catId |] ]
fromData<Post>
if not (List.isEmpty posts) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [
"@id", Sql.string (PostId.toString post.Id)
"@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
])
]
|> Sql.executeTransactionAsync
[ Query.Patch.byId Table.Post,
posts
|> List.map (fun post ->
[ idParam post.Id
jsonParam
"@data"
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} ]) ]
()
// Delete the category itself
do! Delete.byId Table.Category (CategoryId.toString catId)
do! Delete.byId Table.Category catId
return if hasChildren then ReassignedChildCategories else CategoryDeleted
| None -> return CategoryNotFound
}
/// Save a category
let save (cat : Category) = backgroundTask {
let save (cat: Category) = backgroundTask {
log.LogTrace "Category.save"
do! save Table.Category (CategoryId.toString cat.Id) cat
do! save Table.Category cat
}
/// Restore categories from a backup
@@ -132,7 +138,7 @@ type PostgresCategoryData (log : ILogger) =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Category, cats |> List.map catParameters
Query.insert Table.Category, cats |> List.map (fun c -> [ jsonParam "@data" c ])
]
()
}

137
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@@ -61,7 +61,8 @@ module Table =
open System
open System.Threading.Tasks
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open MyWebLog
open MyWebLog.Data
open NodaTime
@@ -69,29 +70,23 @@ open Npgsql
open Npgsql.FSharp
/// Create a SQL parameter for the web log ID
let webLogIdParam webLogId =
"@webLogId", Sql.string (WebLogId.toString webLogId)
let webLogIdParam (webLogId: WebLogId) =
"@webLogId", Sql.string (string webLogId)
/// Create an anonymous record with the given web log ID
let webLogDoc (webLogId : WebLogId) =
let webLogDoc (webLogId: WebLogId) =
{| WebLogId = webLogId |}
/// Create a parameter for a web log document-contains query
let webLogContains webLogId =
"@criteria", Query.jsonbDocParam (webLogDoc webLogId)
/// The name of the field to select to be able to use Map.toCount
let countName = "the_count"
/// The name of the field to select to be able to use Map.toExists
let existsName = "does_exist"
jsonParam "@criteria" (webLogDoc webLogId)
/// A SQL string to select data from a table with the given JSON document contains criteria
let selectWithCriteria tableName =
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
/// Create the SQL and parameters for an IN clause
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : 'T list) =
let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
if List.isEmpty items then "", []
else
let mutable idx = 0
@@ -99,114 +94,109 @@ let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items : '
|> List.skip 1
|> List.fold (fun (itemS, itemP) it ->
idx <- idx + 1
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (valueFunc it)) :: itemP)
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
(Seq.ofList items
|> Seq.map (fun it ->
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (valueFunc it) ])
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
|> Seq.head)
|> function sql, ps -> $"{sql})", ps
/// Create the SQL and parameters for match-any array query
let arrayContains<'T> name (valueFunc : 'T -> string) (items : 'T list) =
let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
$"data['{name}'] ?| @{name}Values",
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let tryHead<'T> (query: Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
let typedParam<'T> name (it: 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
let optParam<'T> name (it: 'T option) =
let p = NpgsqlParameter($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
/// Mapping functions for SQL queries
module Map =
/// Get a count from a row
let toCount (row : RowReader) =
row.int countName
/// Get a true/false value as to whether an item exists
let toExists (row : RowReader) =
row.bool existsName
/// Create a permalink from the current row
let toPermalink (row : RowReader) =
let toPermalink (row: RowReader) =
Permalink (row.string "permalink")
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
}
let toRevision (row: RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.Parse }
/// Create a theme asset from the current row
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
let toThemeAsset includeData (row: RowReader) : ThemeAsset =
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] }
/// Create an uploaded file from the current row
let toUpload includeData (row : RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||]
}
let toUpload includeData (row: RowReader) : Upload =
{ Id = row.string "id" |> UploadId
WebLogId = row.string "web_log_id" |> WebLogId
Path = row.string "path" |> Permalink
UpdatedOn = row.fieldValue<Instant> "updated_on"
Data = if includeData then row.bytea "data" else [||] }
/// Document manipulation functions
module Document =
/// Determine whether a document exists with the given key for the given web log
let existsByWebLog<'TKey> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
let existsByWebLog<'TKey> table (key: 'TKey) webLogId =
Custom.scalar
$""" SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE id = @id AND {Query.whereDataContains "@criteria"}
) AS {existsName}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] Map.toExists
$"""SELECT EXISTS (
SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}
) AS it"""
[ "@id", Sql.string (string key); webLogContains webLogId ]
toExists
/// Find a document by its ID for the given web log
let findByIdAndWebLog<'TKey, 'TDoc> table (key : 'TKey) (keyFunc : 'TKey -> string) webLogId =
Custom.single $"""{Query.selectFromTable table} WHERE id = @id AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (keyFunc key); webLogContains webLogId ] fromData<'TDoc>
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
Custom.single
$"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
[ "@id", Sql.string (string key); webLogContains webLogId ]
fromData<'TDoc>
/// Find a document by its ID for the given web log
/// Find documents for the given web log
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
Find.byContains table (webLogDoc webLogId)
/// Functions to support revisions
module Revisions =
/// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) =
Custom.list $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (keyFunc key) ] Map.toRevision
let findByEntityId<'TKey> revTable entityTable (key: 'TKey) =
Custom.list
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ "@id", Sql.string (string key) ]
Map.toRevision
/// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc : string -> 'TKey) webLogId =
let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId =
Custom.list
$"""SELECT pr.*
FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.id = pr.{entityTable}_id
INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id
WHERE p.{Query.whereDataContains "@criteria"}
ORDER BY as_of DESC"""
[ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
[ webLogContains webLogId ]
(fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row)
/// Parameters for a revision INSERT statement
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
let revParams<'TKey> (key: 'TKey) rev = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string (MarkupText.toString rev.Text)
"@id", Sql.string (string key)
"@text", Sql.string (string rev.Text)
]
/// The SQL statement to insert a revision
@@ -214,23 +204,20 @@ module Revisions =
$"INSERT INTO %s{table} VALUES (@id, @asOf, @text)"
/// Update a page's revisions
let update<'TKey> revTable entityTable (key : 'TKey) (keyFunc : 'TKey -> string) oldRevs newRevs = backgroundTask {
let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
if not (List.isEmpty toDelete) then
|> Sql.executeTransactionAsync
[ if not (List.isEmpty toDelete) then
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf",
toDelete
|> List.map (fun it -> [
"@id", Sql.string (keyFunc key)
typedParam "asOf" it.AsOf
])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key keyFunc)
]
|> List.map (fun it ->
[ "@id", Sql.string (string key)
typedParam "asOf" it.AsOf ])
if not (List.isEmpty toAdd) then
insertSql revTable, toAdd |> List.map (revParams key) ]
()
}

121
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@@ -1,44 +1,55 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog page data implementation
type PostgresPageData (log : ILogger) =
/// PostgreSQL myWebLog page data implementation
type PostgresPageData(log: ILogger) =
// SUPPORT FUNCTIONS
/// Append revisions to a page
let appendPageRevisions (page : Page) = backgroundTask {
let appendPageRevisions (page: Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id
return { page with Revisions = revisions }
}
/// Return a page with no text or revisions
let pageWithoutText (row : RowReader) =
let pageWithoutText (row: RowReader) =
{ fromData<Page> row with Text = "" }
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs =
let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions"
Revisions.update Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs
Revisions.update Table.PageRevision Table.Page pageId oldRevs newRevs
/// Does the given page exist?
let pageExists pageId webLogId =
let pageExists (pageId: PageId) webLogId =
log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId PageId.toString webLogId
Document.existsByWebLog Table.Page pageId webLogId
// IMPLEMENTATION FUNCTIONS
/// Get all pages for a web log (without text or revisions)
/// Add a page
let add (page: Page) = backgroundTask {
log.LogTrace "Page.add"
do! insert Table.Page { page with Revisions = [] }
do! updatePageRevisions page.Id [] page.Revisions
()
}
/// Get all pages for a web log (without text, metadata, revisions, or prior permalinks)
let all webLogId =
log.LogTrace "Page.all"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
[ webLogContains webLogId ] fromData<Page>
Custom.list
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
[ webLogContains webLogId ]
(fun row -> { fromData<Page> row with Text = ""; Metadata = []; PriorPermalinks = [] })
/// Count all pages for the given web log
let countAll webLogId =
@@ -50,50 +61,61 @@ type PostgresPageData (log : ILogger) =
log.LogTrace "Page.countListed"
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions)
let findById pageId webLogId =
/// Find a page by its ID (without revisions or prior permalinks)
let findById pageId webLogId = backgroundTask {
log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId PageId.toString webLogId
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId with
| Some page -> return Some { page with PriorPermalinks = [] }
| None -> return None
}
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
log.LogTrace "Page.findFullById"
match! findById pageId webLogId with
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId with
| Some page ->
let! withMore = appendPageRevisions page
return Some withMore
| None -> return None
}
// TODO: need to handle when the page being deleted is the home page
/// Delete a page by its ID
let delete pageId webLogId = backgroundTask {
log.LogTrace "Page.delete"
match! pageExists pageId webLogId with
| true ->
do! Delete.byId Table.Page (PageId.toString pageId)
do! Custom.nonQuery
$"""DELETE FROM {Table.PageRevision} WHERE page_id = @id;
DELETE FROM {Table.Page} WHERE {Query.whereById "@id"}"""
[ idParam pageId ]
return true
| false -> return false
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId =
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
log.LogTrace "Page.findByPermalink"
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
|> tryHead
let! page =
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = permalink |}
|> tryHead
return page |> Option.map (fun pg -> { pg with PriorPermalinks = [] })
}
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Page.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
$"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
FROM page
WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
AND {linkSql}"""
[ webLogContains webLogId; linkParam ]
Map.toPermalink
}
/// Get all complete pages for the given web log
@@ -110,58 +132,59 @@ type PostgresPageData (log : ILogger) =
/// Get all listed pages for the given web log (without revisions or text)
let findListed webLogId =
log.LogTrace "Page.findListed"
Custom.list $"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.empty.Title}')"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText
Custom.list
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
[ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ]
pageWithoutText
/// Get a page of pages for the given web log (without revisions)
let findPageOfPages webLogId pageNbr =
log.LogTrace "Page.findPageOfPages"
Custom.list
$"{selectWithCriteria Table.Page}
ORDER BY LOWER(data->>'{nameof Page.empty.Title}')
ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
LIMIT @pageSize OFFSET @toSkip"
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
fromData<Page>
(fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] })
/// Restore pages from a backup
let restore (pages : Page list) = backgroundTask {
let restore (pages: Page list) = backgroundTask {
log.LogTrace "Page.restore"
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Page,
pages
|> List.map (fun page -> Query.docParameters (PageId.toString page.Id) { page with Revisions = [] })
Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev)
]
|> Sql.executeTransactionAsync
[ Query.insert Table.Page,
pages |> List.map (fun page -> [ jsonParam "@data" { page with Revisions = [] } ])
Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId rev) ]
()
}
/// Save a page
let save (page : Page) = backgroundTask {
log.LogTrace "Page.save"
let! oldPage = findFullById page.Id page.WebLogId
do! save Table.Page (PageId.toString page.Id) { page with Revisions = [] }
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
/// Update a page
let update (page: Page) = backgroundTask {
log.LogTrace "Page.update"
match! findFullById page.Id page.WebLogId with
| Some oldPage ->
do! Update.byId Table.Page page.Id { page with Revisions = [] }
do! updatePageRevisions page.Id oldPage.Revisions page.Revisions
| None -> ()
()
}
/// Update a page's prior permalinks
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
let updatePriorPermalinks pageId webLogId (permalinks: Permalink list) = backgroundTask {
log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with
| true ->
do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |}
do! Patch.byId Table.Page pageId {| PriorPermalinks = permalinks |}
return true
| false -> return false
}
interface IPageData with
member _.Add page = save page
member _.Add page = add page
member _.All webLogId = all webLogId
member _.CountAll webLogId = countAll webLogId
member _.CountListed webLogId = countListed webLogId
@@ -174,5 +197,5 @@ type PostgresPageData (log : ILogger) =
member _.FindListed webLogId = findListed webLogId
member _.FindPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
member _.Restore pages = restore pages
member _.Update page = save page
member _.Update page = update page
member _.UpdatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks

174
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@@ -1,62 +1,77 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open NodaTime.Text
open NodaTime
open Npgsql.FSharp
/// PostgreSQL myWebLog post data implementation
type PostgresPostData (log : ILogger) =
/// PostgreSQL myWebLog post data implementation
type PostgresPostData(log: ILogger) =
// SUPPORT FUNCTIONS
/// Append revisions to a post
let appendPostRevisions (post : Post) = backgroundTask {
let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id
return { post with Revisions = revisions }
}
/// Return a post with no revisions or prior permalinks
let postWithoutLinks row =
{ fromData<Post> row with PriorPermalinks = [] }
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText row =
{ fromData<Post> row with Text = "" }
{ postWithoutLinks row with Text = "" }
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs =
let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions"
Revisions.update Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs
Revisions.update Table.PostRevision Table.Post postId oldRevs newRevs
/// Does the given post exist?
let postExists postId webLogId =
let postExists (postId: PostId) webLogId =
log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId PostId.toString webLogId
Document.existsByWebLog Table.Post postId webLogId
// IMPLEMENTATION FUNCTIONS
/// Add a post
let add (post : Post) = backgroundTask {
log.LogTrace "Post.add"
do! insert Table.Post { post with Revisions = [] }
do! updatePostRevisions post.Id [] post.Revisions
}
/// Count posts in a status for the given web log
let countByStatus status webLogId =
let countByStatus (status: PostStatus) webLogId =
log.LogTrace "Post.countByStatus"
Count.byContains Table.Post {| webLogDoc webLogId with Status = PostStatus.toString status |}
Count.byContains Table.Post {| webLogDoc webLogId with Status = status |}
/// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId =
let findById postId webLogId = backgroundTask {
log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> Table.Post postId PostId.toString webLogId
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
| Some post -> return Some { post with PriorPermalinks = [] }
| None -> return None
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId =
/// Find a post by its permalink for the given web log (excluding revisions)
let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post)
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
] fromData<Post>
Custom.single
(selectWithCriteria Table.Post)
[ jsonParam "@criteria" {| webLogDoc webLogId with Permalink = permalink |} ]
postWithoutLinks
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
log.LogTrace "Post.findFullById"
match! findById postId webLogId with
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId with
| Some post ->
let! withRevisions = appendPostRevisions post
return Some withRevisions
@@ -68,28 +83,29 @@ type PostgresPostData (log : ILogger) =
log.LogTrace "Post.delete"
match! postExists postId webLogId with
| true ->
let theId = PostId.toString postId
do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id"""
[ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.PostRevision} WHERE post_id = @id;
DELETE FROM {Table.Post} WHERE {Query.whereById "@id"}"""
[ idParam postId; jsonParam "@criteria" {| PostId = postId |} ]
return true
| false -> return false
}
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
let findCurrentPermalink (permalinks: Permalink list) webLogId = backgroundTask {
log.LogTrace "Post.findCurrentPermalink"
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
$"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {linkSql}""" [ webLogContains webLogId; linkParam ] Map.toPermalink
AND {linkSql}"""
[ webLogContains webLogId; linkParam ]
Map.toPermalink
}
/// Get all complete posts for the given web log
@@ -104,79 +120,73 @@ type PostgresPostData (log : ILogger) =
}
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) CategoryId.toString categoryIds
let catSql, catParam = arrayContains (nameof Post.Empty.CategoryIds) string categoryIds
Custom.list
$"{selectWithCriteria Table.Post}
AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catParam
] fromData<Post>
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catParam ]
postWithoutLinks
/// Get a page of posts for the given web log (excludes text and revisions)
let findPageOfPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPosts"
Custom.list
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.empty.UpdatedOn}'
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
data ->> '{nameof Post.Empty.UpdatedOn}'
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ webLogContains webLogId ] postWithoutText
[ webLogContains webLogId ]
postWithoutText
/// Get a page of published posts for the given web log (excludes revisions)
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
log.LogTrace "Post.findPageOfPublishedPosts"
Custom.list
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
fromData<Post>
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
postWithoutLinks
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
log.LogTrace "Post.findPageOfTaggedPosts"
Custom.list
$"{selectWithCriteria Table.Post}
AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
AND data['{nameof Post.Empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@tag", Query.jsonbDocParam [| tag |]
] fromData<Post>
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
postWithoutLinks
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId publishedOn = backgroundTask {
let findSurroundingPosts webLogId (publishedOn: Instant) = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
]
let pubField = nameof Post.empty.PublishedOn
let! older =
Custom.list
$"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) < @publishedOn
ORDER BY data ->> '{pubField}' DESC
LIMIT 1" (queryParams ()) fromData<Post>
let! newer =
Custom.list
$"{selectWithCriteria Table.Post}
AND SUBSTR(data ->> '{pubField}', 1, 19) > @publishedOn
ORDER BY data ->> '{pubField}'
LIMIT 1" (queryParams ()) fromData<Post>
let queryParams () =
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
"@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
let query op direction =
$"{selectWithCriteria Table.Post}
AND (data ->> '{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' %s{direction}
LIMIT 1"
let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
let! newer = Custom.list (query ">" "") (queryParams ()) postWithoutLinks
return List.tryHead older, List.tryHead newer
}
/// Save a post
let save (post : Post) = backgroundTask {
/// Update a post
let update (post : Post) = backgroundTask {
log.LogTrace "Post.save"
let! oldPost = findFullById post.Id post.WebLogId
do! save Table.Post (PostId.toString post.Id) { post with Revisions = [] }
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
match! findFullById post.Id post.WebLogId with
| Some oldPost ->
do! Update.byId Table.Post post.Id { post with Revisions = [] }
do! updatePostRevisions post.Id oldPost.Revisions post.Revisions
| None -> ()
}
/// Restore posts from a backup
@@ -186,28 +196,26 @@ type PostgresPostData (log : ILogger) =
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Post,
posts
|> List.map (fun post -> Query.docParameters (PostId.toString post.Id) { post with Revisions = [] })
Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev)
]
|> Sql.executeTransactionAsync
[ Query.insert Table.Post,
posts |> List.map (fun post -> [ jsonParam "@data" { post with Revisions = [] } ])
Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId rev) ]
()
}
/// Update prior permalinks for a post
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
let updatePriorPermalinks postId webLogId (permalinks: Permalink list) = backgroundTask {
log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with
| true ->
do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |}
do! Patch.byId Table.Post postId {| PriorPermalinks = permalinks |}
return true
| false -> return false
}
interface IPostData with
member _.Add post = save post
member _.Add post = add post
member _.CountByStatus status webLogId = countByStatus status webLogId
member _.Delete postId webLogId = delete postId webLogId
member _.FindById postId webLogId = findById postId webLogId
@@ -224,5 +232,5 @@ type PostgresPostData (log : ILogger) =
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
member _.FindSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
member _.Restore posts = restore posts
member _.Update post = save post
member _.Update post = update post
member _.UpdatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks

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

@@ -1,62 +1,65 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData (log : ILogger) =
/// PostgreSQL myWebLog tag mapping data implementation
type PostgresTagMapData(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> Table.TagMap tagMapId TagMapId.toString webLogId
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId
/// Delete a tag mapping for the given web log
let delete tagMapId webLogId = backgroundTask {
let delete (tagMapId: TagMapId) webLogId = backgroundTask {
log.LogTrace "TagMap.delete"
let! exists = Document.existsByWebLog Table.TagMap tagMapId TagMapId.toString webLogId
let! exists = Document.existsByWebLog Table.TagMap tagMapId webLogId
if exists then
do! Delete.byId Table.TagMap (TagMapId.toString tagMapId)
do! Delete.byId Table.TagMap tagMapId
return true
else return false
}
/// Find a tag mapping by its URL value for the given web log
let findByUrlValue (urlValue : string) webLogId =
let findByUrlValue (urlValue: string) webLogId =
log.LogTrace "TagMap.findByUrlValue"
Custom.single (selectWithCriteria Table.TagMap)
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with UrlValue = urlValue |} ]
fromData<TagMap>
Find.firstByContains<TagMap> Table.TagMap {| webLogDoc webLogId with UrlValue = urlValue |}
/// Get all tag mappings for the given web log
let findByWebLog webLogId =
log.LogTrace "TagMap.findByWebLog"
Custom.list $"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'" [ webLogContains webLogId ]
fromData<TagMap>
Custom.list
$"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'"
[ webLogContains webLogId ]
fromData<TagMap>
/// Find any tag mappings in a list of tags for the given web log
let findMappingForTags tags webLogId =
log.LogTrace "TagMap.findMappingForTags"
let tagSql, tagParam = arrayContains (nameof TagMap.empty.Tag) id tags
Custom.list $"{selectWithCriteria Table.TagMap} AND {tagSql}" [ webLogContains webLogId; tagParam ]
fromData<TagMap>
let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
Custom.list
$"{selectWithCriteria Table.TagMap} AND {tagSql}"
[ webLogContains webLogId; tagParam ]
fromData<TagMap>
/// Save a tag mapping
let save (tagMap : TagMap) =
save Table.TagMap (TagMapId.toString tagMap.Id) tagMap
let save (tagMap: TagMap) =
log.LogTrace "TagMap.save"
save Table.TagMap tagMap
/// Restore tag mappings from a backup
let restore (tagMaps : TagMap list) = backgroundTask {
let restore (tagMaps: TagMap list) = backgroundTask {
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> Query.docParameters (TagMapId.toString tagMap.Id) tagMap)
]
|> Sql.executeTransactionAsync
[ Query.insert Table.TagMap,
tagMaps |> List.map (fun tagMap -> [ jsonParam "@data" tagMap ]) ]
()
}

78
src/MyWebLog.Data/Postgres/PostgresThemeData.fs
View File

@@ -1,13 +1,13 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostreSQL myWebLog theme data implementation
type PostgresThemeData (log : ILogger) =
/// PostreSQL myWebLog theme data implementation
type PostgresThemeData(log: ILogger) =
/// Clear out the template text from a theme
let withoutTemplateText row =
@@ -17,40 +17,48 @@ type PostgresThemeData (log : ILogger) =
/// Retrieve all themes (except 'admin'; excludes template text)
let all () =
log.LogTrace "Theme.all"
Custom.list $"{Query.selectFromTable Table.Theme} WHERE id <> 'admin' ORDER BY id" [] withoutTemplateText
Custom.list
$"{Query.selectFromTable Table.Theme}
WHERE data ->> '{nameof Theme.Empty.Id}' <> 'admin'
ORDER BY data ->> '{nameof Theme.Empty.Id}'"
[]
withoutTemplateText
/// Does a given theme exist?
let exists themeId =
let exists (themeId: ThemeId) =
log.LogTrace "Theme.exists"
Exists.byId Table.Theme (ThemeId.toString themeId)
Exists.byId Table.Theme themeId
/// Find a theme by its ID
let findById themeId =
let findById (themeId: ThemeId) =
log.LogTrace "Theme.findById"
Find.byId<Theme> Table.Theme (ThemeId.toString themeId)
Find.byId<ThemeId, Theme> Table.Theme themeId
/// Find a theme by its ID (excludes the text of templates)
let findByIdWithoutText themeId =
let findByIdWithoutText (themeId: ThemeId) =
log.LogTrace "Theme.findByIdWithoutText"
Custom.single (Query.Find.byId Table.Theme) [ "@id", Sql.string (ThemeId.toString themeId) ] withoutTemplateText
Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
/// Delete a theme by its ID
let delete themeId = backgroundTask {
log.LogTrace "Theme.delete"
match! exists themeId with
| true ->
do! Delete.byId Table.Theme (ThemeId.toString themeId)
do! Custom.nonQuery
$"""DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
DELETE FROM {Table.Theme} WHERE {Query.whereById "@id"}"""
[ idParam themeId ]
return true
| false -> return false
}
/// Save a theme
let save (theme : Theme) =
let save (theme: Theme) =
log.LogTrace "Theme.save"
save Table.Theme (ThemeId.toString theme.Id) theme
save Table.Theme theme
interface IThemeData with
member _.All () = all ()
member _.All() = all ()
member _.Delete themeId = delete themeId
member _.Exists themeId = exists themeId
member _.FindById themeId = findById themeId
@@ -58,8 +66,8 @@ type PostgresThemeData (log : ILogger) =
member _.Save theme = save theme
/// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData (log : ILogger) =
/// PostreSQL myWebLog theme data implementation
type PostgresThemeAssetData(log: ILogger) =
/// Get all theme assets (excludes data)
let all () =
@@ -67,32 +75,34 @@ type PostgresThemeAssetData (log : ILogger) =
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
/// Delete all assets for the given theme
let deleteByTheme themeId =
let deleteByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.deleteByTheme"
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ]
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
/// Find a theme asset by its ID
let findById assetId =
log.LogTrace "ThemeAsset.findById"
let (ThemeAssetId (ThemeId themeId, path)) = assetId
Custom.single $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId AND path = @path"
[ "@themeId", Sql.string themeId; "@path", Sql.string path ] (Map.toThemeAsset true)
Custom.single
$"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
[ idParam themeId; "@path", Sql.string path ]
(Map.toThemeAsset true)
/// Get theme assets for the given theme (excludes data)
let findByTheme themeId =
let findByTheme (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByTheme"
Custom.list $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset false)
Custom.list
$"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id"
[ idParam themeId ]
(Map.toThemeAsset false)
/// Get theme assets for the given theme
let findByThemeWithData themeId =
let findByThemeWithData (themeId: ThemeId) =
log.LogTrace "ThemeAsset.findByThemeWithData"
Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @themeId"
[ "@themeId", Sql.string (ThemeId.toString themeId) ] (Map.toThemeAsset true)
Custom.list $"SELECT * FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ] (Map.toThemeAsset true)
/// Save a theme asset
let save (asset : ThemeAsset) =
let save (asset: ThemeAsset) =
log.LogTrace "ThemeAsset.save"
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
Custom.nonQuery
@@ -103,13 +113,13 @@ type PostgresThemeAssetData (log : ILogger) =
) ON CONFLICT (theme_id, path) DO UPDATE
SET updated_on = EXCLUDED.updated_on,
data = EXCLUDED.data"
[ "@themeId", Sql.string themeId
"@path", Sql.string path
"@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ]
[ "@themeId", Sql.string themeId
"@path", Sql.string path
"@data", Sql.bytea asset.Data
typedParam "updatedOn" asset.UpdatedOn ]
interface IThemeAssetData with
member _.All () = all ()
member _.All() = all ()
member _.DeleteByTheme themeId = deleteByTheme themeId
member _.FindById assetId = findById assetId
member _.FindByTheme themeId = findByTheme themeId

49
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@@ -1,13 +1,13 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData (log : ILogger) =
/// PostgreSQL myWebLog uploaded file data implementation
type PostgresUploadData(log: ILogger) =
/// The INSERT statement for an uploaded file
let upInsert = $"
@@ -18,13 +18,12 @@ type PostgresUploadData (log : ILogger) =
)"
/// Parameters for adding an uploaded file
let upParams (upload : Upload) = [
webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path)
"@data", Sql.bytea upload.Data
]
let upParams (upload: Upload) =
[ webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
idParam upload.Id
"@path", Sql.string (string upload.Path)
"@data", Sql.bytea upload.Data ]
/// Save an uploaded file
let add upload =
@@ -34,33 +33,41 @@ type PostgresUploadData (log : ILogger) =
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
log.LogTrace "Upload.delete"
let idParam = [ "@id", Sql.string (UploadId.toString uploadId) ]
let idParam = [ idParam uploadId ]
let! path =
Custom.single $"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam) (fun row -> row.string "path")
Custom.single
$"SELECT path FROM {Table.Upload} WHERE id = @id AND web_log_id = @webLogId"
(webLogIdParam webLogId :: idParam)
(fun row -> row.string "path")
if Option.isSome path then
do! Custom.nonQuery (Query.Delete.byId Table.Upload) idParam
do! Custom.nonQuery $"DELETE FROM {Table.Upload} WHERE id = @id" idParam
return Ok path.Value
else return Error $"""Upload ID {UploadId.toString uploadId} not found"""
else return Error $"Upload ID {uploadId} not found"
}
/// Find an uploaded file by its path for the given web log
let findByPath path webLogId =
log.LogTrace "Upload.findByPath"
Custom.single $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
[ webLogIdParam webLogId; "@path", Sql.string path ] (Map.toUpload true)
Custom.single
$"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId AND path = @path"
[ webLogIdParam webLogId; "@path", Sql.string path ]
(Map.toUpload true)
/// Find all uploaded files for the given web log (excludes data)
let findByWebLog webLogId =
log.LogTrace "Upload.findByWebLog"
Custom.list $"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ] (Map.toUpload false)
Custom.list
$"SELECT id, web_log_id, path, updated_on FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ]
(Map.toUpload false)
/// Find all uploaded files for the given web log
let findByWebLogWithData webLogId =
log.LogTrace "Upload.findByWebLogWithData"
Custom.list $"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId" [ webLogIdParam webLogId ]
(Map.toUpload true)
Custom.list
$"SELECT * FROM {Table.Upload} WHERE web_log_id = @webLogId"
[ webLogIdParam webLogId ]
(Map.toUpload true)
/// Restore uploads from a backup
let restore uploads = backgroundTask {

63
src/MyWebLog.Data/Postgres/PostgresWebLogData.fs
View File

@@ -1,17 +1,18 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
/// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData (log : ILogger) =
/// PostgreSQL myWebLog web log data implementation
type PostgresWebLogData(log: ILogger) =
/// Add a web log
let add (webLog : WebLog) =
let add (webLog: WebLog) =
log.LogTrace "WebLog.add"
insert Table.WebLog (WebLogId.toString webLog.Id) webLog
insert Table.WebLog webLog
/// Retrieve all web logs
let all () =
@@ -23,46 +24,60 @@ 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 data ->> '{nameof Post.Empty.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};
{Query.Delete.byContains Table.TagMap};
{Query.Delete.byContains Table.WebLogUser};
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
DELETE FROM {Table.WebLog} WHERE id = @webLogId"""
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
[ webLogIdParam webLogId; webLogContains webLogId ]
/// Find a web log by its host (URL base)
let findByHost (url : string) =
let findByHost (url: string) =
log.LogTrace "WebLog.findByHost"
Custom.single (selectWithCriteria Table.WebLog) [ "@criteria", Query.jsonbDocParam {| UrlBase = url |} ]
fromData<WebLog>
Find.firstByContains<WebLog> Table.WebLog {| UrlBase = url |}
/// Find a web log by its ID
let findById webLogId =
let findById (webLogId: WebLogId) =
log.LogTrace "WebLog.findById"
Find.byId<WebLog> Table.WebLog (WebLogId.toString webLogId)
Find.byId<WebLogId, WebLog> Table.WebLog webLogId
/// Update settings for a web log
let updateSettings (webLog : WebLog) =
log.LogTrace "WebLog.updateSettings"
Update.full Table.WebLog (WebLogId.toString webLog.Id) webLog
/// Update RSS options for a web log
let updateRssOptions (webLog : WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRssOptions"
/// Update redirect rules for a web log
let updateRedirectRules (webLog: WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRedirectRules"
match! findById webLog.Id with
| Some _ -> do! Update.partialById Table.WebLog (WebLogId.toString webLog.Id) {| Rss = webLog.Rss |}
| Some _ -> do! Patch.byId Table.WebLog webLog.Id {| RedirectRules = webLog.RedirectRules |}
| None -> ()
}
/// Update RSS options for a web log
let updateRssOptions (webLog: WebLog) = backgroundTask {
log.LogTrace "WebLog.updateRssOptions"
match! findById webLog.Id with
| Some _ -> do! Patch.byId Table.WebLog webLog.Id {| Rss = webLog.Rss |}
| None -> ()
}
/// Update settings for a web log
let updateSettings (webLog: WebLog) =
log.LogTrace "WebLog.updateSettings"
Update.byId Table.WebLog webLog.Id webLog
interface IWebLogData with
member _.Add webLog = add webLog
member _.All () = all ()
member _.All() = all ()
member _.Delete webLogId = delete webLogId
member _.FindByHost url = findByHost url
member _.FindById webLogId = findById webLogId
member _.UpdateSettings webLog = updateSettings webLog
member _.UpdateRedirectRules webLog = updateRedirectRules webLog
member _.UpdateRssOptions webLog = updateRssOptions webLog
member _.UpdateSettings webLog = updateSettings webLog

76
src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs
View File

@@ -1,18 +1,24 @@
namespace MyWebLog.Data.Postgres
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents
open BitBadger.Documents.Postgres
open Microsoft.Extensions.Logging
open MyWebLog
open MyWebLog.Data
open Npgsql.FSharp
/// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData (log : ILogger) =
/// PostgreSQL myWebLog user data implementation
type PostgresWebLogUserData(log: ILogger) =
/// Add a user
let add (user: WebLogUser) =
log.LogTrace "WebLogUser.add"
insert Table.WebLogUser user
/// Find a user by their ID for the given web log
let findById userId webLogId =
log.LogTrace "WebLogUser.findById"
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId WebLogUserId.toString webLogId
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId
/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
@@ -22,73 +28,70 @@ type PostgresWebLogUserData (log : ILogger) =
let criteria = Query.whereDataContains "@criteria"
let! isAuthor =
Custom.scalar
$" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria}
$" SELECT ( EXISTS (SELECT 1 FROM {Table.Page} WHERE {criteria})
OR EXISTS (SELECT 1 FROM {Table.Post} WHERE {criteria})
) AS {existsName}"
[ "@criteria", Query.jsonbDocParam {| AuthorId = userId |} ] Map.toExists
) AS it"
[ jsonParam "@criteria" {| AuthorId = userId |} ]
toExists
if isAuthor then
return Error "User has pages or posts; cannot delete"
else
do! Delete.byId Table.WebLogUser (WebLogUserId.toString userId)
do! Delete.byId 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 =
let findByEmail (email: string) webLogId =
log.LogTrace "WebLogUser.findByEmail"
Custom.single (selectWithCriteria Table.WebLogUser)
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Email = email |} ]
fromData<WebLogUser>
Find.firstByContains<WebLogUser> Table.WebLogUser {| webLogDoc webLogId with Email = email |}
/// Get all users for the given web log
let findByWebLog webLogId =
log.LogTrace "WebLogUser.findByWebLog"
Custom.list
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data->>'{nameof WebLogUser.empty.PreferredName}')"
[ webLogContains webLogId ] fromData<WebLogUser>
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')"
[ webLogContains webLogId ]
fromData<WebLogUser>
/// Find the names of users by their IDs for the given web log
let findNames webLogId userIds = backgroundTask {
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
log.LogTrace "WebLogUser.findNames"
let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
let idSql, idParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" userIds
let! users =
Custom.list $"{selectWithCriteria Table.WebLogUser} {idSql}" (webLogContains webLogId :: idParams)
fromData<WebLogUser>
return
users
|> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
Custom.list
$"{selectWithCriteria Table.WebLogUser} {idSql}"
(webLogContains webLogId :: idParams)
fromData<WebLogUser>
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
}
/// Restore users from a backup
let restore (users : WebLogUser list) = backgroundTask {
let restore (users: WebLogUser list) = backgroundTask {
log.LogTrace "WebLogUser.restore"
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.WebLogUser,
users |> List.map (fun user -> Query.docParameters (WebLogUserId.toString user.Id) user)
]
|> Sql.executeTransactionAsync
[ Query.insert Table.WebLogUser, users |> List.map (fun user -> [ jsonParam "@data" user ]) ]
()
}
/// Set a user's last seen date/time to now
let setLastSeen userId webLogId = backgroundTask {
let setLastSeen (userId: WebLogUserId) webLogId = backgroundTask {
log.LogTrace "WebLogUser.setLastSeen"
match! Document.existsByWebLog Table.WebLogUser userId WebLogUserId.toString webLogId with
| true ->
do! Update.partialById Table.WebLogUser (WebLogUserId.toString userId) {| LastSeenOn = Some (Noda.now ()) |}
match! Document.existsByWebLog Table.WebLogUser userId webLogId with
| true -> do! Patch.byId Table.WebLogUser userId {| LastSeenOn = Some (Noda.now ()) |}
| false -> ()
}
/// Save a user
let save (user : WebLogUser) =
log.LogTrace "WebLogUser.save"
save Table.WebLogUser (WebLogUserId.toString user.Id) user
/// Update a user
let update (user: WebLogUser) =
log.LogTrace "WebLogUser.update"
Update.byId Table.WebLogUser user.Id user
interface IWebLogUserData with
member _.Add user = save user
member _.Add user = add user
member _.Delete userId webLogId = delete userId webLogId
member _.FindByEmail email webLogId = findByEmail email webLogId
member _.FindById userId webLogId = findById userId webLogId
@@ -96,5 +99,4 @@ type PostgresWebLogUserData (log : ILogger) =
member _.FindNames webLogId userIds = findNames webLogId userIds
member _.Restore users = restore users
member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
member _.Update user = save user
member _.Update user = update user