bit-badger/myPrayerJournal
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 36 Activity

Convert Data Storage to PostgreSQL Documents #74

Merged
danieljsummers merged 11 commits from pg-doc into main 2023-10-10 02:15:39 +00:00
Conversation 0 Commits 11 Files Changed 19 +116 -83
4 changed files with 116 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit cc4347bc6e - Show all commits

71
src/MyPrayerJournal/Data.fs
View File

@ -1,6 +1,6 @@
module MyPrayerJournal.Data
/// Table(s) used by myPrayerJournal
/// Table(!) used by myPrayerJournal
module Table =
/// Requests
@ -8,16 +8,69 @@ module Table =
let Request = "mpj.request"
/// JSON serialization customizations
[<RequireQualifiedAccess>]
module Json =
open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T> ()
override _.Read(reader, _, _) =
wrap (reader.GetString ())
override _.Write(writer, value, _) =
writer.WriteStringValue (unwrap value)
open System.Text.Json
open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain
let options =
let opts = JsonSerializerOptions ()
[ WrappedJsonConverter (Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter (RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter (RequestId.ofString, RequestId.toString)
WrappedJsonConverter (UserId, UserId.toString)
JsonFSharpConverter ()
]
|> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
opts
open BitBadger.Npgsql.FSharp.Documents
module DataConnection =
/// Connection
[<RequireQualifiedAccess>]
module Connection =
let ensureDb () = backgroundTask {
open BitBadger.Npgsql.Documents
open Microsoft.Extensions.Configuration
open Npgsql
open System.Text.Json
/// Ensure the database is ready to use
let private ensureDb () = backgroundTask {
do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS mpj" []
do! Definition.ensureTable Table.Request
do! Definition.ensureIndex Table.Request Optimized
}
/// Set up the data environment
let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj")
let _ = builder.UseNodaTime ()
Configuration.useDataSource (builder.Build ())
Configuration.useSerializer
{ new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) = JsonSerializer.Serialize (it, Json.options)
member _.Deserialize<'T> (it : string) = JsonSerializer.Deserialize<'T> (it, Json.options)
}
do! ensureDb ()
}
/// Data access functions for requests
[<RequireQualifiedAccess>]
@ -30,6 +83,10 @@ module Request =
do! insert Table.Request (RequestId.toString req.Id) req
}
/// Does a request exist for the given request ID and user ID?
let existsById (reqId : RequestId) (userId : UserId) =
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
/// Retrieve a request by its ID and user ID (includes history and notes)
let tryByIdFull reqId userId = backgroundTask {
match! Find.byId<Request> Table.Request (RequestId.toString reqId) with
@ -44,10 +101,6 @@ module Request =
| None -> return None
}
/// Does a request exist for the given request ID and user ID?
let private existsById (reqId : RequestId) (userId : UserId) =
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
/// Update recurrence for a request
let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask {
let dbId = RequestId.toString reqId
@ -57,7 +110,7 @@ module Request =
}
/// Update the show-after time for a request
let updateShowAfter reqId userId (showAfter : Instant) = backgroundTask {
let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |}
@ -65,7 +118,7 @@ module Request =
}
/// Update the snoozed and show-after values for a request
let updateSnoozed reqId userId (until : Instant) = backgroundTask {
let updateSnoozed reqId userId (until : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}

102
src/MyPrayerJournal/Handlers.fs
View File

@ -45,16 +45,12 @@ module Error =
open System.Security.Claims
open LiteDB
open Microsoft.AspNetCore.Http
open NodaTime
/// Extensions on the HTTP context
type HttpContext with
/// The LiteDB database
member this.Db = this.GetService<LiteDatabase> ()
/// The "sub" for the current user (None if no user is authenticated)
member this.CurrentUser =
this.User
@ -83,6 +79,8 @@ type HttpContext with
| None -> DateTimeZone.Utc
open MyPrayerJournal.Data
/// Handler helpers
[<AutoOpen>]
module private Helpers =
@ -127,7 +125,7 @@ module private Helpers =
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed =
match ctx.CurrentUser with
| Some _ -> LiteData.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
| Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now ())
| None -> Task.FromResult false
return
{ IsAuthenticated = Option.isSome ctx.CurrentUser
@ -155,17 +153,17 @@ module private Helpers =
/// Push a new message into the list
let push (ctx : HttpContext) message url = lock upd8 (fun () ->
messages <- messages.Add (ctx.UserId, (message, url)))
messages <- messages.Add (ctx.UserId, (message, url)))
/// Add a success message header to the response
let pushSuccess ctx message url =
push ctx $"success|||%s{message}" url
push ctx $"success|||%s{message}" url
/// Pop the messages for the given user
let pop userId = lock upd8 (fun () ->
let msg = messages.TryFind userId
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
msg)
let msg = messages.TryFind userId
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
msg)
/// Send a partial result if this is not a full page load (does not append no-cache headers)
let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task {
@ -238,7 +236,6 @@ module Models =
}
open MyPrayerJournal.LiteData.Extensions
open NodaTime.Text
/// Handlers for less-than-full-page HTML requests
@ -254,14 +251,14 @@ module Components =
| Some snooze, _ when snooze < now -> true
| _, Some hide when hide < now -> true
| _, _ -> false
let! journal = LiteData.journalByUserId ctx.UserId ctx.Db
let! journal = Journal.forUser ctx.UserId
let shown = journal |> List.filter shouldBeShown
return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx
}
// GET /components/request-item/[req-id]
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
match! LiteData.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx
| None -> return! Error.notFound next ctx
}
@ -272,7 +269,7 @@ module Components =
// GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let! notes = LiteData.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx
}
@ -333,7 +330,7 @@ module Request =
return! partial "Add Prayer Request"
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
| _ ->
match! LiteData.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
match! Journal.tryById (RequestId.ofString requestId) ctx.UserId with
| Some req ->
debug ctx "Found - sending view"
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
@ -344,46 +341,42 @@ module Request =
// PATCH /request/[req-id]/prayed
let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! LiteData.tryRequestById reqId userId db with
match! Journal.tryById reqId userId with
| Some req ->
let now = ctx.Now ()
do! LiteData.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db
do! History.add reqId userId { AsOf = now; Status = Prayed; Text = None }
let nextShow =
match Recurrence.duration req.Recurrence with
| 0L -> None
| duration -> Some <| now.Plus (Duration.FromSeconds duration)
do! LiteData.updateShowAfter reqId userId nextShow db
do! db.SaveChanges ()
do! Request.updateShowAfter reqId userId nextShow
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx
}
/// POST /request/[req-id]/note
// POST /request/[req-id]/note
let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! LiteData.tryRequestById reqId userId db with
| Some _ ->
match! Request.existsById reqId userId with
| true ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
do! LiteData.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
do! db.SaveChanges ()
do! Note.add reqId userId { AsOf = ctx.Now (); Notes = notes.notes }
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// GET /requests/active
let active : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = LiteData.journalByUserId ctx.UserId ctx.Db
let! reqs = Journal.forUser ctx.UserId
return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx
}
// GET /requests/snoozed
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = LiteData.journalByUserId ctx.UserId ctx.Db
let! reqs = Journal.forUser ctx.UserId
let now = ctx.Now ()
let snoozed = reqs
|> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
@ -392,62 +385,56 @@ module Request =
// GET /requests/answered
let answered : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = LiteData.answeredRequests ctx.UserId ctx.Db
let! reqs = Journal.answered ctx.UserId
return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx
}
// GET /request/[req-id]/full
let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
match! LiteData.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with
match! Request.tryByIdFull (RequestId.ofString requestId) ctx.UserId with
| Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx
| None -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/show
let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! LiteData.tryRequestById reqId userId db with
| Some _ ->
do! LiteData.updateShowAfter reqId userId None db
do! db.SaveChanges ()
match! Request.existsById reqId userId with
| true ->
do! Request.updateShowAfter reqId userId None
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/snooze
let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! LiteData.tryRequestById reqId userId db with
| Some _ ->
match! Request.existsById reqId userId with
| true ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
let date =
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant ()
do! LiteData.updateSnoozed reqId userId (Some date) db
do! db.SaveChanges ()
do! Request.updateSnoozed reqId userId (Some date)
return!
(withSuccessMessage $"Request snoozed until {until.until}"
>=> hideModal "snooze"
>=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/cancel-snooze
let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! LiteData.tryRequestById reqId userId db with
| Some _ ->
do! LiteData.updateSnoozed reqId userId None db
do! db.SaveChanges ()
match! Request.existsById reqId userId with
| true ->
do! Request.updateSnoozed reqId userId None
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
/// Derive a recurrence from its representation in the form
@ -458,7 +445,6 @@ module Request =
// POST /request
let add : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = ctx.Db
let userId = ctx.UserId
let now = ctx.Now ()
let req =
@ -475,8 +461,7 @@ module Request =
}
|]
}
LiteData.addRequest req db
do! db.SaveChanges ()
do! Request.add req
Messages.pushSuccess ctx "Added prayer request" "/journal"
return! seeOther "/journal" next ctx
}
@ -484,25 +469,24 @@ module Request =
// PATCH /request
let update : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = ctx.Db
let userId = ctx.UserId
match! LiteData.tryJournalById (RequestId.ofString form.requestId) userId db with
// TODO: update the instance and save rather than all these little updates
match! Journal.tryById (RequestId.ofString form.requestId) userId with
| Some req ->
// update recurrence if changed
let recur = parseRecurrence form
match recur = req.Recurrence with
| true -> ()
| false ->
do! LiteData.updateRecurrence req.RequestId userId recur db
do! Request.updateRecurrence req.RequestId userId recur
match recur with
| Immediate -> do! LiteData.updateShowAfter req.RequestId userId None db
| Immediate -> do! Request.updateShowAfter req.RequestId userId None
| _ -> ()
// append history
let upd8Text = form.requestText.Trim ()
let text = if upd8Text = req.Text then None else Some upd8Text
do! LiteData.addHistory req.RequestId userId
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
do! db.SaveChanges ()
do! History.add req.RequestId userId
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text }
let nextUrl =
match form.returnTo with
| "active" -> "/requests/active"

