From bbe7294ba67b27a5d0211cb4d3240077022be002 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 21 Sep 2021 19:12:13 -0400 Subject: [PATCH] Convert data to LiteDB-backed store --- src/MyPrayerJournal.sln | 37 -- src/MyPrayerJournal/Api/Data.fs | 379 ++++++++++-------- src/MyPrayerJournal/Api/Domain.fs | 196 ++++----- src/MyPrayerJournal/Api/Handlers.fs | 348 +++++++--------- .../Api/MyPrayerJournal.Api.fsproj | 13 +- src/MyPrayerJournal/Api/Program.fs | 184 ++++----- 6 files changed, 553 insertions(+), 604 deletions(-) delete mode 100644 src/MyPrayerJournal.sln diff --git a/src/MyPrayerJournal.sln b/src/MyPrayerJournal.sln deleted file mode 100644 index 9253d74..0000000 --- a/src/MyPrayerJournal.sln +++ /dev/null @@ -1,37 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.28721.148 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyPrayerJournal.Api", "MyPrayerJournal.Api\MyPrayerJournal.Api.fsproj", "{1887D1E1-544A-4F54-B266-38E7867DC842}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Any CPU = Debug|Any CPU - Debug|iPhone = Debug|iPhone - Debug|iPhoneSimulator = Debug|iPhoneSimulator - Release|Any CPU = Release|Any CPU - Release|iPhone = Release|iPhone - Release|iPhoneSimulator = Release|iPhoneSimulator - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|Any CPU.Build.0 = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhone.ActiveCfg = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhone.Build.0 = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|Any CPU.ActiveCfg = Release|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|Any CPU.Build.0 = Release|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhone.ActiveCfg = Release|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhone.Build.0 = Release|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU - {1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhoneSimulator.Build.0 = Release|Any CPU - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {8E2447D9-52F0-4A0D-BB61-A83C19353D7C} - EndGlobalSection -EndGlobal diff --git a/src/MyPrayerJournal/Api/Data.fs b/src/MyPrayerJournal/Api/Data.fs index 1ab0537..a5e82f1 100644 --- a/src/MyPrayerJournal/Api/Data.fs +++ b/src/MyPrayerJournal/Api/Data.fs @@ -1,186 +1,227 @@ -namespace MyPrayerJournal +module MyPrayerJournal.Data +open LiteDB open System -open System.Collections.Generic +open System.Threading.Tasks -/// JSON converters for various DUs -module Converters = +// fsharplint:disable MemberNames + +/// LiteDB extensions +[] +module Extensions = - open Microsoft.FSharpLu.Json - open Newtonsoft.Json + /// Extensions on the LiteDatabase class + type LiteDatabase with + /// The Request collection + member this.requests + with get () = this.GetCollection("request") + /// Async version of the checkpoint command (flushes log) + member this.saveChanges () = + this.Checkpoint() + Task.CompletedTask - /// JSON converter for request IDs - type RequestIdJsonConverter () = - inherit JsonConverter () - override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) = - (RequestId.toString >> writer.WriteValue) value - override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) = - (string >> RequestId.fromIdString) reader.Value - /// JSON converter for user IDs - type UserIdJsonConverter () = - inherit JsonConverter () - override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) = - (UserId.toString >> writer.WriteValue) value - override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) = - (string >> UserId) reader.Value +/// Map domain to LiteDB +// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation +[] +module Mapping = + + /// Map a history entry to BSON + let historyToBson (hist : History) : BsonValue = + let doc = BsonDocument () + doc.["asOf"] <- BsonValue (Ticks.toLong hist.asOf) + doc.["status"] <- BsonValue (RequestAction.toString hist.status) + doc.["text"] <- BsonValue (Option.toObj hist.text) + upcast doc - /// JSON converter for Ticks - type TicksJsonConverter () = - inherit JsonConverter () - override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) = - (Ticks.toLong >> writer.WriteValue) value - override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) = - (string >> int64 >> Ticks) reader.Value + /// Map a BSON document to a history entry + let historyFromBson (doc : BsonValue) = + { asOf = Ticks doc.["asOf"].AsInt64 + status = RequestAction.fromString doc.["status"].AsString + text = match doc.["text"].IsNull with true -> None | false -> Some doc.["text"].AsString + } - /// A sequence of all custom converters needed for myPrayerJournal - let all : JsonConverter seq = - seq { - yield RequestIdJsonConverter () - yield UserIdJsonConverter () - yield TicksJsonConverter () - yield CompactUnionJsonConverter true + /// Map a note entry to BSON + let noteToBson (note : Note) : BsonValue = + let doc = BsonDocument () + doc.["asOf"] <- BsonValue (Ticks.toLong note.asOf) + doc.["notes"] <- BsonValue note.notes + upcast doc + + /// Map a BSON document to a note entry + let noteFromBson (doc : BsonValue) = + { asOf = Ticks doc.["asOf"].AsInt64 + notes = doc.["notes"].AsString + } + + /// Map a request to its BSON representation + let requestToBson req : BsonValue = + let doc = BsonDocument () + doc.["_id"] <- BsonValue (RequestId.toString req.id) + doc.["enteredOn"] <- BsonValue (Ticks.toLong req.enteredOn) + doc.["userId"] <- BsonValue (UserId.toString req.userId) + doc.["snoozedUntil"] <- BsonValue (Ticks.toLong req.snoozedUntil) + doc.["showAfter"] <- BsonValue (Ticks.toLong req.showAfter) + doc.["recurType"] <- BsonValue (Recurrence.toString req.recurType) + doc.["recurCount"] <- BsonValue req.recurCount + doc.["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList) + doc.["notes"] <- BsonValue (req.notes |> List.map noteToBson |> Seq.ofList) + upcast doc + + /// Map a BSON document to a request + let requestFromBson (doc : BsonValue) = + { id = RequestId.ofString doc.["_id"].AsString + enteredOn = Ticks doc.["enteredOn"].AsInt64 + userId = UserId doc.["userId"].AsString + snoozedUntil = Ticks doc.["snoozedUntil"].AsInt64 + showAfter = Ticks doc.["showAfter"].AsInt64 + recurType = Recurrence.fromString doc.["recurType"].AsString + recurCount = int16 doc.["recurCount"].AsInt32 + history = doc.["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq + notes = doc.["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq + } + + /// Set up the mapping + let register () = + BsonMapper.Global.RegisterType( + Func requestToBson, Func requestFromBson) + +/// Code to be run at startup +module Startup = + + /// Ensure the database is set up + let ensureDb (db : LiteDatabase) = + db.requests.EnsureIndex (fun it -> it.userId) |> ignore + Mapping.register () + + +/// Async wrappers for LiteDB, and request -> journal mappings +[] +module private Helpers = + + /// Async wrapper around a LiteDB query that returns multiple results + let doListQuery<'T> (q : ILiteQueryable<'T>) = + q.ToList () |> Task.FromResult + + /// Async wrapper around a LiteDB query that returns 0 or 1 results + let doSingleQuery<'T> (q : ILiteQueryable<'T>) = + q.FirstOrDefault () |> Task.FromResult + + /// Async wrapper around a request update + let doUpdate (db : LiteDatabase) (req : Request) = + db.requests.Update req |> ignore + Task.CompletedTask + + /// Convert a request to the form used for the journal (precomputed values, no notes or history) + let toJournalLite (req : Request) = + let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.head + { requestId = req.id + userId = req.userId + text = (req.history + |> List.filter (fun it -> Option.isSome it.text) + |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) + |> List.head).text + |> Option.get + asOf = hist.asOf + lastStatus = hist.status + snoozedUntil = req.snoozedUntil + showAfter = req.showAfter + recurType = req.recurType + recurCount = req.recurCount + history = [] + notes = [] + } + + /// Same as above, but with notes and history + let toJournalFull req = + { toJournalLite req with + history = req.history + notes = req.notes } -/// RavenDB index declarations -module Indexes = +/// Retrieve a request, including its history and notes, by its ID and user ID +let tryFullRequestById reqId userId (db : LiteDatabase) = task { + let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId)) + return match box req with null -> None | _ -> Some req + } + +/// Add a history entry +let addHistory reqId userId hist db = task { + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with history = hist :: req.history } + | None -> invalidOp $"{RequestId.toString reqId} not found" + } + +/// Add a note +let addNote reqId userId note db = task { + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with notes = note :: req.notes } + | None -> invalidOp $"{RequestId.toString reqId} not found" + } + +/// Add a request +let addRequest (req : Request) (db : LiteDatabase) = + db.requests.Insert req |> ignore + +/// Retrieve all answered requests for the given user +let answeredRequests userId (db : LiteDatabase) = task { + let! reqs = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId)) + return + reqs + |> Seq.map toJournalFull + |> Seq.filter (fun it -> it.lastStatus = Answered) + |> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf) + |> List.ofSeq + } - open Raven.Client.Documents.Indexes +/// Retrieve the user's current journal +let journalByUserId userId (db : LiteDatabase) = task { + let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId)) + return + jrnl + |> Seq.map toJournalLite + |> Seq.filter (fun it -> it.lastStatus <> Answered) + |> Seq.sortBy (fun it -> Ticks.toLong it.asOf) + |> List.ofSeq + } - /// Index requests for a journal view - // fsharplint:disable-next-line TypeNames - type Requests_AsJournal () as this = - inherit AbstractJavaScriptIndexCreationTask () - do - this.Maps <- HashSet [ - """docs.Requests.Select(req => new { - requestId = req.Id.Replace("Requests/", ""), - userId = req.userId, - text = req.history.Where(hist => hist.text != null).OrderByDescending(hist => hist.asOf).First().text, - asOf = req.history.OrderByDescending(hist => hist.asOf).First().asOf, - lastStatus = req.history.OrderByDescending(hist => hist.asOf).First().status, - snoozedUntil = req.snoozedUntil, - showAfter = req.showAfter, - recurType = req.recurType, - recurCount = req.recurCount - })""" - ] - this.Fields <- - [ "requestId", IndexFieldOptions (Storage = Nullable FieldStorage.Yes) - "text", IndexFieldOptions (Storage = Nullable FieldStorage.Yes) - "asOf", IndexFieldOptions (Storage = Nullable FieldStorage.Yes) - "lastStatus", IndexFieldOptions (Storage = Nullable FieldStorage.Yes) - ] - |> dict - |> Dictionary +/// Retrieve a request by its ID and user ID (without notes and history) +let tryRequestById reqId userId db = task { + match! tryFullRequestById reqId userId db with + | Some r -> return Some { r with history = []; notes = [] } + | _ -> return None + } - -/// All data manipulations within myPrayerJournal -module Data = - - open Indexes - open Microsoft.FSharpLu - open Raven.Client.Documents - open Raven.Client.Documents.Linq - open Raven.Client.Documents.Session - - /// Add a history entry - let addHistory reqId (hist : History) (sess : IAsyncDocumentSession) = - sess.Advanced.Patch ( - RequestId.toString reqId, - (fun r -> r.history :> IEnumerable), - fun (h : JavaScriptArray) -> h.Add (hist) :> obj) - - /// Add a note - let addNote reqId (note : Note) (sess : IAsyncDocumentSession) = - sess.Advanced.Patch ( - RequestId.toString reqId, - (fun r -> r.notes :> IEnumerable), - fun (h : JavaScriptArray) -> h.Add (note) :> obj) - - /// Add a request - let addRequest req (sess : IAsyncDocumentSession) = - sess.StoreAsync (req, req.Id) - - /// Retrieve all answered requests for the given user - let answeredRequests userId (sess : IAsyncDocumentSession) = - task { - let! reqs = - sess.Query() - .Where(fun r -> r.userId = userId && r.lastStatus = "Answered") - .OrderByDescending(fun r -> r.asOf) - .ProjectInto() - .ToListAsync () - return List.ofSeq reqs - } +/// Retrieve notes for a request by its ID and user ID +let notesById reqId userId (db : LiteDatabase) = task { + match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return [] + } - /// Retrieve the user's current journal - let journalByUserId userId (sess : IAsyncDocumentSession) = - task { - let! jrnl = - sess.Query() - .Where(fun r -> r.userId = userId && r.lastStatus <> "Answered") - .OrderBy(fun r -> r.asOf) - .ProjectInto() - .ToListAsync() - return - jrnl - |> Seq.map (fun r -> r.history <- []; r.notes <- []; r) - |> List.ofSeq - } +/// Retrieve a journal request by its ID and user ID +let tryJournalById reqId userId (db : LiteDatabase) = task { + match! tryFullRequestById reqId userId db with + | Some req -> return req |> (toJournalLite >> Some) + | None -> return None + } + +/// Update the recurrence for a request +let updateRecurrence reqId userId recurType recurCount db = task { + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount } + | None -> invalidOp $"{RequestId.toString reqId} not found" + } - /// Save changes in the current document session - let saveChanges (sess : IAsyncDocumentSession) = - sess.SaveChangesAsync () +/// Update a snoozed request +let updateSnoozed reqId userId until db = task { + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until } + | None -> invalidOp $"{RequestId.toString reqId} not found" + } - /// Retrieve a request, including its history and notes, by its ID and user ID - let tryFullRequestById reqId userId (sess : IAsyncDocumentSession) = - task { - let! req = RequestId.toString reqId |> sess.LoadAsync - return match Option.fromObject req with Some r when r.userId = userId -> Some r | _ -> None - } - - - /// Retrieve a request by its ID and user ID (without notes and history) - let tryRequestById reqId userId (sess : IAsyncDocumentSession) = - task { - match! tryFullRequestById reqId userId sess with - | Some r -> return Some { r with history = []; notes = [] } - | _ -> return None - } - - /// Retrieve notes for a request by its ID and user ID - let notesById reqId userId (sess : IAsyncDocumentSession) = - task { - match! tryFullRequestById reqId userId sess with - | Some req -> return req.notes - | None -> return [] - } - - /// Retrieve a journal request by its ID and user ID - let tryJournalById reqId userId (sess : IAsyncDocumentSession) = - task { - let! req = - sess.Query() - .Where(fun x -> x.Id = (RequestId.toString reqId) && x.userId = userId) - .ProjectInto() - .FirstOrDefaultAsync () - return - Option.fromObject req - |> Option.map (fun r -> r.history <- []; r.notes <- []; r) - } - - /// Update the recurrence for a request - let updateRecurrence reqId recurType recurCount (sess : IAsyncDocumentSession) = - sess.Advanced.Patch (RequestId.toString reqId, (fun r -> r.recurType), recurType) - sess.Advanced.Patch (RequestId.toString reqId, (fun r -> r.recurCount), recurCount) - - /// Update a snoozed request - let updateSnoozed reqId until (sess : IAsyncDocumentSession) = - sess.Advanced.Patch (RequestId.toString reqId, (fun r -> r.snoozedUntil), until) - sess.Advanced.Patch (RequestId.toString reqId, (fun r -> r.showAfter), until) - - /// Update the "show after" timestamp for a request - let updateShowAfter reqId showAfter (sess : IAsyncDocumentSession) = - sess.Advanced.Patch (RequestId.toString reqId, (fun r -> r.showAfter), showAfter) +/// Update the "show after" timestamp for a request +let updateShowAfter reqId userId showAfter db = task { + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with showAfter = showAfter } + | None -> invalidOp $"{RequestId.toString reqId} not found" + } diff --git a/src/MyPrayerJournal/Api/Domain.fs b/src/MyPrayerJournal/Api/Domain.fs index fecf0d3..02f25b0 100644 --- a/src/MyPrayerJournal/Api/Domain.fs +++ b/src/MyPrayerJournal/Api/Domain.fs @@ -6,19 +6,23 @@ module MyPrayerJournal.Domain open Cuid -/// Request ID is a CUID +/// An identifier for a request type RequestId = | RequestId of Cuid + +/// Functions to manipulate request IDs module RequestId = /// The string representation of the request ID - let toString = function RequestId x -> $"Requests/{Cuid.toString x}" + let toString = function RequestId x -> Cuid.toString x /// Create a request ID from a string representation - let fromIdString (x : string) = x.Replace ("Requests/", "") |> (Cuid >> RequestId) + let ofString = Cuid >> RequestId -/// User ID is a string (the "sub" part of the JWT) +/// The identifier of a user (the "sub" part of the JWT) type UserId = | UserId of string + +/// Functions to manipulate user IDs module UserId = /// The string representation of the user ID let toString = function UserId x -> x @@ -27,6 +31,8 @@ module UserId = /// A long integer representing seconds since the epoch type Ticks = | Ticks of int64 + +/// Functions to manipulate Ticks module Ticks = /// The int64 (long) representation of ticks let toLong = function Ticks x -> x @@ -38,22 +44,34 @@ type Recurrence = | Hours | Days | Weeks + +/// Functions to manipulate recurrences module Recurrence = + /// Create a string representation of a recurrence + let toString = + function + | Immediate -> "Immediate" + | Hours -> "Hours" + | Days -> "Days" + | Weeks -> "Weeks" /// Create a recurrence value from a string let fromString = function | "Immediate" -> Immediate - | "Hours" -> Hours - | "Days" -> Days - | "Weeks" -> Weeks - | it -> invalidOp $"{it} is not a valid recurrence" - /// The duration of the recurrence - let duration = - function - | Immediate -> 0L - | Hours -> 3600000L - | Days -> 86400000L - | Weeks -> 604800000L + | "Hours" -> Hours + | "Days" -> Days + | "Weeks" -> Weeks + | it -> invalidOp $"{it} is not a valid recurrence" + /// An hour's worth of seconds + let private oneHour = 3_600L + /// The duration of the recurrence (in milliseconds) + let duration x = + (match x with + | Immediate -> 0L + | Hours -> oneHour + | Days -> oneHour * 24L + | Weeks -> oneHour * 24L * 7L) + |> ( * ) 1000L /// The action taken on a request as part of a history entry @@ -62,76 +80,72 @@ type RequestAction = | Prayed | Updated | Answered + +/// Functions to manipulate request actions module RequestAction = + /// Create a string representation of an action + let toString = + function + | Created -> "Created" + | Prayed -> "Prayed" + | Updated -> "Updated" + | Answered -> "Answered" /// Create a RequestAction from a string let fromString = function - | "Created" -> Created - | "Prayed" -> Prayed - | "Updated" -> Updated + | "Created" -> Created + | "Prayed" -> Prayed + | "Updated" -> Updated | "Answered" -> Answered - | it -> invalidOp $"Bad request action {it}" + | it -> invalidOp $"Bad request action {it}" /// History is a record of action taken on a prayer request, including updates to its text [] -type History = - { /// The time when this history entry was made - asOf : Ticks - /// The status for this history entry - status : RequestAction - /// The text of the update, if applicable - text : string option - } -with - /// An empty history entry - static member empty = - { asOf = Ticks 0L - status = Created - text = None - } +type History = { + /// The time when this history entry was made + asOf : Ticks + /// The status for this history entry + status : RequestAction + /// The text of the update, if applicable + text : string option + } /// Note is a note regarding a prayer request that does not result in an update to its text [] -type Note = - { /// The time when this note was made - asOf : Ticks - /// The text of the notes - notes : string - } -with - /// An empty note - static member empty = - { asOf = Ticks 0L - notes = "" - } +type Note = { + /// The time when this note was made + asOf : Ticks + /// The text of the notes + notes : string + } /// Request is the identifying record for a prayer request [] -type Request = - { /// The ID of the request - Id : string - /// The time this request was initially entered - enteredOn : Ticks - /// The ID of the user to whom this request belongs ("sub" from the JWT) - userId : UserId - /// The time at which this request should reappear in the user's journal by manual user choice - snoozedUntil : Ticks - /// The time at which this request should reappear in the user's journal by recurrence - showAfter : Ticks - /// The type of recurrence for this request - recurType : Recurrence - /// How many of the recurrence intervals should occur between appearances in the journal - recurCount : int16 - /// The history entries for this request - history : History list - /// The notes for this request - notes : Note list - } +type Request = { + /// The ID of the request + id : RequestId + /// The time this request was initially entered + enteredOn : Ticks + /// The ID of the user to whom this request belongs ("sub" from the JWT) + userId : UserId + /// The time at which this request should reappear in the user's journal by manual user choice + snoozedUntil : Ticks + /// The time at which this request should reappear in the user's journal by recurrence + showAfter : Ticks + /// The type of recurrence for this request + recurType : Recurrence + /// How many of the recurrence intervals should occur between appearances in the journal + recurCount : int16 + /// The history entries for this request + history : History list + /// The notes for this request + notes : Note list + } with /// An empty request static member empty = - { Id = "" + { id = Cuid.generate () |> RequestId enteredOn = Ticks 0L userId = UserId "" snoozedUntil = Ticks 0L @@ -144,28 +158,28 @@ with /// JournalRequest is the form of a prayer request returned for the request journal display. It also contains /// properties that may be filled for history and notes. -// RavenDB doesn't like the "@"-suffixed properties from record types in a ProjectInto clause [] -type JournalRequest () = - /// The ID of the request (just the CUID part) - [] val mutable requestId : string - /// The ID of the user to whom the request belongs - [] val mutable userId : UserId - /// The current text of the request - [] val mutable text : string - /// The last time action was taken on the request - [] val mutable asOf : Ticks - /// The last status for the request - [] val mutable lastStatus : string - /// The time that this request should reappear in the user's journal - [] val mutable snoozedUntil : Ticks - /// The time after which this request should reappear in the user's journal by configured recurrence - [] val mutable showAfter : Ticks - /// The type of recurrence for this request - [] val mutable recurType : Recurrence - /// How many of the recurrence intervals should occur between appearances in the journal - [] val mutable recurCount : int16 - /// History entries for the request - [] val mutable history : History list - /// Note entries for the request - [] val mutable notes : Note list +type JournalRequest = + { /// The ID of the request (just the CUID part) + requestId : RequestId + /// The ID of the user to whom the request belongs + userId : UserId + /// The current text of the request + text : string + /// The last time action was taken on the request + asOf : Ticks + /// The last status for the request + lastStatus : RequestAction + /// The time that this request should reappear in the user's journal + snoozedUntil : Ticks + /// The time after which this request should reappear in the user's journal by configured recurrence + showAfter : Ticks + /// The type of recurrence for this request + recurType : Recurrence + /// How many of the recurrence intervals should occur between appearances in the journal + recurCount : int16 + /// History entries for the request + history : History list + /// Note entries for the request + notes : Note list + } diff --git a/src/MyPrayerJournal/Api/Handlers.fs b/src/MyPrayerJournal/Api/Handlers.fs index 5760732..a5c907d 100644 --- a/src/MyPrayerJournal/Api/Handlers.fs +++ b/src/MyPrayerJournal/Api/Handlers.fs @@ -5,6 +5,7 @@ module MyPrayerJournal.Handlers // fsharplint:disable RecordFieldNames open Giraffe +open MyPrayerJournal.Data.Extensions /// Handler to return Vue files module Vue = @@ -35,21 +36,18 @@ module Error = | _ -> Vue.app next ctx open Cuid +open LiteDB /// Handler helpers [] module private Helpers = open Microsoft.AspNetCore.Http - open Raven.Client.Documents open System.Threading.Tasks open System.Security.Claims - /// Create a RavenDB session - let session (ctx : HttpContext) = - let sess = ctx.GetService().OpenAsyncSession () - sess.Advanced.WaitForIndexesAfterSaveChanges () - sess + /// Get the LiteDB database + let db (ctx : HttpContext) = ctx.GetService() /// Get the user's "sub" claim let user (ctx : HttpContext) = @@ -73,7 +71,7 @@ module private Helpers = /// The "now" time in JavaScript as Ticks let jsNow () = - (int64 >> (*) 1000L >> Ticks) <| DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds + DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds |> (int64 >> ( * ) 1_000L >> Ticks) /// Handler to return a 403 Not Authorized reponse let notAuthorized : HttpHandler = @@ -86,15 +84,6 @@ module private Helpers = /// Flip JSON result so we can pipe into it let asJson<'T> next ctx (o : 'T) = json o next ctx - - /// Work-around to let the Json.NET serializer synchronously deserialize from the request stream - // TODO: Remove this once there is an async serializer - // let allowSyncIO : HttpHandler = - // fun next ctx -> - // match ctx.Features.Get() with - // | null -> () - // | f -> f.AllowSynchronousIO <- true - // next ctx /// Strongly-typed models for post requests @@ -102,46 +91,46 @@ module Models = /// A history entry addition (AKA request update) [] - type HistoryEntry = - { /// The status of the history update - status : string - /// The text of the update - updateText : string - } + type HistoryEntry = { + /// The status of the history update + status : string + /// The text of the update + updateText : string + } /// An additional note [] - type NoteEntry = - { /// The notes being added - notes : string - } + type NoteEntry = { + /// The notes being added + notes : string + } /// Recurrence update [] - type Recurrence = - { /// The recurrence type - recurType : string - /// The recurrence cound - recurCount : int16 - } + type Recurrence = { + /// The recurrence type + recurType : string + /// The recurrence cound + recurCount : int16 + } /// A prayer request [] - type Request = - { /// The text of the request - requestText : string - /// The recurrence type - recurType : string - /// The recurrence count - recurCount : int16 - } + type Request = { + /// The text of the request + requestText : string + /// The recurrence type + recurType : string + /// The recurrence count + recurCount : int16 + } /// The time until which a request should not appear in the journal [] - type SnoozeUntil = - { /// The time at which the request should reappear - until : int64 - } + type SnoozeUntil = { + /// The time at which the request should reappear + until : int64 + } /// /api/journal URLs module Journal = @@ -149,13 +138,10 @@ module Journal = /// GET /api/journal let journal : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let! jrnl = Data.journalByUserId usrId sess - return! json jrnl next ctx - } + >=> fun next ctx -> task { + let! jrnl = Data.journalByUserId (userId ctx) (db ctx) + return! json jrnl next ctx + } /// /api/request URLs @@ -164,184 +150,162 @@ module Request = /// POST /api/request let add : HttpHandler = authorize - // >=> allowSyncIO - >=> fun next ctx -> - task { - let! r = ctx.BindJsonAsync () - use sess = session ctx - let reqId = (Cuid.generate >> RequestId) () - let usrId = userId ctx - let now = jsNow () - do! Data.addRequest - { Request.empty with - Id = RequestId.toString reqId - userId = usrId - enteredOn = now - showAfter = Ticks 0L - recurType = Recurrence.fromString r.recurType - recurCount = r.recurCount - history = [ - { asOf = now - status = Created - text = Some r.requestText - } - ] - } sess - do! Data.saveChanges sess - match! Data.tryJournalById reqId usrId sess with - | Some req -> return! (setStatusCode 201 >=> json req) next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + let! r = ctx.BindJsonAsync () + let db = db ctx + let usrId = userId ctx + let now = jsNow () + let req = { Request.empty with + userId = usrId + enteredOn = now + showAfter = Ticks 0L + recurType = Recurrence.fromString r.recurType + recurCount = r.recurCount + history = [ + { asOf = now + status = Created + text = Some r.requestText + } + ] + } + Data.addRequest req db + do! db.saveChanges () + match! Data.tryJournalById req.id usrId db with + | Some req -> return! (setStatusCode 201 >=> json req) next ctx + | None -> return! Error.notFound next ctx + } /// POST /api/request/[req-id]/history let addHistory requestId : HttpHandler = authorize - // >=> allowSyncIO - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let reqId = toReqId requestId - match! Data.tryRequestById reqId usrId sess with - | Some req -> - let! hist = ctx.BindJsonAsync () - let now = jsNow () - let act = RequestAction.fromString hist.status - Data.addHistory reqId - { asOf = now - status = act - text = match hist.updateText with null | "" -> None | x -> Some x - } sess - match act with - | Prayed -> - let nextShow = - match Recurrence.duration req.recurType with - | 0L -> 0L - | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) - Data.updateShowAfter reqId (Ticks nextShow) sess - | _ -> () - do! Data.saveChanges sess - return! created next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> FSharp.Control.Tasks.Affine.task { + let db = db ctx + let usrId = userId ctx + let reqId = toReqId requestId + match! Data.tryRequestById reqId usrId db with + | Some req -> + let! hist = ctx.BindJsonAsync () + let now = jsNow () + let act = RequestAction.fromString hist.status + do! Data.addHistory reqId usrId + { asOf = now + status = act + text = match hist.updateText with null | "" -> None | x -> Some x + } db + match act with + | Prayed -> + let nextShow = + match Recurrence.duration req.recurType with + | 0L -> 0L + | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) + do! Data.updateShowAfter reqId usrId (Ticks nextShow) db + | _ -> () + do! db.saveChanges () + return! created next ctx + | None -> return! Error.notFound next ctx + } /// POST /api/request/[req-id]/note let addNote requestId : HttpHandler = authorize // >=> allowSyncIO - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let reqId = toReqId requestId - match! Data.tryRequestById reqId usrId sess with - | Some _ -> - let! notes = ctx.BindJsonAsync () - Data.addNote reqId { asOf = jsNow (); notes = notes.notes } sess - do! Data.saveChanges sess - return! created next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + let db = db ctx + let usrId = userId ctx + let reqId = toReqId requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + let! notes = ctx.BindJsonAsync () + do! Data.addNote reqId usrId { asOf = jsNow (); notes = notes.notes } db + do! db.saveChanges () + return! created next ctx + | None -> return! Error.notFound next ctx + } /// GET /api/requests/answered let answered : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let! reqs = Data.answeredRequests usrId sess - return! json reqs next ctx - } + >=> fun next ctx -> task { + let! reqs = Data.answeredRequests (userId ctx) (db ctx) + return! json reqs next ctx + } /// GET /api/request/[req-id] let get requestId : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - match! Data.tryJournalById (toReqId requestId) usrId sess with - | Some req -> return! json req next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + match! Data.tryJournalById (toReqId requestId) (userId ctx) (db ctx) with + | Some req -> return! json req next ctx + | None -> return! Error.notFound next ctx + } /// GET /api/request/[req-id]/full let getFull requestId : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - match! Data.tryFullRequestById (toReqId requestId) usrId sess with - | Some req -> return! json req next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + match! Data.tryFullRequestById (toReqId requestId) (userId ctx) (db ctx) with + | Some req -> return! json req next ctx + | None -> return! Error.notFound next ctx + } /// GET /api/request/[req-id]/notes let getNotes requestId : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let! notes = Data.notesById (toReqId requestId) usrId sess - return! json notes next ctx - } + >=> fun next ctx -> task { + let! notes = Data.notesById (toReqId requestId) (userId ctx) (db ctx) + return! json notes next ctx + } /// PATCH /api/request/[req-id]/show let show requestId : HttpHandler = authorize - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let reqId = toReqId requestId - match! Data.tryRequestById reqId usrId sess with - | Some _ -> - Data.updateShowAfter reqId (Ticks 0L) sess - do! Data.saveChanges sess - return! setStatusCode 204 next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + let db = db ctx + let usrId = userId ctx + let reqId = toReqId requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + do! Data.updateShowAfter reqId usrId (Ticks 0L) db + do! db.saveChanges () + return! setStatusCode 204 next ctx + | None -> return! Error.notFound next ctx + } /// PATCH /api/request/[req-id]/snooze let snooze requestId : HttpHandler = authorize - // >=> allowSyncIO - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let reqId = toReqId requestId - match! Data.tryRequestById reqId usrId sess with - | Some _ -> - let! until = ctx.BindJsonAsync () - Data.updateSnoozed reqId (Ticks until.until) sess - do! Data.saveChanges sess - return! setStatusCode 204 next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> task { + let db = db ctx + let usrId = userId ctx + let reqId = toReqId requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + let! until = ctx.BindJsonAsync () + do! Data.updateSnoozed reqId usrId (Ticks until.until) db + do! db.saveChanges () + return! setStatusCode 204 next ctx + | None -> return! Error.notFound next ctx + } /// PATCH /api/request/[req-id]/recurrence let updateRecurrence requestId : HttpHandler = authorize - // >=> allowSyncIO - >=> fun next ctx -> - task { - use sess = session ctx - let usrId = userId ctx - let reqId = toReqId requestId - match! Data.tryRequestById reqId usrId sess with - | Some _ -> - let! recur = ctx.BindJsonAsync () - let recurrence = Recurrence.fromString recur.recurType - Data.updateRecurrence reqId recurrence recur.recurCount sess - match recurrence with Immediate -> Data.updateShowAfter reqId (Ticks 0L) sess | _ -> () - do! Data.saveChanges sess - return! setStatusCode 204 next ctx - | None -> return! Error.notFound next ctx - } + >=> fun next ctx -> FSharp.Control.Tasks.Affine.task { + let db = db ctx + let usrId = userId ctx + let reqId = toReqId requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + let! recur = ctx.BindJsonAsync () + let recurrence = Recurrence.fromString recur.recurType + do! Data.updateRecurrence reqId usrId recurrence recur.recurCount db + match recurrence with + | Immediate -> do! Data.updateShowAfter reqId usrId (Ticks 0L) db + | _ -> () + do! db.saveChanges () + return! setStatusCode 204 next ctx + | None -> return! Error.notFound next ctx + } open Giraffe.EndpointRouting diff --git a/src/MyPrayerJournal/Api/MyPrayerJournal.Api.fsproj b/src/MyPrayerJournal/Api/MyPrayerJournal.Api.fsproj index bf6ade7..cb76930 100644 --- a/src/MyPrayerJournal/Api/MyPrayerJournal.Api.fsproj +++ b/src/MyPrayerJournal/Api/MyPrayerJournal.Api.fsproj @@ -1,29 +1,22 @@  - net6.0 3.0.0.0 - - + + - - - - - - - + \ No newline at end of file diff --git a/src/MyPrayerJournal/Api/Program.fs b/src/MyPrayerJournal/Api/Program.fs index 3efae6f..0837b40 100644 --- a/src/MyPrayerJournal/Api/Program.fs +++ b/src/MyPrayerJournal/Api/Program.fs @@ -8,140 +8,114 @@ open System.IO module Configure = /// Configure the content root - let contentRoot root (bldr : IWebHostBuilder) = - bldr.UseContentRoot root + let contentRoot root = + WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder + open Microsoft.Extensions.Configuration /// Configure the application configuration - let appConfiguration (bldr : IWebHostBuilder) = - let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = - cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) - .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) - .AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName) - .AddEnvironmentVariables () - |> ignore - bldr.ConfigureAppConfiguration configuration - + let appConfiguration (bldr : WebApplicationBuilder) = + bldr.Configuration + .SetBasePath(bldr.Environment.ContentRootPath) + .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) + .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json") + .AddEnvironmentVariables () + |> ignore + bldr + + open Microsoft.AspNetCore.Server.Kestrel.Core /// Configure Kestrel from appsettings.json - let kestrel (bldr : IWebHostBuilder) = + let kestrel (bldr : WebApplicationBuilder) = let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" - bldr.UseKestrel().ConfigureKestrel kestrelOpts + bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore + bldr + /// Configure the web root directory - let webRoot pathSegments (bldr : IWebHostBuilder) = - (Path.Combine >> bldr.UseWebRoot) pathSegments + let webRoot pathSegments (bldr : WebApplicationBuilder) = + Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ] + |> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore) + bldr - open Giraffe - open Microsoft.AspNetCore.Authentication.JwtBearer - open Microsoft.Extensions.DependencyInjection - open MyPrayerJournal.Indexes - open Newtonsoft.Json - open Newtonsoft.Json.Serialization - open Raven.Client.Documents - open Raven.Client.Documents.Indexes - open System.Security.Cryptography.X509Certificates - /// Configure dependency injection - let services (bldr : IWebHostBuilder) = - let svcs (sc : IServiceCollection) = - /// Custom settings for the JSON serializer (uses compact representation for options and DUs) - let jsonSettings = - let x = NewtonsoftJson.Serializer.DefaultSettings - Converters.all |> List.ofSeq |> List.iter x.Converters.Add - x.NullValueHandling <- NullValueHandling.Ignore - x.MissingMemberHandling <- MissingMemberHandling.Error - x.Formatting <- Formatting.Indented - x.ContractResolver <- DefaultContractResolver () - x - - use sp = sc.BuildServiceProvider () - let cfg = sp.GetRequiredService () - sc.AddRouting() - .AddGiraffe() - .AddAuthentication( - /// Use HTTP "Bearer" authentication with JWTs - fun opts -> - opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme - opts.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme) - .AddJwtBearer( - /// Configure JWT options with Auth0 options from configuration - fun opts -> - let jwtCfg = cfg.GetSection "Auth0" - opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"] - opts.Audience <- jwtCfg.["Id"] - ) - |> ignore - sc.AddSingleton (NewtonsoftJson.Serializer jsonSettings) - |> ignore - let config = sc.BuildServiceProvider().GetRequiredService().GetSection "RavenDB" - let store = new DocumentStore () - store.Urls <- [| config.["URL"] |] - store.Database <- config.["Database"] - match isNull config.["Certificate"] with - | true -> () - | false -> store.Certificate <- new X509Certificate2 (config.["Certificate"], config.["Password"]) - store.Conventions.CustomizeJsonSerializer <- fun x -> Converters.all |> List.ofSeq |> List.iter x.Converters.Add - store.Initialize () |> (sc.AddSingleton >> ignore) - IndexCreation.CreateIndexes (typeof.Assembly, store) - bldr.ConfigureServices svcs - open Microsoft.Extensions.Logging open Microsoft.Extensions.Hosting /// Configure logging - let logging (bldr : IWebHostBuilder) = - let logz (log : ILoggingBuilder) = - let env = log.Services.BuildServiceProvider().GetService () - match env.IsDevelopment () with - | true -> log - | false -> log.AddFilter(fun l -> l > LogLevel.Information) - |> function l -> l.AddConsole().AddDebug() - |> ignore - bldr.ConfigureLogging logz + let logging (bldr : WebApplicationBuilder) = + match bldr.Environment.IsDevelopment () with + | true -> () + | false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore + bldr.Logging.AddConsole().AddDebug() |> ignore + bldr + + + open Giraffe + open LiteDB + open Microsoft.AspNetCore.Authentication.JwtBearer + open Microsoft.Extensions.DependencyInjection + open System.Text.Json + open System.Text.Json.Serialization + + /// Configure dependency injection + let services (bldr : WebApplicationBuilder) = + bldr.Services + .AddRouting() + .AddGiraffe() + .AddAuthentication( + /// Use HTTP "Bearer" authentication with JWTs + fun opts -> + opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme + opts.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme) + .AddJwtBearer( + /// Configure JWT options with Auth0 options from configuration + fun opts -> + let jwtCfg = bldr.Configuration.GetSection "Auth0" + opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"] + opts.Audience <- jwtCfg.["Id"] + ) + |> ignore + let jsonOptions = JsonSerializerOptions () + jsonOptions.Converters.Add (JsonFSharpConverter ()) + bldr.Services.AddSingleton(jsonOptions) + .AddSingleton() + .AddSingleton(fun _ -> new LiteDatabase (bldr.Configuration.GetConnectionString "db")) + |> ignore + bldr.Build () + - open System open Giraffe.EndpointRouting /// Configure the web application - let application (bldr : IWebHostBuilder) = - let appConfig = - Action ( - fun (app : IApplicationBuilder) -> - let env = app.ApplicationServices.GetService () - match env.IsDevelopment () with - | true -> app.UseDeveloperExceptionPage () - | false -> app.UseGiraffeErrorHandler Handlers.Error.error - |> function - | a -> - a.UseAuthentication() - .UseStaticFiles() - .UseRouting() - .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) - |> ignore) - bldr.Configure appConfig + let application (app : WebApplication) = + match app.Environment.IsDevelopment () with + | true -> app.UseDeveloperExceptionPage () + | false -> app.UseGiraffeErrorHandler Handlers.Error.error + |> ignore + app.UseAuthentication() + .UseStaticFiles() + .UseRouting() + .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) + |> ignore + app /// Compose all the configurations into one - let webHost appRoot pathSegments = - contentRoot appRoot + let webHost pathSegments = + contentRoot >> appConfiguration >> kestrel - >> webRoot (Array.concat [ [| appRoot |]; pathSegments ]) - >> services + >> webRoot pathSegments >> logging + >> services >> application - /// Build the web host from the given configuration - let buildHost (bldr : IWebHostBuilder) = bldr.Build () - -let exitCode = 0 [] let main _ = - let appRoot = Directory.GetCurrentDirectory () - use host = WebHostBuilder() |> (Configure.webHost appRoot [| "wwwroot" |] >> Configure.buildHost) + use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) host.Run () - exitCode + 0