Version 3 #67

Merged
danieljsummers merged 53 commits from version-3 into master 2021-10-26 23:39:59 +00:00
12 changed files with 137 additions and 135 deletions
Showing only changes of commit 619c94f5ed - Show all commits

View File

@ -12,10 +12,11 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.Data" Version="4.2.3" /> <PackageReference Include="FSharp.Data" Version="4.2.3" />
<PackageReference Include="LiteDB" Version="5.0.11" /> <PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\Api\MyPrayerJournal.Api.fsproj" /> <ProjectReference Include="..\Server\MyPrayerJournal.Server.fsproj" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@ -2,6 +2,7 @@
open FSharp.Data.CsvExtensions open FSharp.Data.CsvExtensions
open LiteDB open LiteDB
open MyPrayerJournal.Domain open MyPrayerJournal.Domain
open NodaTime
module Subdocs = module Subdocs =
@ -12,8 +13,8 @@ module Subdocs =
| JsonValue.Array hist -> | JsonValue.Array hist ->
hist hist
|> Array.map (fun h -> |> Array.map (fun h ->
{ asOf = h?asOf.AsInteger64 () |> Ticks { asOf = (h?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
status = h?status.AsString () |> RequestAction.fromString status = h?status.AsString () |> RequestAction.ofString
text = match h?text.AsString () with "" -> None | txt -> Some txt text = match h?text.AsString () with "" -> None | txt -> Some txt
}) })
|> List.ofArray |> List.ofArray
@ -24,7 +25,7 @@ module Subdocs =
| JsonValue.Array notes -> | JsonValue.Array notes ->
notes notes
|> Array.map (fun n -> |> Array.map (fun n ->
{ asOf = n?asOf.AsInteger64 () |> Ticks { asOf = (n?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
notes = n?notes.AsString () notes = n?notes.AsString ()
}) })
|> List.ofArray |> List.ofArray
@ -39,12 +40,12 @@ MyPrayerJournal.Data.Startup.ensureDb db
let migrated = let migrated =
oldData.Rows oldData.Rows
|> Seq.map (fun r -> |> Seq.map (fun r ->
{ id = r.["@id"].Replace ("Requests/", "") |> RequestId.ofString { id = r["@id"].Replace ("Requests/", "") |> RequestId.ofString
enteredOn = r?enteredOn.AsInteger64 () |> Ticks enteredOn = (r?enteredOn.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
userId = UserId r?userId userId = UserId r?userId
snoozedUntil = r?snoozedUntil.AsInteger64 () |> Ticks snoozedUntil = (r?snoozedUntil.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
showAfter = r?showAfter.AsInteger64 () |> Ticks showAfter = (r?showAfter.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
recurType = r?recurType |> Recurrence.fromString recurType = r?recurType |> Recurrence.ofString
recurCount = (r?recurCount.AsInteger >> int16) () recurCount = (r?recurCount.AsInteger >> int16) ()
history = Subdocs.history r?history history = Subdocs.history r?history
notes = Subdocs.notes r?notes notes = Subdocs.notes r?notes

View File

@ -1,6 +1,7 @@
module MyPrayerJournal.Data module MyPrayerJournal.Data
open LiteDB open LiteDB
open NodaTime
open System open System
open System.Threading.Tasks open System.Threading.Tasks
@ -29,14 +30,14 @@ module Mapping =
/// Map a history entry to BSON /// Map a history entry to BSON
let historyToBson (hist : History) : BsonValue = let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc["asOf"] <- Ticks.toLong hist.asOf doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> "" doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc upcast doc
/// Map a BSON document to a history entry /// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) = let historyFromBson (doc : BsonValue) =
{ asOf = Ticks doc["asOf"].AsInt64 { asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt text = match doc["text"].AsString with "" -> None | txt -> Some txt
} }
@ -44,13 +45,13 @@ module Mapping =
/// Map a note entry to BSON /// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue = let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc["asOf"] <- Ticks.toLong note.asOf doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds ()
doc["notes"] <- note.notes doc["notes"] <- note.notes
upcast doc upcast doc
/// Map a BSON document to a note entry /// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) = let noteFromBson (doc : BsonValue) =
{ asOf = Ticks doc["asOf"].AsInt64 { asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
notes = doc["notes"].AsString notes = doc["notes"].AsString
} }
@ -58,10 +59,10 @@ module Mapping =
let requestToBson req : BsonValue = let requestToBson req : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- Ticks.toLong req.enteredOn doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- Ticks.toLong req.snoozedUntil doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- Ticks.toLong req.showAfter doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList) doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
@ -71,10 +72,10 @@ module Mapping =
/// Map a BSON document to a request /// Map a BSON document to a request
let requestFromBson (doc : BsonValue) = let requestFromBson (doc : BsonValue) =
{ id = RequestId.ofString doc["_id"].AsString { id = RequestId.ofString doc["_id"].AsString
enteredOn = Ticks doc["enteredOn"].AsInt64 enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString userId = UserId doc["userId"].AsString
snoozedUntil = Ticks doc["snoozedUntil"].AsInt64 snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Ticks doc["showAfter"].AsInt64 showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc["recurType"].AsString recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc["recurCount"].AsInt32 recurCount = int16 doc["recurCount"].AsInt32
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
@ -139,6 +140,8 @@ let addNote reqId userId note db = backgroundTask {
let addRequest (req : Request) (db : LiteDatabase) = let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore db.requests.Insert req |> ignore
// FIXME: make a common function here
/// Retrieve all answered requests for the given user /// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = backgroundTask { let answeredRequests userId (db : LiteDatabase) = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
@ -146,7 +149,7 @@ let answeredRequests userId (db : LiteDatabase) = backgroundTask {
reqs reqs
|> Seq.map JournalRequest.ofRequestFull |> Seq.map JournalRequest.ofRequestFull
|> Seq.filter (fun it -> it.lastStatus = Answered) |> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf) |> Seq.sortByDescending (fun it -> it.asOf)
|> List.ofSeq |> List.ofSeq
} }
@ -157,14 +160,14 @@ let journalByUserId userId (db : LiteDatabase) = backgroundTask {
jrnl jrnl
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.lastStatus <> Answered) |> Seq.filter (fun it -> it.lastStatus <> Answered)
|> Seq.sortBy (fun it -> Ticks.toLong it.asOf) |> Seq.sortBy (fun it -> it.asOf)
|> List.ofSeq |> List.ofSeq
} }
/// Does the user have any snoozed requests? /// Does the user have any snoozed requests?
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
let! jrnl = journalByUserId userId db let! jrnl = journalByUserId userId db
return jrnl |> List.exists (fun r -> Ticks.toLong r.snoozedUntil > Ticks.toLong now) return jrnl |> List.exists (fun r -> r.snoozedUntil > now)
} }
/// Retrieve a request by its ID and user ID (without notes and history) /// Retrieve a request by its ID and user ID (without notes and history)

View File

@ -2,6 +2,7 @@
// Many thanks to date-fns (https://date-fns.org) for this logic // Many thanks to date-fns (https://date-fns.org) for this logic
module MyPrayerJournal.Dates module MyPrayerJournal.Dates
open NodaTime
type internal FormatDistanceToken = type internal FormatDistanceToken =
| LessThanXMinutes | LessThanXMinutes
@ -48,7 +49,7 @@ open System
/// Convert from a JavaScript "ticks" value to a date/time /// Convert from a JavaScript "ticks" value to a date/time
let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L) let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
let formatDistance (startDate : DateTime) (endDate : DateTime) = let formatDistance (startDate : Instant) (endDate : Instant) =
let format (token, number) locale = let format (token, number) locale =
let labels = locales |> Map.find locale let labels = locales |> Map.find locale
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number

View File

@ -5,6 +5,7 @@ module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames // fsharplint:disable RecordFieldNames
open Cuid open Cuid
open NodaTime
/// An identifier for a request /// An identifier for a request
type RequestId = type RequestId =
@ -28,16 +29,6 @@ module UserId =
let toString = function UserId x -> x let toString = function UserId x -> x
/// 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
/// How frequently a request should reappear after it is marked "Prayed" /// How frequently a request should reappear after it is marked "Prayed"
type Recurrence = type Recurrence =
| Immediate | Immediate
@ -71,7 +62,6 @@ module Recurrence =
| Hours -> oneHour | Hours -> oneHour
| Days -> oneHour * 24L | Days -> oneHour * 24L
| Weeks -> oneHour * 24L * 7L) | Weeks -> oneHour * 24L * 7L)
|> ( * ) 1000L
/// The action taken on a request as part of a history entry /// The action taken on a request as part of a history entry
@ -86,7 +76,7 @@ type RequestAction =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type History = { type History = {
/// The time when this history entry was made /// The time when this history entry was made
asOf : Ticks asOf : Instant
/// The status for this history entry /// The status for this history entry
status : RequestAction status : RequestAction
/// The text of the update, if applicable /// The text of the update, if applicable
@ -97,7 +87,7 @@ type History = {
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Note = { type Note = {
/// The time when this note was made /// The time when this note was made
asOf : Ticks asOf : Instant
/// The text of the notes /// The text of the notes
notes : string notes : string
} }
@ -108,13 +98,13 @@ type Request = {
/// The ID of the request /// The ID of the request
id : RequestId id : RequestId
/// The time this request was initially entered /// The time this request was initially entered
enteredOn : Ticks enteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT) /// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice /// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : Ticks snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence /// The time at which this request should reappear in the user's journal by recurrence
showAfter : Ticks showAfter : Instant
/// The type of recurrence for this request /// The type of recurrence for this request
recurType : Recurrence recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal /// How many of the recurrence intervals should occur between appearances in the journal
@ -128,10 +118,10 @@ with
/// An empty request /// An empty request
static member empty = static member empty =
{ id = Cuid.generate () |> RequestId { id = Cuid.generate () |> RequestId
enteredOn = Ticks 0L enteredOn = Instant.MinValue
userId = UserId "" userId = UserId ""
snoozedUntil = Ticks 0L snoozedUntil = Instant.MinValue
showAfter = Ticks 0L showAfter = Instant.MinValue
recurType = Immediate recurType = Immediate
recurCount = 0s recurCount = 0s
history = [] history = []
@ -149,13 +139,13 @@ type JournalRequest =
/// The current text of the request /// The current text of the request
text : string text : string
/// The last time action was taken on the request /// The last time action was taken on the request
asOf : Ticks asOf : Instant
/// The last status for the request /// The last status for the request
lastStatus : RequestAction lastStatus : RequestAction
/// The time that this request should reappear in the user's journal /// The time that this request should reappear in the user's journal
snoozedUntil : Ticks snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence /// The time after which this request should reappear in the user's journal by configured recurrence
showAfter : Ticks showAfter : Instant
/// The type of recurrence for this request /// The type of recurrence for this request
recurType : Recurrence recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal /// How many of the recurrence intervals should occur between appearances in the journal
@ -171,16 +161,16 @@ module JournalRequest =
/// Convert a request to the form used for the journal (precomputed values, no notes or history) /// Convert a request to the form used for the journal (precomputed values, no notes or history)
let ofRequestLite (req : Request) = let ofRequestLite (req : Request) =
let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.tryHead let hist = req.history |> List.sortByDescending (fun it -> it.asOf) |> List.tryHead
{ requestId = req.id { requestId = req.id
userId = req.userId userId = req.userId
text = req.history text = req.history
|> List.filter (fun it -> Option.isSome it.text) |> List.filter (fun it -> Option.isSome it.text)
|> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.sortByDescending (fun it -> it.asOf)
|> List.tryHead |> List.tryHead
|> Option.map (fun h -> Option.get h.text) |> Option.map (fun h -> Option.get h.text)
|> Option.defaultValue "" |> Option.defaultValue ""
asOf = match hist with Some h -> h.asOf | None -> Ticks 0L asOf = match hist with Some h -> h.asOf | None -> Instant.MinValue
lastStatus = match hist with Some h -> h.status | None -> Created lastStatus = match hist with Some h -> h.status | None -> Created
snoozedUntil = req.snoozedUntil snoozedUntil = req.snoozedUntil
showAfter = req.showAfter showAfter = req.showAfter

View File

@ -10,6 +10,7 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open System open System
open System.Security.Claims open System.Security.Claims
open NodaTime
/// Helper function to be able to split out log on /// Helper function to be able to split out log on
[<AutoOpen>] [<AutoOpen>]
@ -81,6 +82,14 @@ module private Helpers =
let userId ctx = let userId ctx =
(user >> Option.get) ctx |> UserId (user >> Option.get) ctx |> UserId
/// Get the system clock
let clock (ctx : HttpContext) =
ctx.GetService<IClock> ()
/// Get the current instant
let now ctx =
(clock ctx).GetCurrentInstant ()
/// Return a 201 CREATED response /// Return a 201 CREATED response
let created = let created =
setStatusCode 201 setStatusCode 201
@ -95,14 +104,6 @@ module private Helpers =
let seeOther (url : string) = let seeOther (url : string) =
noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url
/// Convert a date/time to JS-style ticks
let toJs (date : DateTime) =
date.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds |> (int64 >> ( * ) 1_000L >> Ticks)
/// The "now" time in JavaScript as Ticks
let jsNow () =
toJs DateTime.UtcNow
/// Render a component result /// Render a component result
let renderComponent nodes : HttpHandler = let renderComponent nodes : HttpHandler =
noResponseCaching noResponseCaching
@ -116,7 +117,7 @@ module private Helpers =
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed = backgroundTask { let! hasSnoozed = backgroundTask {
match user ctx with match user ctx with
| Some _ -> return! Data.hasSnoozed (userId ctx) (jsNow ()) (db ctx) | Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx)
| None -> return false | None -> return false
} }
return { return {
@ -224,6 +225,7 @@ module Models =
open MyPrayerJournal.Data.Extensions open MyPrayerJournal.Data.Extensions
open NodaTime.Text
/// Handlers for less-than-full-page HTML requests /// Handlers for less-than-full-page HTML requests
module Components = module Components =
@ -232,10 +234,10 @@ module Components =
let journalItems : HttpHandler = let journalItems : HttpHandler =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
let shouldShow now r = now > Ticks.toLong r.snoozedUntil && now > Ticks.toLong r.showAfter let now = now ctx
let! jrnl = Data.journalByUserId (userId ctx) (db ctx) let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
let shown = jrnl |> List.filter (shouldShow ((jsNow >> Ticks.toLong) ())) let shown = jrnl |> List.filter (fun it -> now > it.snoozedUntil && now > it.showAfter)
return! renderComponent [ Views.Journal.journalItems shown ] next ctx return! renderComponent [ Views.Journal.journalItems now shown ] next ctx
} }
// GET /components/request-item/[req-id] // GET /components/request-item/[req-id]
@ -243,7 +245,7 @@ module Components =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with
| Some req -> return! renderComponent [ Views.Request.reqListItem req ] next ctx | Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -257,7 +259,7 @@ module Components =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx)
return! renderComponent (Views.Request.notes notes) next ctx return! renderComponent (Views.Request.notes (now ctx) notes) next ctx
} }
// GET /components/request/[req-id]/snooze // GET /components/request/[req-id]/snooze
@ -321,8 +323,12 @@ module Request =
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx (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) (userId ctx) (db ctx) with
| Some req -> return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx | Some req ->
| None -> return! Error.notFound next ctx debug ctx "Found - sending view"
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
| None ->
debug ctx "Not found - uh oh..."
return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/prayed // PATCH /request/[req-id]/prayed
@ -334,13 +340,13 @@ module Request =
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId usrId db with
| Some req -> | Some req ->
let now = jsNow () let now = now ctx
do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db
let nextShow = let nextShow =
match Recurrence.duration req.recurType with match Recurrence.duration req.recurType with
| 0L -> 0L | 0L -> Instant.MinValue
| duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) | duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount))
do! Data.updateShowAfter reqId usrId (Ticks nextShow) db do! Data.updateShowAfter reqId usrId nextShow db
do! db.saveChanges () do! db.saveChanges ()
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -356,7 +362,7 @@ module Request =
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> () let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
do! Data.addNote reqId usrId { asOf = jsNow (); notes = notes.notes } db do! Data.addNote reqId usrId { asOf = now ctx; notes = notes.notes } db
do! db.saveChanges () do! db.saveChanges ()
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -367,7 +373,7 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partial "Active Requests" (Views.Request.active reqs) next ctx return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx
} }
// GET /requests/snoozed // GET /requests/snoozed
@ -375,9 +381,9 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
let now = (jsNow >> Ticks.toLong) () let now = now ctx
let snoozed = reqs |> List.filter (fun r -> Ticks.toLong r.snoozedUntil > now) let snoozed = reqs |> List.filter (fun it -> it.snoozedUntil > now)
return! partial "Active Requests" (Views.Request.snoozed snoozed) next ctx return! partial "Active Requests" (Views.Request.snoozed now snoozed) next ctx
} }
// GET /requests/answered // GET /requests/answered
@ -385,7 +391,7 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
let! reqs = Data.answeredRequests (userId ctx) (db ctx) let! reqs = Data.answeredRequests (userId ctx) (db ctx)
return! partial "Answered Requests" (Views.Request.answered reqs) next ctx return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx
} }
// GET /api/request/[req-id] // GET /api/request/[req-id]
@ -402,7 +408,7 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask { >=> fun next ctx -> backgroundTask {
match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! partial "Prayer Request" (Views.Request.full req) next ctx | Some req -> return! partial "Prayer Request" (Views.Request.full (clock ctx) req) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -415,7 +421,7 @@ module Request =
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
do! Data.updateShowAfter reqId usrId (Ticks 0L) db do! Data.updateShowAfter reqId usrId Instant.MinValue db
do! db.saveChanges () do! db.saveChanges ()
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -431,8 +437,11 @@ module Request =
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> () let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
let date = sprintf "%s 00:00:00" until.until |> DateTime.Parse let date =
do! Data.updateSnoozed reqId usrId (toJs date) db LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant ()
do! Data.updateSnoozed reqId usrId date db
do! db.saveChanges () do! db.saveChanges ()
return! return!
(withSuccessMessage $"Request snoozed until {until.until}" (withSuccessMessage $"Request snoozed until {until.until}"
@ -450,7 +459,7 @@ module Request =
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
do! Data.updateSnoozed reqId usrId (Ticks 0L) db do! Data.updateSnoozed reqId usrId Instant.MinValue db
do! db.saveChanges () do! db.saveChanges ()
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -468,13 +477,13 @@ module Request =
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let now = jsNow () let now = now ctx
let (recur, interval) = parseRecurrence form let (recur, interval) = parseRecurrence form
let req = let req =
{ Request.empty with { Request.empty with
userId = usrId userId = usrId
enteredOn = now enteredOn = now
showAfter = Ticks 0L showAfter = Instant.MinValue
recurType = recur recurType = recur
recurCount = interval recurCount = interval
history = [ history = [
@ -506,13 +515,13 @@ module Request =
| false -> | false ->
do! Data.updateRecurrence req.requestId usrId recur interval db do! Data.updateRecurrence req.requestId usrId recur interval db
match recur with match recur with
| Immediate -> do! Data.updateShowAfter req.requestId usrId (Ticks 0L) db | Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db
| _ -> () | _ -> ()
// append history // append history
let upd8Text = form.requestText.Trim () let upd8Text = form.requestText.Trim ()
let text = match upd8Text = req.text with true -> None | false -> Some upd8Text let text = match upd8Text = req.text with true -> None | false -> Some upd8Text
do! Data.addHistory req.requestId usrId do! Data.addHistory req.requestId usrId
{ asOf = jsNow (); status = (Option.get >> RequestAction.ofString) form.status; text = text } db { asOf = now ctx; status = (Option.get >> RequestAction.ofString) form.status; text = text } db
do! db.saveChanges () do! db.saveChanges ()
let nextUrl = let nextUrl =
match form.returnTo with match form.returnTo with

View File

@ -21,6 +21,7 @@
<PackageReference Include="Giraffe" Version="5.0.0" /> <PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="LiteDB" Version="5.0.11" /> <PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="../../../../Giraffe.Htmx/src/Htmx/Giraffe.Htmx.fsproj" /> <ProjectReference Include="../../../../Giraffe.Htmx/src/Htmx/Giraffe.Htmx.fsproj" />

View File

@ -61,6 +61,7 @@ module Configure =
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open Microsoft.IdentityModel.Protocols.OpenIdConnect open Microsoft.IdentityModel.Protocols.OpenIdConnect
open NodaTime
open System open System
open System.Text.Json open System.Text.Json
open System.Text.Json.Serialization open System.Text.Json.Serialization
@ -76,6 +77,7 @@ module Configure =
bldr.Services bldr.Services
.AddRouting() .AddRouting()
.AddGiraffe() .AddGiraffe()
.AddSingleton<IClock>(SystemClock.Instance)
.Configure<CookiePolicyOptions>( .Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) -> fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified

View File

@ -5,7 +5,7 @@ module private MyPrayerJournal.Views.Helpers
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
open System open NodaTime
/// Create a link that targets the `#top` element and pushes a URL to history /// Create a link that targets the `#top` element and pushes a URL to history
let pageLink href attrs = let pageLink href attrs =
@ -26,10 +26,6 @@ let noResults heading link buttonText text =
] ]
] ]
/// Convert `Ticks` to `DateTime`
let fromJs = Ticks.toLong >> Dates.fromJs
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate jsDate = let relativeDate (date : Instant) now =
let date = fromJs jsDate span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]
span [ _title (date.ToString "f") ] [ Dates.formatDistance DateTime.UtcNow date |> str ]

View File

@ -7,7 +7,7 @@ open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
/// Display a card for this prayer request /// Display a card for this prayer request
let journalCard req = let journalCard now req =
let reqId = RequestId.toString req.requestId let reqId = RequestId.toString req.requestId
let spacer = span [] [ rawText "&nbsp;" ] let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [ div [ _class "col" ] [
@ -48,7 +48,7 @@ let journalCard req =
p [ _class "request-text" ] [ str req.text ] p [ _class "request-text" ] [ str req.text ]
] ]
div [ _class "card-footer text-end text-muted px-1 py-0" ] [ div [ _class "card-footer text-end text-muted px-1 py-0" ] [
em [] [ str "last activity "; relativeDate req.asOf ] em [] [ str "last activity "; relativeDate req.asOf now ]
] ]
] ]
] ]
@ -113,7 +113,7 @@ let journal user = article [ _class "container-fluid mt-3" ] [
] ]
/// The journal items /// The journal items
let journalItems items = let journalItems now items =
match items |> List.isEmpty with match items |> List.isEmpty with
| true -> | true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [ noResults "No Active Requests" "/request/new/edit" "Add a Request" [
@ -122,7 +122,7 @@ let journalItems items =
] ]
| false -> | false ->
items items
|> List.map journalCard |> List.map (journalCard now)
|> section [ |> section [
_id "journalItems" _id "journalItems"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
@ -170,7 +170,7 @@ let snooze requestId =
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml
] [ ] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today ] input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
label [ _for "until" ] [ str "Until" ] label [ _for "until" ] [ str "Until" ]
] ]
p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ] p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ]

