diff --git a/src/MyPrayerJournal.ConvertRecurrence/Program.fs b/src/MyPrayerJournal.ConvertRecurrence/Program.fs index 4522fef..1be0e70 100644 --- a/src/MyPrayerJournal.ConvertRecurrence/Program.fs +++ b/src/MyPrayerJournal.ConvertRecurrence/Program.fs @@ -81,13 +81,19 @@ let convertNote (old : OldNote) = Notes = old.notes } +/// Convert items that may be Instant.MinValue or Instant(0) to None +let noneIfOld ms = + match Instant.FromUnixTimeMilliseconds ms with + | instant when instant > Instant.FromUnixTimeMilliseconds 0 -> Some instant + | _ -> None + /// Map the old request to the new request let convert old = { Id = old.id EnteredOn = Instant.FromUnixTimeMilliseconds old.enteredOn UserId = old.userId - SnoozedUntil = Instant.FromUnixTimeMilliseconds old.snoozedUntil - ShowAfter = Instant.FromUnixTimeMilliseconds old.showAfter + SnoozedUntil = noneIfOld old.snoozedUntil + ShowAfter = noneIfOld old.showAfter Recurrence = mapRecurrence old History = old.history |> Array.map convertHistory |> List.ofArray Notes = old.notes |> Array.map convertNote |> List.ofArray @@ -95,8 +101,8 @@ let convert old = /// Remove the old request, add the converted one (removes recurType / recurCount fields) let replace (req : Request) = - db.requests.Delete (Mapping.RequestId.toBson req.Id) |> ignore - db.requests.Insert req |> ignore + db.Requests.Delete (Mapping.RequestId.toBson req.Id) |> ignore + db.Requests.Insert req |> ignore db.Checkpoint () db.GetCollection("request").FindAll () diff --git a/src/MyPrayerJournal/Data.fs b/src/MyPrayerJournal/Data.fs index 4afd347..6af5797 100644 --- a/src/MyPrayerJournal/Data.fs +++ b/src/MyPrayerJournal/Data.fs @@ -2,11 +2,7 @@ open LiteDB open MyPrayerJournal -open NodaTime open System.Threading.Tasks -open NodaTime.Text - -// fsharplint:disable MemberNames /// LiteDB extensions [] @@ -16,11 +12,10 @@ module Extensions = type LiteDatabase with /// The Request collection - member this.requests - with get () = this.GetCollection "request" + member this.Requests = this.GetCollection "request" /// Async version of the checkpoint command (flushes log) - member this.saveChanges () = + member this.SaveChanges () = this.Checkpoint () Task.CompletedTask @@ -30,6 +25,9 @@ module Extensions = [] module Mapping = + open NodaTime + open NodaTime.Text + /// A NodaTime instant pattern to use for parsing instants from the database let instantPattern = InstantPattern.CreateWithInvariantCulture "g" @@ -40,6 +38,9 @@ module Mapping = /// Mapping for option types module Option = + let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value) + let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null + let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" @@ -66,6 +67,7 @@ module Mapping = /// Set up the mapping let register () = BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) + BsonMapper.Global.RegisterType(Option.instantToBson, Option.instantFromBson) BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) @@ -77,7 +79,7 @@ module Startup = /// Ensure the database is set up let ensureDb (db : LiteDatabase) = - db.requests.EnsureIndex (fun it -> it.UserId) |> ignore + db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore Mapping.register () @@ -97,39 +99,42 @@ module private Helpers = /// Async wrapper around a request update let doUpdate (db : LiteDatabase) (req : Request) = - db.requests.Update req |> ignore + db.Requests.Update req |> ignore Task.CompletedTask /// Retrieve a request, including its history and notes, by its ID and user ID let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync + let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None } /// Add a history entry let addHistory reqId userId hist db = backgroundTask { match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with History = hist :: req.History } + | Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History } | None -> invalidOp $"{RequestId.toString reqId} not found" } /// Add a note let addNote reqId userId note db = backgroundTask { match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with Notes = note :: req.Notes } + | Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes } | None -> invalidOp $"{RequestId.toString reqId} not found" } /// Add a request let addRequest (req : Request) (db : LiteDatabase) = - db.requests.Insert req |> ignore + db.Requests.Insert req |> ignore -// FIXME: make a common function here +/// Find all requests for the given user +let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask { + return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync +} /// Retrieve all answered requests for the given user -let answeredRequests userId (db : LiteDatabase) = backgroundTask { - let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync +let answeredRequests userId db = backgroundTask { + let! reqs = getRequestsForUser userId db return reqs |> Seq.map JournalRequest.ofRequestFull @@ -139,10 +144,10 @@ let answeredRequests userId (db : LiteDatabase) = backgroundTask { } /// Retrieve the user's current journal -let journalByUserId userId (db : LiteDatabase) = backgroundTask { - let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync +let journalByUserId userId db = backgroundTask { + let! reqs = getRequestsForUser userId db return - jrnl + reqs |> Seq.map JournalRequest.ofRequestLite |> Seq.filter (fun it -> it.LastStatus <> Answered) |> Seq.sortBy (fun it -> it.AsOf) @@ -152,18 +157,18 @@ let journalByUserId userId (db : LiteDatabase) = backgroundTask { /// Does the user have any snoozed requests? let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { let! jrnl = journalByUserId userId db - return jrnl |> List.exists (fun r -> r.SnoozedUntil > now) + return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false) } /// Retrieve a request by its ID and user ID (without notes and history) let tryRequestById reqId userId db = backgroundTask { let! req = tryFullRequestById reqId userId db - return req |> Option.map (fun r -> { r with History = []; Notes = [] }) + return req |> Option.map (fun r -> { r with History = [||]; Notes = [||] }) } /// Retrieve notes for a request by its ID and user ID let notesById reqId userId (db : LiteDatabase) = backgroundTask { - match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [] + match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||] } /// Retrieve a journal request by its ID and user ID diff --git a/src/MyPrayerJournal/Domain.fs b/src/MyPrayerJournal/Domain.fs index 11fef56..b012da3 100644 --- a/src/MyPrayerJournal/Domain.fs +++ b/src/MyPrayerJournal/Domain.fs @@ -160,19 +160,19 @@ type Request = UserId : UserId /// The time at which this request should reappear in the user's journal by manual user choice - SnoozedUntil : Instant + SnoozedUntil : Instant option /// The time at which this request should reappear in the user's journal by recurrence - ShowAfter : Instant + ShowAfter : Instant option /// The recurrence for this request Recurrence : Recurrence /// The history entries for this request - History : History list + History : History[] /// The notes for this request - Notes : Note list + Notes : Note[] } /// Functions to support requests @@ -183,11 +183,11 @@ module Request = { Id = Cuid.generate () |> RequestId EnteredOn = Instant.MinValue UserId = UserId "" - SnoozedUntil = Instant.MinValue - ShowAfter = Instant.MinValue + SnoozedUntil = None + ShowAfter = None Recurrence = Immediate - History = [] - Notes = [] + History = [||] + Notes = [||] } @@ -211,10 +211,10 @@ type JournalRequest = LastStatus : RequestAction /// The time that this request should reappear in the user's journal - SnoozedUntil : Instant + SnoozedUntil : Instant option /// The time after which this request should reappear in the user's journal by configured recurrence - ShowAfter : Instant + ShowAfter : Instant option /// The recurrence for this request Recurrence : Recurrence @@ -231,17 +231,37 @@ module JournalRequest = /// Convert a request to the form used for the journal (precomputed values, no notes or history) let ofRequestLite (req : Request) = - let hist = req.History |> List.sortByDescending (fun it -> it.AsOf) |> List.tryHead + let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead + // Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the + // larger of either the last prayed date or the "show after" date; if neither of those are filled, we will use + // the last activity date. This will mean that: + // - Immediately shown requests will be at the top of the list, in order from least recently prayed to most. + // - Non-immediate requests will enter the list as if they were marked as prayed at that time; this will put + // them at the bottom of the list. + // - New requests will go to the bottom of the list, but will rise as others are marked as prayed. + let lastActivity = lastHistory |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue + let lastPrayed = + req.History + |> Array.sortByDescending (fun it -> it.AsOf) + |> Array.filter History.isPrayed + |> Array.tryHead + |> Option.map (fun it -> it.AsOf) + |> Option.defaultValue Instant.MinValue + let showAfter = defaultArg req.ShowAfter Instant.MinValue + let asOf = + if lastPrayed > showAfter then lastPrayed + elif showAfter > lastPrayed then showAfter + else lastActivity { RequestId = req.Id UserId = req.UserId Text = req.History - |> List.filter (fun it -> Option.isSome it.Text) - |> List.sortByDescending (fun it -> it.AsOf) - |> List.tryHead + |> Array.filter (fun it -> Option.isSome it.Text) + |> Array.sortByDescending (fun it -> it.AsOf) + |> Array.tryHead |> Option.map (fun h -> Option.get h.Text) |> Option.defaultValue "" - AsOf = match hist with Some h -> h.AsOf | None -> Instant.MinValue - LastStatus = match hist with Some h -> h.Status | None -> Created + AsOf = asOf + LastStatus = match lastHistory with Some h -> h.Status | None -> Created SnoozedUntil = req.SnoozedUntil ShowAfter = req.ShowAfter Recurrence = req.Recurrence @@ -252,6 +272,6 @@ module JournalRequest = /// Same as `ofRequestLite`, but with notes and history let ofRequestFull req = { ofRequestLite req with - History = req.History - Notes = req.Notes + History = List.ofArray req.History + Notes = List.ofArray req.Notes } diff --git a/src/MyPrayerJournal/Handlers.fs b/src/MyPrayerJournal/Handlers.fs index 16fc0b0..4a5d0ea 100644 --- a/src/MyPrayerJournal/Handlers.fs +++ b/src/MyPrayerJournal/Handlers.fs @@ -2,22 +2,18 @@ [] module MyPrayerJournal.Handlers -// fsharplint:disable RecordFieldNames - open Giraffe open Giraffe.Htmx -open Microsoft.AspNetCore.Authentication -open Microsoft.AspNetCore.Http open System -open System.Security.Claims -open NodaTime /// Helper function to be able to split out log on [] module private LogOnHelpers = + open Microsoft.AspNetCore.Authentication + /// Log on, optionally specifying a redirected URL once authentication is complete - let logOn url : HttpHandler = fun next ctx -> backgroundTask { + let logOn url : HttpHandler = fun next ctx -> task { match url with | Some it -> do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) @@ -30,7 +26,6 @@ module private LogOnHelpers = module Error = open Microsoft.Extensions.Logging - open System.Threading.Tasks /// Handle errors let error (ex : Exception) (log : ILogger) = @@ -42,52 +37,59 @@ module Error = /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response let notAuthorized : HttpHandler = fun next ctx -> - (next, ctx) - ||> match ctx.Request.Method with - | "GET" -> logOn None - | _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult None + (if ctx.Request.Method = "GET" then logOn None next else setStatusCode 401 earlyReturn) ctx /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there let notFound : HttpHandler = setStatusCode 404 >=> text "Not found" -/// Handler helpers -[] -module private Helpers = - - open LiteDB - open Microsoft.Extensions.Logging - open Microsoft.Net.Http.Headers +open System.Security.Claims +open LiteDB +open Microsoft.AspNetCore.Http +open NodaTime - let debug (ctx : HttpContext) message = - let fac = ctx.GetService() - let log = fac.CreateLogger "Debug" - log.LogInformation message - - /// Get the LiteDB database - let db (ctx : HttpContext) = ctx.GetService() - - /// Get the user's "sub" claim - let user (ctx : HttpContext) = - ctx.User +/// 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 |> Option.ofObj |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)) |> Option.flatten |> Option.map (fun claim -> claim.Value) + + /// The current user's ID + // NOTE: this may raise if you don't run the request through the requireUser handler first + member this.UserId = UserId this.CurrentUser.Value + + /// The system clock + member this.Clock = this.GetService () + + /// Get the current instant from the system clock + member this.Now = this.Clock.GetCurrentInstant - /// Get the current user's ID - // NOTE: this may raise if you don't run the request through the requiresAuthentication handler first - let userId ctx = - (user >> Option.get) ctx |> UserId - /// Get the system clock - let clock (ctx : HttpContext) = - ctx.GetService () +/// Handler helpers +[] +module private Helpers = - /// Get the current instant - let now ctx = - (clock ctx).GetCurrentInstant () + open Microsoft.Extensions.Logging + open Microsoft.Net.Http.Headers + + /// Require a user to be logged on + let requireUser : HttpHandler = + requiresAuthentication Error.notAuthorized + + /// Debug logger + let debug (ctx : HttpContext) message = + let fac = ctx.GetService () + let log = fac.CreateLogger "Debug" + log.LogInformation message /// Return a 201 CREATED response let created = @@ -110,21 +112,21 @@ module private Helpers = } open Views.Layout - + open System.Threading.Tasks + /// Create a page rendering context let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { - let! hasSnoozed = backgroundTask { - match user ctx with - | Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx) - | None -> return false - } - return { - isAuthenticated = (user >> Option.isSome) ctx - hasSnoozed = hasSnoozed - currentUrl = ctx.Request.Path.Value - pageTitle = pageTitle - content = content - } + let! hasSnoozed = + match ctx.CurrentUser with + | Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db + | None -> Task.FromResult false + return + { IsAuthenticated = Option.isSome ctx.CurrentUser + HasSnoozed = hasSnoozed + CurrentUrl = ctx.Request.Path.Value + PageTitle = pageTitle + Content = content + } } /// Composable handler to write a view to the output @@ -137,18 +139,18 @@ module private Helpers = module Messages = /// The messages being held - let mutable private messages : Map = Map.empty + let mutable private messages : Map = Map.empty /// Locked update to prevent updates by multiple threads let private upd8 = obj () /// Push a new message into the list - let push ctx message url = lock upd8 (fun () -> - messages <- messages.Add (ctx |> (user >> Option.get), (message, url))) + let push (ctx : HttpContext) message url = lock upd8 (fun () -> + messages <- messages.Add (ctx.UserId, (message, url))) /// Add a success message header to the response let pushSuccess ctx message url = - push ctx $"success|||{message}" url + push ctx $"success|||%s{message}" url /// Pop the messages for the given user let pop userId = lock upd8 (fun () -> @@ -157,15 +159,15 @@ module private Helpers = 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 -> backgroundTask { + let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task { let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh let! pageCtx = pageContext ctx pageTitle content let view = (match isPartial with true -> partial | false -> view) pageCtx return! (next, ctx) - ||> match user ctx with - | Some u -> - match Messages.pop u with + ||> match ctx.CurrentUser with + | Some _ -> + match Messages.pop ctx.UserId with | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> writeView view | None -> writeView view | None -> writeView view @@ -234,35 +236,40 @@ open NodaTime.Text module Components = // GET /components/journal-items - let journalItems : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let now = now ctx - let! jrnl = Data.journalByUserId (userId ctx) (db ctx) - let shown = jrnl |> List.filter (fun it -> now > it.SnoozedUntil && now > it.ShowAfter) + let journalItems : HttpHandler = requireUser >=> fun next ctx -> task { + let now = ctx.Now () + let shouldBeShown (req : JournalRequest) = + match req.SnoozedUntil, req.ShowAfter with + | None, None -> true + | Some snooze, Some hide when snooze < now && hide < now -> true + | Some snooze, _ when snooze < now -> true + | _, Some hide when hide < now -> true + | _, _ -> false + let! journal = Data.journalByUserId ctx.UserId ctx.Db + let shown = journal |> List.filter shouldBeShown return! renderComponent [ Views.Journal.journalItems now shown ] next ctx } // GET /components/request-item/[req-id] - let requestItem reqId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with - | Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx + let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task { + match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with + | Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) req ] next ctx | None -> return! Error.notFound next ctx } // GET /components/request/[req-id]/add-notes let addNotes requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId)) + requireUser >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId)) // GET /components/request/[req-id]/notes - let notes requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) - return! renderComponent (Views.Request.notes (now ctx) notes) next ctx + let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db + return! renderComponent (Views.Request.notes (ctx.Now ()) (List.ofArray notes)) next ctx } // GET /components/request/[req-id]/snooze let snooze requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ] + requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ] /// / URL @@ -277,7 +284,7 @@ module Home = module Journal = // GET /journal - let journal : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let journal : HttpHandler = requireUser >=> fun next ctx -> task { let usr = ctx.User.Claims |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName) @@ -304,7 +311,7 @@ module Legal = module Request = // GET /request/[req-id]/edit - let edit requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let edit requestId : HttpHandler = requireUser >=> fun next ctx -> task { let returnTo = match ctx.Request.Headers.Referer[0] with | it when it.EndsWith "/active" -> "active" @@ -315,7 +322,7 @@ module Request = return! partial "Add Prayer Request" (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx | _ -> - match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with + match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with | Some req -> debug ctx "Found - sending view" return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx @@ -325,92 +332,93 @@ module Request = } // PATCH /request/[req-id]/prayed - let prayed requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with + let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let db = ctx.Db + let userId = ctx.UserId + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId userId db with | Some req -> - let now = now ctx - do! Data.addHistory reqId usrId { AsOf = now; Status = Prayed; Text = None } db + let now = ctx.Now () + do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db let nextShow = match Recurrence.duration req.Recurrence with - | 0L -> Instant.MinValue - | duration -> now.Plus (Duration.FromSeconds duration) - do! Data.updateShowAfter reqId usrId nextShow db - do! db.saveChanges () + | 0L -> None + | duration -> Some <| now.Plus (Duration.FromSeconds duration) + do! Data.updateShowAfter reqId userId nextShow db + do! db.SaveChanges () return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx | None -> return! Error.notFound next ctx } /// POST /request/[req-id]/note - let addNote requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with + let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let db = ctx.Db + let userId = ctx.UserId + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId userId db with | Some _ -> let! notes = ctx.BindFormAsync () - do! Data.addNote reqId usrId { AsOf = now ctx; Notes = notes.notes } db - do! db.saveChanges () + do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db + do! db.SaveChanges () return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx | None -> return! Error.notFound next ctx } // GET /requests/active - let active : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! reqs = Data.journalByUserId (userId ctx) (db ctx) - return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx + let active : HttpHandler = requireUser >=> fun next ctx -> task { + let! reqs = Data.journalByUserId ctx.UserId ctx.Db + return! partial "Active Requests" (Views.Request.active (ctx.Now ()) reqs) next ctx } // GET /requests/snoozed - let snoozed : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! reqs = Data.journalByUserId (userId ctx) (db ctx) - let now = now ctx - let snoozed = reqs |> List.filter (fun it -> it.SnoozedUntil > now) - return! partial "Active Requests" (Views.Request.snoozed now snoozed) next ctx + let snoozed : HttpHandler = requireUser >=> fun next ctx -> task { + let! reqs = Data.journalByUserId ctx.UserId ctx.Db + let now = ctx.Now () + let snoozed = reqs + |> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false) + return! partial "Snoozed Requests" (Views.Request.snoozed now snoozed) next ctx } // GET /requests/answered - let answered : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! reqs = Data.answeredRequests (userId ctx) (db ctx) - return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx + let answered : HttpHandler = requireUser >=> fun next ctx -> task { + let! reqs = Data.answeredRequests ctx.UserId ctx.Db + return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) reqs) next ctx } // GET /request/[req-id]/full - let getFull requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with - | Some req -> return! partial "Prayer Request" (Views.Request.full (clock ctx) req) next ctx + let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task { + match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with + | Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock req) next ctx | None -> return! Error.notFound next ctx } // PATCH /request/[req-id]/show - let show requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with + let show requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let db = ctx.Db + let userId = ctx.UserId + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId userId db with | Some _ -> - do! Data.updateShowAfter reqId usrId Instant.MinValue db - do! db.saveChanges () + do! Data.updateShowAfter reqId userId None db + do! db.SaveChanges () return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx | None -> return! Error.notFound next ctx } // PATCH /request/[req-id]/snooze - let snooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with + let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let db = ctx.Db + let userId = ctx.UserId + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId userId db with | Some _ -> let! until = ctx.BindFormAsync () let date = LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value .AtStartOfDayInZone(DateTimeZone.Utc) .ToInstant () - do! Data.updateSnoozed reqId usrId date db - do! db.saveChanges () + do! Data.updateSnoozed reqId userId (Some date) db + do! db.SaveChanges () return! (withSuccessMessage $"Request snoozed until {until.until}" >=> hideModal "snooze" @@ -419,14 +427,14 @@ module Request = } // PATCH /request/[req-id]/cancel-snooze - let cancelSnooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with + let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task { + let db = ctx.Db + let userId = ctx.UserId + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId userId db with | Some _ -> - do! Data.updateSnoozed reqId usrId Instant.MinValue db - do! db.saveChanges () + do! Data.updateSnoozed reqId userId None db + do! db.SaveChanges () return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx | None -> return! Error.notFound next ctx } @@ -437,52 +445,52 @@ module Request = |> Recurrence.ofString // POST /request - let add : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! form = ctx.BindModelAsync () - let db = db ctx - let usrId = userId ctx - let now = now ctx - let req = + 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 = { Request.empty with - UserId = usrId + UserId = userId EnteredOn = now - ShowAfter = Instant.MinValue + ShowAfter = None Recurrence = parseRecurrence form - History = [ + History = [| { AsOf = now Status = Created Text = Some form.requestText } - ] + |] } Data.addRequest req db - do! db.saveChanges () + do! db.SaveChanges () Messages.pushSuccess ctx "Added prayer request" "/journal" return! seeOther "/journal" next ctx } // PATCH /request - let update : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { - let! form = ctx.BindModelAsync () - let db = db ctx - let usrId = userId ctx - match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with + let update : HttpHandler = requireUser >=> fun next ctx -> task { + let! form = ctx.BindModelAsync () + let db = ctx.Db + let userId = ctx.UserId + match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with | Some req -> // update recurrence if changed let recur = parseRecurrence form match recur = req.Recurrence with | true -> () | false -> - do! Data.updateRecurrence req.RequestId usrId recur db + do! Data.updateRecurrence req.RequestId userId recur db match recur with - | Immediate -> do! Data.updateShowAfter req.RequestId usrId Instant.MinValue db + | Immediate -> do! Data.updateShowAfter req.RequestId userId None db | _ -> () // append history let upd8Text = form.requestText.Trim () - let text = match upd8Text = req.Text with true -> None | false -> Some upd8Text - do! Data.addHistory req.RequestId usrId - { AsOf = now ctx; Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db - do! db.saveChanges () + let text = if upd8Text = req.Text then None else Some upd8Text + do! Data.addHistory req.RequestId userId + { AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db + do! db.SaveChanges () let nextUrl = match form.returnTo with | "active" -> "/requests/active" @@ -497,6 +505,7 @@ module Request = /// Handlers for /user URLs module User = + open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication.Cookies // GET /user/log-on @@ -504,7 +513,7 @@ module User = logOn (Some "/journal") // GET /user/log-off - let logOff : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> task { + let logOff : HttpHandler = requireUser >=> fun next ctx -> task { do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/")) do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme return! next ctx diff --git a/src/MyPrayerJournal/Program.fs b/src/MyPrayerJournal/Program.fs index b5ea843..f2ea129 100644 --- a/src/MyPrayerJournal/Program.fs +++ b/src/MyPrayerJournal/Program.fs @@ -7,174 +7,162 @@ open System.IO /// Configuration functions for the application module Configure = - /// Configure the content root - let contentRoot root = - WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder + /// Configure the content root + let contentRoot root = + WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder - open Microsoft.Extensions.Configuration + open Microsoft.Extensions.Configuration - /// Configure the application configuration - let appConfiguration (bldr : WebApplicationBuilder) = - bldr.Configuration - .SetBasePath(bldr.Environment.ContentRootPath) - .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) - .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true) - .AddEnvironmentVariables () - |> ignore - bldr + /// Configure the application configuration + let appConfiguration (bldr : WebApplicationBuilder) = + bldr.Configuration + .SetBasePath(bldr.Environment.ContentRootPath) + .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) + .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true) + .AddEnvironmentVariables () + |> ignore + bldr - open Microsoft.AspNetCore.Server.Kestrel.Core + open Microsoft.AspNetCore.Server.Kestrel.Core - /// Configure Kestrel from appsettings.json - let kestrel (bldr : WebApplicationBuilder) = - let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = - (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" - bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore - bldr + /// Configure Kestrel from appsettings.json + let kestrel (bldr : WebApplicationBuilder) = + let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = + (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" + bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore + bldr - /// Configure the web root directory - let webRoot pathSegments (bldr : WebApplicationBuilder) = - Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ] - |> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore) - bldr + /// Configure the web root directory + let webRoot pathSegments (bldr : WebApplicationBuilder) = + Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ] + |> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore) + bldr - open Microsoft.Extensions.Logging - open Microsoft.Extensions.Hosting + open Microsoft.Extensions.Logging + open Microsoft.Extensions.Hosting - /// Configure logging - 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 + /// Configure logging + let logging (bldr : WebApplicationBuilder) = + if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore + bldr.Logging.AddConsole().AddDebug() |> ignore + bldr - 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 NodaTime - open System - open System.Text.Json - open System.Text.Json.Serialization - open System.Threading.Tasks + 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 NodaTime + open System + open System.Text.Json + open System.Text.Json.Serialization + open System.Threading.Tasks - /// Configure dependency injection - let services (bldr : WebApplicationBuilder) = - let sameSite (opts : CookieOptions) = - match opts.SameSite, opts.Secure with - | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified - | _, _ -> () + /// Configure dependency injection + let services (bldr : WebApplicationBuilder) = + let sameSite (opts : CookieOptions) = + match opts.SameSite, opts.Secure with + | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified + | _, _ -> () - bldr.Services - .AddRouting() - .AddGiraffe() - .AddSingleton(SystemClock.Instance) - .Configure( - fun (opts : CookiePolicyOptions) -> - opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified - opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions - opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions) - .AddAuthentication( - // Use HTTP "Bearer" authentication with JWTs - fun opts -> - opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme - opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme - opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme) - .AddCookie() - .AddOpenIdConnect("Auth0", - // Configure OIDC with Auth0 options from configuration - fun opts -> - let cfg = bldr.Configuration.GetSection "Auth0" - opts.Authority <- $"""https://{cfg["Domain"]}/""" - opts.ClientId <- cfg["Id"] - opts.ClientSecret <- cfg["Secret"] - opts.ResponseType <- OpenIdConnectResponseType.Code - - opts.Scope.Clear () - opts.Scope.Add "openid" - opts.Scope.Add "profile" - - opts.CallbackPath <- PathString "/user/log-on/success" - opts.ClaimsIssuer <- "Auth0" - opts.SaveTokens <- true - - opts.Events <- OpenIdConnectEvents () - opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> - let returnTo = - match ctx.Properties.RedirectUri with - | it when isNull it || it = "" -> "" - | redirUri -> - let finalRedirUri = - match redirUri.StartsWith "/" with - | true -> - // transform to absolute - let request = ctx.Request - $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}" - | false -> redirUri - Uri.EscapeDataString $"&returnTo={finalRedirUri}" - ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}""" - ctx.HandleResponse () - - Task.CompletedTask - opts.Events.OnRedirectToIdentityProvider <- fun ctx -> - let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri - bldr.Scheme <- cfg["Scheme"] - bldr.Port <- int cfg["Port"] - ctx.ProtocolMessage.RedirectUri <- string bldr - Task.CompletedTask - ) - |> ignore - let jsonOptions = JsonSerializerOptions () - jsonOptions.Converters.Add (JsonFSharpConverter ()) - let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db") - Data.Startup.ensureDb db - bldr.Services.AddSingleton(jsonOptions) - .AddSingleton() - .AddSingleton db - |> ignore - bldr.Build () + let _ = bldr.Services.AddRouting () + let _ = bldr.Services.AddGiraffe () + let _ = bldr.Services.AddSingleton(SystemClock.Instance) + + let _ = + bldr.Services.Configure(fun (opts : CookiePolicyOptions) -> + opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified + opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions + opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions) + let _ = + bldr.Services.AddAuthentication(fun opts -> + opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme + opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme + opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme) + .AddCookie() + .AddOpenIdConnect("Auth0", fun opts -> + // Configure OIDC with Auth0 options from configuration + let cfg = bldr.Configuration.GetSection "Auth0" + opts.Authority <- $"""https://{cfg["Domain"]}/""" + opts.ClientId <- cfg["Id"] + opts.ClientSecret <- cfg["Secret"] + opts.ResponseType <- OpenIdConnectResponseType.Code + + opts.Scope.Clear () + opts.Scope.Add "openid" + opts.Scope.Add "profile" + + opts.CallbackPath <- PathString "/user/log-on/success" + opts.ClaimsIssuer <- "Auth0" + opts.SaveTokens <- true + + opts.Events <- OpenIdConnectEvents () + opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> + let returnTo = + match ctx.Properties.RedirectUri with + | it when isNull it || it = "" -> "" + | redirUri -> + let finalRedirUri = + match redirUri.StartsWith "/" with + | true -> + // transform to absolute + let request = ctx.Request + $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}" + | false -> redirUri + Uri.EscapeDataString $"&returnTo={finalRedirUri}" + ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}""" + ctx.HandleResponse () + Task.CompletedTask + opts.Events.OnRedirectToIdentityProvider <- fun ctx -> + let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri + bldr.Scheme <- cfg["Scheme"] + bldr.Port <- int cfg["Port"] + ctx.ProtocolMessage.RedirectUri <- string bldr + Task.CompletedTask) + + let jsonOptions = JsonSerializerOptions () + jsonOptions.Converters.Add (JsonFSharpConverter ()) + let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db") + Data.Startup.ensureDb db + let _ = bldr.Services.AddSingleton jsonOptions + let _ = bldr.Services.AddSingleton () + let _ = bldr.Services.AddSingleton db + + bldr.Build () - open Giraffe.EndpointRouting + open Giraffe.EndpointRouting - /// Configure the web application - let application (app : WebApplication) = - // match app.Environment.IsDevelopment () with - // | true -> app.UseDeveloperExceptionPage () - // | false -> app.UseGiraffeErrorHandler Handlers.Error.error - // |> ignore - app - .UseStaticFiles() - .UseCookiePolicy() - .UseRouting() - .UseAuthentication() - .UseGiraffeErrorHandler(Handlers.Error.error) - .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) - |> ignore - app + /// Configure the web application + let application (app : WebApplication) = + let _ = app.UseStaticFiles () + let _ = app.UseCookiePolicy () + let _ = app.UseRouting () + let _ = app.UseAuthentication () + let _ = app.UseGiraffeErrorHandler Handlers.Error.error + let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) + app - /// Compose all the configurations into one - let webHost pathSegments = - contentRoot - >> appConfiguration - >> kestrel - >> webRoot pathSegments - >> logging - >> services - >> application + /// Compose all the configurations into one + let webHost pathSegments = + contentRoot + >> appConfiguration + >> kestrel + >> webRoot pathSegments + >> logging + >> services + >> application [] let main _ = - use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) - host.Run () - 0 + use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) + host.Run () + 0 diff --git a/src/MyPrayerJournal/Views/Layout.fs b/src/MyPrayerJournal/Views/Layout.fs index 49ef3d8..202714b 100644 --- a/src/MyPrayerJournal/Views/Layout.fs +++ b/src/MyPrayerJournal/Views/Layout.fs @@ -1,27 +1,25 @@ /// Layout / home views module MyPrayerJournal.Views.Layout -// fsharplint:disable RecordFieldNames - open Giraffe.ViewEngine open Giraffe.ViewEngine.Accessibility /// The data needed to render a page-level view type PageRenderContext = { /// Whether the user is authenticated - isAuthenticated : bool + IsAuthenticated : bool /// Whether the user has snoozed requests - hasSnoozed : bool + HasSnoozed : bool /// The current URL - currentUrl : string + CurrentUrl : string /// The title for the page to be rendered - pageTitle : string + PageTitle : string /// The content of the page - content : XmlNode + Content : XmlNode } /// The home page @@ -51,12 +49,12 @@ let private navBar ctx = ] seq { let navLink (matchUrl : string) = - match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> [] + match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> [] |> pageLink matchUrl - if ctx.isAuthenticated then + if ctx.IsAuthenticated then li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] - if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ] + if ctx.HasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ] li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ] li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] @@ -71,7 +69,7 @@ let private navBar ctx = /// The title tag with the application name appended let titleTag ctx = - title [] [ str ctx.pageTitle; rawText " « myPrayerJournal" ] + title [] [ str ctx.PageTitle; rawText " « myPrayerJournal" ] /// The HTML `head` element let htmlHead ctx = @@ -136,7 +134,7 @@ let view ctx = html [ _lang "en" ] [ htmlHead ctx body [] [ - section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] + section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] toaster htmlFoot ] @@ -146,5 +144,5 @@ let view ctx = let partial ctx = html [ _lang "en" ] [ head [] [ titleTag ctx ] - body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] + body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] ] diff --git a/src/MyPrayerJournal/Views/Request.fs b/src/MyPrayerJournal/Views/Request.fs index 472a615..d7df748 100644 --- a/src/MyPrayerJournal/Views/Request.fs +++ b/src/MyPrayerJournal/Views/Request.fs @@ -8,10 +8,11 @@ open NodaTime /// Create a request within the list let reqListItem now req = + let isFuture instant = defaultArg (instant |> Option.map (fun it -> it > now)) false let reqId = RequestId.toString req.RequestId let isAnswered = req.LastStatus = Answered - let isSnoozed = req.SnoozedUntil > now - let isPending = (not isSnoozed) && req.ShowAfter > now + let isSnoozed = isFuture req.SnoozedUntil + let isPending = (not isSnoozed) && isFuture req.ShowAfter let btnClass = _class "btn btn-light mx-2" let restoreBtn (link : string) title = button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ] @@ -27,9 +28,9 @@ let reqListItem now req = if isSnoozed || isPending || isAnswered then br [] small [ _class "text-muted" ] [ - if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil now ] - elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter now ] - else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now ] + if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil.Value now ] + elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter.Value now ] + else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now ] |> em [] ] ] @@ -56,7 +57,7 @@ let answered now reqs = article [ _class "container mt-3" ] [ h2 [ _class "pb-3" ] [ str "Answered Requests" ] if List.isEmpty reqs then - noResults "No Active Requests" "/journal" "Return to your journal" [ + noResults "No Answered Requests" "/journal" "Return to your journal" [ str "Your prayer journal has no answered requests; once you have marked one as " rawText "“Answered”, it will appear here" ] @@ -75,29 +76,30 @@ let full (clock : IClock) (req : Request) = let now = clock.GetCurrentInstant () let answered = req.History - |> List.filter History.isAnswered - |> List.tryHead + |> Array.filter History.isAnswered + |> Array.tryHead |> Option.map (fun x -> x.AsOf) - let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0" + let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0" let daysOpen = let asOf = defaultArg answered now - ((asOf - (req.History |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0" + ((asOf - (req.History |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0" let lastText = req.History - |> List.filter (fun h -> Option.isSome h.Text) - |> List.sortByDescending (fun h -> h.AsOf) - |> List.map (fun h -> Option.get h.Text) - |> List.head + |> Array.filter (fun h -> Option.isSome h.Text) + |> Array.sortByDescending (fun h -> h.AsOf) + |> Array.map (fun h -> Option.get h.Text) + |> Array.head // The history log including notes (and excluding the final entry for answered requests) let log = let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |} let all = req.Notes - |> List.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) - |> List.append (req.History |> List.map toDisp) - |> List.sortByDescending (fun it -> it.asOf) + |> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) + |> Array.append (req.History |> Array.map toDisp) + |> Array.sortByDescending (fun it -> it.asOf) + |> List.ofArray // Skip the first entry for answered requests; that info is already displayed - match answered with Some _ -> all |> List.skip 1 | None -> all + match answered with Some _ -> all.Tail | None -> all article [ _class "container mt-3" ] [ div [_class "card" ] [ h5 [ _class "card-header" ] [ str "Full Prayer Request" ] @@ -111,7 +113,7 @@ let full (clock : IClock) (req : Request) = relativeDate date now rawText ") • " | None -> () - sprintf "Prayed %s times • Open %s days" prayed daysOpen |> rawText + rawText $"Prayed %s{prayed} times • Open %s{daysOpen} days" ] p [ _class "card-text" ] [ str lastText ] ]