diff --git a/src/MyPrayerJournal/Data.fs b/src/MyPrayerJournal/Data.fs index 51cda0b..6380765 100644 --- a/src/MyPrayerJournal/Data.fs +++ b/src/MyPrayerJournal/Data.fs @@ -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 +[] +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 +[] +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 [] @@ -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 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 |} diff --git a/src/MyPrayerJournal/Handlers.fs b/src/MyPrayerJournal/Handlers.fs index 79d92da..c81f837 100644 --- a/src/MyPrayerJournal/Handlers.fs +++ b/src/MyPrayerJournal/Handlers.fs @@ -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 () - /// 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 [] 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 () - 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 () 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 () - 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 () - 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" diff --git a/src/MyPrayerJournal/MyPrayerJournal.fsproj b/src/MyPrayerJournal/MyPrayerJournal.fsproj index 3616f90..20289fa 100644 --- a/src/MyPrayerJournal/MyPrayerJournal.fsproj +++ b/src/MyPrayerJournal/MyPrayerJournal.fsproj @@ -21,15 +21,16 @@ - + - - + + - - + + + diff --git a/src/MyPrayerJournal/Program.fs b/src/MyPrayerJournal/Program.fs index 70ed17a..0181106 100644 --- a/src/MyPrayerJournal/Program.fs +++ b/src/MyPrayerJournal/Program.fs @@ -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 () - let _ = bldr.Services.AddSingleton db + let _ = bldr.Services.AddSingleton Json.options + let _ = bldr.Services.AddSingleton (SystemTextJson.Serializer Json.options) + let _ = Connection.setUp bldr.Configuration |> Async.AwaitTask |> Async.RunSynchronously bldr.Build ()