View File

@ -4,30 +4,26 @@ module MyPrayerJournal.Views.Request
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
open NodaTime
open System open System
/// Create a request within the list /// Create a request within the list
let reqListItem req = let reqListItem now req =
let jsNow = int64 (DateTime.UtcNow - DateTime.UnixEpoch).TotalMilliseconds
let reqId = RequestId.toString req.requestId let reqId = RequestId.toString req.requestId
let isAnswered = req.lastStatus = Answered let isAnswered = req.lastStatus = Answered
let isSnoozed = Ticks.toLong req.snoozedUntil > jsNow let isSnoozed = req.snoozedUntil > now
let isPending = (not isSnoozed) && Ticks.toLong req.showAfter > jsNow let isPending = (not isSnoozed) && req.showAfter > now
let btnClass = _class "btn btn-light mx-2" let btnClass = _class "btn btn-light mx-2"
div [ let restoreBtn (link : string) title =
_class "list-group-item px-0 d-flex flex-row align-items-start" button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
_hxTarget "this" div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
_hxSwap HxSwap.OuterHtml
] [
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with match isAnswered with
| true -> () | true -> ()
| false -> button [ btnClass; _hxGet $"/components/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ] | false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
match true with match true with
| _ when isSnoozed -> | _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
button [ btnClass; _hxPatch $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ] | _ when isPending -> restoreBtn "show" "Show Now"
| _ when isPending ->
button [ btnClass; _hxPatch $"/request/{reqId}/show"; _title "Show Now" ] [ icon "restore" ]
| _ -> () | _ -> ()
p [ _class "request-text mb-0" ] [ p [ _class "request-text mb-0" ] [
str req.text str req.text
@ -36,9 +32,9 @@ let reqListItem req =
br [] br []
small [ _class "text-muted" ] [ small [ _class "text-muted" ] [
match () with match () with
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil ] | _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter ] | _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf ] | _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em [] |> em []
] ]
| false -> () | false -> ()
@ -46,23 +42,23 @@ let reqListItem req =
] ]
/// Create a list of requests /// Create a list of requests
let reqList reqs = let reqList now reqs =
reqs reqs
|> List.map reqListItem |> List.map (reqListItem now)
|> div [ _class "list-group" ] |> div [ _class "list-group" ]
/// View for Active Requests page /// View for Active Requests page
let active reqs = article [ _class "container mt-3" ] [ let active now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Active Requests" ] h2 [ _class "pb-3" ] [ str "Active Requests" ]
match reqs |> List.isEmpty with match reqs |> List.isEmpty with
| true -> | true ->
noResults "No Active Requests" "/journal" "Return to your journal" noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ] [ str "Your prayer journal has no active requests" ]
| false -> reqList reqs | false -> reqList now reqs
] ]
/// View for Answered Requests page /// View for Answered Requests page
let answered reqs = article [ _class "container mt-3" ] [ let answered now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Answered Requests" ] h2 [ _class "pb-3" ] [ str "Answered Requests" ]
match reqs |> List.isEmpty with match reqs |> List.isEmpty with
| true -> | true ->
@ -70,38 +66,39 @@ let answered reqs = article [ _class "container mt-3" ] [
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, " rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, "
str "it will appear here" str "it will appear here"
] ]
| false -> reqList reqs | false -> reqList now reqs
] ]
/// View for Snoozed Requests page /// View for Snoozed Requests page
let snoozed reqs = article [ _class "container mt-3" ] [ let snoozed now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Snoozed Requests" ] h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
reqList reqs reqList now reqs
] ]
/// View for Full Request page /// View for Full Request page
let full (req : Request) = let full (clock : IClock) (req : Request) =
let now = clock.GetCurrentInstant ()
let answered = let answered =
req.history req.history
|> List.filter RequestAction.isAnswered |> List.filter RequestAction.isAnswered
|> List.tryHead |> List.tryHead
|> Option.map (fun x -> x.asOf) |> Option.map (fun x -> x.asOf)
let prayed = req.history |> List.filter RequestAction.isPrayed |> List.length let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0"
let daysOpen = let daysOpen =
let asOf = answered |> Option.map fromJs |> Option.defaultValue DateTime.Now let asOf = defaultArg answered now
(asOf - fromJs (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int ((asOf - (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int).ToString "N0"
let lastText = let lastText =
req.history req.history
|> List.filter (fun h -> Option.isSome h.text) |> List.filter (fun h -> Option.isSome h.text)
|> List.sortByDescending (fun h -> Ticks.toLong h.asOf) |> List.sortByDescending (fun h -> h.asOf)
|> List.map (fun h -> Option.get h.text) |> List.map (fun h -> Option.get h.text)
|> List.head |> List.head
// The history log including notes (and excluding the final entry for answered requests) // The history log including notes (and excluding the final entry for answered requests)
let log = let log =
let toDisp (h : History) = {| asOf = fromJs h.asOf; text = h.text; status = RequestAction.toString h.status |} let toDisp (h : History) = {| asOf = h.asOf; text = h.text; status = RequestAction.toString h.status |}
let all = let all =
req.notes req.notes
|> List.map (fun n -> {| asOf = fromJs n.asOf; text = Some n.notes; status = "Notes" |}) |> List.map (fun n -> {| asOf = n.asOf; text = Some n.notes; status = "Notes" |})
|> List.append (req.history |> List.map toDisp) |> List.append (req.history |> List.map toDisp)
|> List.sortByDescending (fun it -> it.asOf) |> List.sortByDescending (fun it -> it.asOf)
// Skip the first entry for answered requests; that info is already displayed // Skip the first entry for answered requests; that info is already displayed
@ -112,14 +109,14 @@ let full (req : Request) =
div [ _class "card-body" ] [ div [ _class "card-body" ] [
h6 [ _class "card-subtitle text-muted mb-2"] [ h6 [ _class "card-subtitle text-muted mb-2"] [
match answered with match answered with
| Some ticks -> | Some date ->
str "Answered " str "Answered "
(fromJs ticks).ToString "D" |> str date.ToDateTimeOffset().ToString ("D", null) |> str
str " (" str " ("
relativeDate ticks relativeDate date now
rawText ") &bull; " rawText ") &bull; "
| None -> () | None -> ()
sprintf "Prayed %i times &bull; Open %i days" prayed daysOpen |> rawText sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText
] ]
p [ _class "card-text" ] [ str lastText ] p [ _class "card-text" ] [ str lastText ]
] ]
@ -128,7 +125,7 @@ let full (req : Request) =
p [ _class "m-0" ] [ p [ _class "m-0" ] [
str it.status str it.status
rawText "&nbsp; " rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToString "D" |> str ] ] small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
] ]
match it.text with match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ] | Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
@ -261,8 +258,9 @@ let edit (req : JournalRequest) returnTo isNew =
] ]
/// Display a list of notes for a request /// Display a list of notes for a request
let notes notes = let notes now notes =
let toItem (note : Note) = p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf ]; br []; str note.notes ] let toItem (note : Note) =
p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ] [ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ] | [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]

View File

@ -30,7 +30,7 @@ const mpj = {
body.innerText = msg body.innerText = msg
const toastEl = document.createElement("div") const toastEl = document.createElement("div")
toastEl.className = `toast bg-${level} text-white` toastEl.className = `toast bg-${level === "error" ? "danger" : level} text-white`
toastEl.setAttribute("role", "alert") toastEl.setAttribute("role", "alert")
toastEl.setAttribute("aria-live", "assertlive") toastEl.setAttribute("aria-live", "assertlive")
toastEl.setAttribute("aria-atomic", "true") toastEl.setAttribute("aria-atomic", "true")