Version 2.1 (#41)
- 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:
GitHub
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user