11
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -21,15 +21,16 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta3" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.2.42" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.2" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.2" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.6" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" />
<PackageReference Include="LiteDB" Version="5.0.16" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.5" />
<PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Update="FSharp.Core" Version="7.0.300" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.6" />
<PackageReference Update="FSharp.Core" Version="7.0.400" />
</ItemGroup>
<ItemGroup>
<Folder Include="wwwroot\" />

15
src/MyPrayerJournal/Program.fs
View File

@ -20,7 +20,7 @@ module Configure =
.SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
.AddEnvironmentVariables ()
.AddEnvironmentVariables "MPJ_"
|> ignore
bldr
@ -53,16 +53,15 @@ module Configure =
open Giraffe
open LiteDB
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Authentication.OpenIdConnect
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open MyPrayerJournal.Data
open NodaTime
open System
open System.Text.Json
open System.Text.Json.Serialization
open System.Threading.Tasks
/// Configure dependency injection
@ -128,13 +127,9 @@ module Configure =
ctx.ProtocolMessage.RedirectUri <- string bldr
Task.CompletedTask)
let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
LiteData.Startup.ensureDb db
let _ = bldr.Services.AddSingleton jsonOptions
let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
let _ = bldr.Services.AddSingleton<LiteDatabase> db
let _ = bldr.Services.AddSingleton<JsonSerializerOptions> Json.options
let _ = bldr.Services.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
let _ = Connection.setUp bldr.Configuration |> Async.AwaitTask |> Async.RunSynchronously
bldr.Build ()