Version 3.1 #71

Merged
danieljsummers merged 9 commits from v3.1 into main 2022-07-30 21:02:58 +00:00
19 changed files with 1952 additions and 1676 deletions

View File

@ -0,0 +1,16 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup>
</Project>

View File

@ -0,0 +1,114 @@
open MyPrayerJournal.Domain
open NodaTime
/// The old definition of the history entry
[<CLIMutable; NoComparison; NoEquality>]
type OldHistory =
{ /// The time when this history entry was made
asOf : int64
/// The status for this history entry
status : RequestAction
/// The text of the update, if applicable
text : string option
}
/// The old definition of of the note entry
[<CLIMutable; NoComparison; NoEquality>]
type OldNote =
{ /// The time when this note was made
asOf : int64
/// The text of the notes
notes : string
}
/// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>]
type OldRequest =
{ /// The ID of the request
id : RequestId
/// The time this request was initially entered
enteredOn : int64
/// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : int64
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : int64
/// The type of recurrence for this request
recurType : string
/// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// The history entries for this request
history : OldHistory[]
/// The notes for this request
notes : OldNote[]
}
open LiteDB
open MyPrayerJournal.Data
let db = new LiteDatabase ("Filename=./mpj.db")
Startup.ensureDb db
/// Map the old recurrence to the new style
let mapRecurrence old =
match old.recurType with
| "Days" -> Days old.recurCount
| "Hours" -> Hours old.recurCount
| "Weeks" -> Weeks old.recurCount
| _ -> Immediate
/// Convert an old history entry to the new form
let convertHistory (old : OldHistory) =
{ AsOf = Instant.FromUnixTimeMilliseconds old.asOf
Status = old.status
Text = old.text
}
/// Convert an old note to the new form
let convertNote (old : OldNote) =
{ AsOf = Instant.FromUnixTimeMilliseconds old.asOf
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 = 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
}
/// 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.Checkpoint ()
db.GetCollection<OldRequest>("request").FindAll ()
|> Seq.map convert
|> List.ofSeq
|> List.iter replace
// For more information see https://aka.ms/fsharp-console-apps
printfn "Done"

28
src/MyPrayerJournal.sln Normal file
View File

@ -0,0 +1,28 @@

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 16
VisualStudioVersion = 16.0.30114.105
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ConvertRecurrence", "MyPrayerJournal.ConvertRecurrence\MyPrayerJournal.ConvertRecurrence.fsproj", "{72B57736-8721-4636-A309-49FA4222416E}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.Build.0 = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

View File

@ -1,23 +1,21 @@
module MyPrayerJournal.Data
open LiteDB
open NodaTime
open System
open MyPrayerJournal
open System.Threading.Tasks
// fsharplint:disable MemberNames
/// LiteDB extensions
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.requests
with get () = this.GetCollection<Request> "request"
member this.Requests = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log)
member this.saveChanges () =
member this.SaveChanges () =
this.Checkpoint ()
Task.CompletedTask
@ -27,72 +25,61 @@ module Extensions =
[<RequireQualifiedAccess>]
module Mapping =
/// Map a history entry to BSON
let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
open NodaTime
open NodaTime.Text
/// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
/// A NodaTime instant pattern to use for parsing instants from the database
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
/// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds ()
doc["notes"] <- note.notes
upcast doc
/// Mapping for NodaTime's Instant type
module Instant =
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
/// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
notes = doc["notes"].AsString
}
/// 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
/// Map a request to its BSON representation
let requestToBson req : BsonValue =
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList)
upcast doc
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 -> ""
/// Map a BSON document to a request
let requestFromBson (doc : BsonValue) =
{ id = RequestId.ofString doc["_id"].AsString
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc["recurCount"].AsInt32
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq
}
/// Mapping for Recurrence
module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction
module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
/// Mapping for RequestId
module RequestId =
let fromBson (value : BsonValue) = RequestId.ofString value.AsString
let toBson (value : RequestId) : BsonValue = RequestId.toString value
/// Mapping for UserId
module UserId =
let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value
/// Set up the mapping
let register () =
BsonMapper.Global.RegisterType<Request>(
Func<Request, BsonValue> requestToBson, Func<BsonValue, Request> requestFromBson)
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
/// Code to be run at startup
module Startup =
/// Ensure the database is set up
let ensureDb (db : LiteDatabase) =
db.requests.EnsureIndex (fun it -> it.userId) |> ignore
db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
Mapping.register ()
@ -112,98 +99,101 @@ 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
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
}
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
|> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.asOf)
|> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.AsOf)
|> List.ofSeq
}
}
/// 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)
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (fun it -> it.AsOf)
|> List.ofSeq
}
}
/// 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
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite
}
}
/// Update the recurrence for a request
let updateRecurrence reqId userId recurType recurCount db = backgroundTask {
let updateRecurrence reqId userId recurType db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
| Some req -> do! doUpdate db { req with Recurrence = recurType }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
}
/// Update a snoozed request
let updateSnoozed reqId userId until db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until }
| Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
}
/// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with showAfter = showAfter }
| Some req -> do! doUpdate db { req with ShowAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
}

View File

@ -46,16 +46,14 @@ let twoMonths = 86_400.
open System
/// Convert from a JavaScript "ticks" value to a date/time
let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
let formatDistance (startDate : Instant) (endDate : Instant) =
/// Format the distance between two instants in approximate English terms
let formatDistance (startOn : Instant) (endOn : Instant) =
let format (token, number) locale =
let labels = locales |> Map.find locale
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number
let round (it : float) = Math.Round it |> int
let diff = startDate - endDate
let diff = startOn - endOn
let minutes = Math.Abs diff.TotalMinutes
let formatToken =
let months = minutes / aMonth |> round
@ -74,5 +72,5 @@ let formatDistance (startDate : Instant) (endDate : Instant) =
| _ -> AlmostXYears, years + 1
format formatToken "en-US"
|> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s"
|> match startOn > endOn with true -> sprintf "%s ago" | false -> sprintf "in %s"

View File

@ -1,67 +1,84 @@
[<AutoOpen>]
/// The data model for myPrayerJournal
/// The data model for myPrayerJournal
[<AutoOpen>]
module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames
open System
open Cuid
open NodaTime
/// An identifier for a request
type RequestId =
| RequestId of Cuid
type RequestId = RequestId of Cuid
/// Functions to manipulate request IDs
module RequestId =
/// The string representation of the request ID
let toString = function RequestId x -> Cuid.toString x
/// Create a request ID from a string representation
let ofString = Cuid >> RequestId
/// The identifier of a user (the "sub" part of the JWT)
type UserId =
| UserId of string
type UserId = UserId of string
/// Functions to manipulate user IDs
module UserId =
/// The string representation of the user ID
let toString = function UserId x -> x
/// How frequently a request should reappear after it is marked "Prayed"
type Recurrence =
/// A request should reappear immediately at the bottom of the list
| Immediate
| Hours
| Days
| Weeks
/// A request should reappear in the given number of hours
| Hours of int16
/// A request should reappear in the given number of days
| Days of int16
/// A request should reappear in the given number of weeks (7-day increments)
| Weeks of int16
/// Functions to manipulate recurrences
module Recurrence =
/// Create a string representation of a recurrence
let toString =
function
| Immediate -> "Immediate"
| Hours -> "Hours"
| Days -> "Days"
| Weeks -> "Weeks"
| Hours h -> $"{h} Hours"
| Days d -> $"{d} Days"
| Weeks w -> $"{w} Weeks"
/// Create a recurrence value from a string
let ofString =
function
| "Immediate" -> Immediate
| "Hours" -> Hours
| "Days" -> Days
| "Weeks" -> Weeks
| it when it.Contains " " ->
let parts = it.Split " "
let length = Convert.ToInt16 parts[0]
match parts[1] with
| "Hours" -> Hours length
| "Days" -> Days length
| "Weeks" -> Weeks length
| _ -> invalidOp $"{parts[1]} is not a valid recurrence"
| it -> invalidOp $"{it} is not a valid recurrence"
/// An hour's worth of seconds
let private oneHour = 3_600L
/// The duration of the recurrence (in milliseconds)
let duration x =
(match x with
let duration =
function
| Immediate -> 0L
| Hours -> oneHour
| Days -> oneHour * 24L
| Weeks -> oneHour * 24L * 7L)
| Hours h -> int64 h * oneHour
| Days d -> int64 d * oneHour * 24L
| Weeks w -> int64 w * oneHour * 24L * 7L
/// The action taken on a request as part of a history entry
@ -71,125 +88,9 @@ type RequestAction =
| Updated
| Answered
/// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>]
type History = {
/// The time when this history entry was made
asOf : Instant
/// The status for this history entry
status : RequestAction
/// The text of the update, if applicable
text : string option
}
/// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>]
type Note = {
/// The time when this note was made
asOf : Instant
/// The text of the notes
notes : string
}
/// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>]
type Request = {
/// The ID of the request
id : RequestId
/// The time this request was initially entered
enteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : Instant
/// The type of recurrence for this request
recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// The history entries for this request
history : History list
/// The notes for this request
notes : Note list
}
with
/// An empty request
static member empty =
{ id = Cuid.generate () |> RequestId
enteredOn = Instant.MinValue
userId = UserId ""
snoozedUntil = Instant.MinValue
showAfter = Instant.MinValue
recurType = Immediate
recurCount = 0s
history = []
notes = []
}
/// JournalRequest is the form of a prayer request returned for the request journal display. It also contains
/// properties that may be filled for history and notes.
[<NoComparison; NoEquality>]
type JournalRequest = {
/// The ID of the request (just the CUID part)
requestId : RequestId
/// The ID of the user to whom the request belongs
userId : UserId
/// The current text of the request
text : string
/// The last time action was taken on the request
asOf : Instant
/// The last status for the request
lastStatus : RequestAction
/// The time that this request should reappear in the user's journal
snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence
showAfter : Instant
/// The type of recurrence for this request
recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// History entries for the request
history : History list
/// Note entries for the request
notes : Note list
}
/// Functions to manipulate journal requests
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
{ 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
|> 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
snoozedUntil = req.snoozedUntil
showAfter = req.showAfter
recurType = req.recurType
recurCount = req.recurCount
history = []
notes = []
}
/// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req =
{ ofRequestLite req with
history = req.history
notes = req.notes
}
/// Functions to manipulate request actions
module RequestAction =
/// Create a string representation of an action
let toString =
function
@ -197,6 +98,7 @@ module RequestAction =
| Prayed -> "Prayed"
| Updated -> "Updated"
| Answered -> "Answered"
/// Create a RequestAction from a string
let ofString =
function
@ -205,9 +107,174 @@ module RequestAction =
| "Updated" -> Updated
| "Answered" -> Answered
| it -> invalidOp $"Bad request action {it}"
/// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>]
type History =
{ /// The time when this history entry was made
AsOf : Instant
/// The status for this history entry
Status : RequestAction
/// The text of the update, if applicable
Text : string option
}
/// Functions to manipulate history entries
module History =
/// Determine if a history's status is `Created`
let isCreated hist = hist.status = Created
let isCreated hist = hist.Status = Created
/// Determine if a history's status is `Prayed`
let isPrayed hist = hist.status = Prayed
let isPrayed hist = hist.Status = Prayed
/// Determine if a history's status is `Answered`
let isAnswered hist = hist.status = Answered
let isAnswered hist = hist.Status = Answered
/// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>]
type Note =
{ /// The time when this note was made
AsOf : Instant
/// The text of the notes
Notes : string
}
/// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>]
type Request =
{ /// The ID of the request
Id : RequestId
/// The time this request was initially entered
EnteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT)
UserId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice
SnoozedUntil : Instant option
/// The time at which this request should reappear in the user's journal by recurrence
ShowAfter : Instant option
/// The recurrence for this request
Recurrence : Recurrence
/// The history entries for this request
History : History[]
/// The notes for this request
Notes : Note[]
}
/// Functions to support requests
module Request =
/// An empty request
let empty =
{ Id = Cuid.generate () |> RequestId
EnteredOn = Instant.MinValue
UserId = UserId ""
SnoozedUntil = None
ShowAfter = None
Recurrence = Immediate
History = [||]
Notes = [||]
}
/// JournalRequest is the form of a prayer request returned for the request journal display. It also contains
/// properties that may be filled for history and notes.
[<NoComparison; NoEquality>]
type JournalRequest =
{ /// The ID of the request (just the CUID part)
RequestId : RequestId
/// The ID of the user to whom the request belongs
UserId : UserId
/// The current text of the request
Text : string
/// The last time action was taken on the request
AsOf : Instant
/// The last time a request was marked as prayed
LastPrayed : Instant option
/// The last status for the request
LastStatus : RequestAction
/// The time that this request should reappear in the user's journal
SnoozedUntil : Instant option
/// The time after which this request should reappear in the user's journal by configured recurrence
ShowAfter : Instant option
/// The recurrence for this request
Recurrence : Recurrence
/// History entries for the request
History : History list
/// Note entries for the request
Notes : Note list
}
/// Functions to manipulate journal requests
module JournalRequest =
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
let ofRequestLite (req : Request) =
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
// largest of the last prayed date, the "snoozed until". or the "show after" date; if none 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.
// - Snoozed requests will reappear at the bottom of the list when they return.
// - 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 showAfter = defaultArg req.ShowAfter Instant.MinValue
let snoozedUntil = defaultArg req.SnoozedUntil 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 asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id
UserId = req.UserId
Text = req.History
|> 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 = if asOf > Instant.MinValue then asOf else lastActivity
LastPrayed = if lastPrayed = Instant.MinValue then None else Some lastPrayed
LastStatus = match lastHistory with Some h -> h.Status | None -> Created
SnoozedUntil = req.SnoozedUntil
ShowAfter = req.ShowAfter
Recurrence = req.Recurrence
History = []
Notes = []
}
/// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req =
{ ofRequestLite req with
History = List.ofArray req.History
Notes = List.ofArray req.Notes
}

View File

@ -2,23 +2,18 @@
[<RequireQualifiedAccess>]
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
[<AutoOpen>]
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))
@ -26,79 +21,93 @@ module private LogOnHelpers =
| None -> return! challenge "Auth0" next ctx
}
/// Handlers for error conditions
module Error =
open Microsoft.Extensions.Logging
open System.Threading.Tasks
/// Handle errors
let error (ex : Exception) (log : ILogger) =
log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
log.LogError (EventId (), ex, "An unhandled exception has occurred while executing the request.")
clearResponse
>=> setStatusCode 500
>=> setHttpHeader "X-Toast" (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message)
>=> setHttpHeader "X-Toast" $"error|||{ex.GetType().Name}: {ex.Message}"
>=> text ex.Message
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized reponse
let notAuthorized : HttpHandler =
fun next ctx ->
(next, ctx)
||> match ctx.Request.Method with
| "GET" -> logOn None
| _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx ->
(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
[<AutoOpen>]
module private Helpers =
open System.Security.Claims
open LiteDB
open Microsoft.AspNetCore.Http
open NodaTime
open LiteDB
open Microsoft.Extensions.Logging
open Microsoft.Net.Http.Headers
/// Extensions on the HTTP context
type HttpContext with
let debug (ctx : HttpContext) message =
let fac = ctx.GetService<ILoggerFactory>()
let log = fac.CreateLogger "Debug"
log.LogInformation message
/// The LiteDB database
member this.Db = this.GetService<LiteDatabase> ()
/// Get the LiteDB database
let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>()
/// Get the user's "sub" claim
let user (ctx : HttpContext) =
ctx.User
/// 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)
/// 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
/// 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
/// Get the system clock
let clock (ctx : HttpContext) =
ctx.GetService<IClock> ()
/// The system clock
member this.Clock = this.GetService<IClock> ()
/// Get the current instant
let now ctx =
(clock ctx).GetCurrentInstant ()
/// Get the current instant from the system clock
member this.Now = this.Clock.GetCurrentInstant
/// Get the time zone from the X-Time-Zone header (default UTC)
member this.TimeZone =
match this.TryGetRequestHeader "X-Time-Zone" with
| Some tz ->
match this.GetService<IDateTimeZoneProvider>().GetZoneOrNull tz with
| null -> DateTimeZone.Utc
| zone -> zone
| None -> DateTimeZone.Utc
/// Handler helpers
[<AutoOpen>]
module private Helpers =
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<ILoggerFactory> ()
let log = fac.CreateLogger "Debug"
log.LogInformation message
/// Return a 201 CREATED response
let created =
setStatusCode 201
/// Return a 201 CREATED response with the location header set for the created resource
let createdAt url : HttpHandler =
fun next ctx ->
(sprintf "%s://%s%s" ctx.Request.Scheme ctx.Request.Host.Value url |> setHttpHeader HeaderNames.Location
>=> created) next ctx
let createdAt url : HttpHandler = fun next ctx ->
Successful.CREATED
($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location) next ctx
/// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
let seeOther (url : string) =
@ -107,50 +116,50 @@ module private Helpers =
/// Render a component result
let renderComponent nodes : HttpHandler =
noResponseCaching
>=> fun next ctx -> backgroundTask {
>=> fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
}
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
let writeView view : HttpHandler =
fun next ctx -> backgroundTask {
let writeView view : HttpHandler = fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlViewAsync view
}
/// Hold messages across redirects
module Messages =
/// The messages being held
let mutable private messages : Map<string, (string * string)> = Map.empty
let mutable private messages : Map<UserId, string * string> = 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 (sprintf "success|||%s" message) url
push ctx $"success|||%s{message}" url
/// Pop the messages for the given user
let pop userId = lock upd8 (fun () ->
@ -159,17 +168,16 @@ 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
| Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> writeView view
||> match ctx.CurrentUser with
| Some _ ->
match Messages.pop ctx.UserId with
| Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPushUrl url >=> writeView view
| None -> writeView view
| None -> writeView view
}
@ -192,34 +200,40 @@ module Models =
/// An additional note
[<CLIMutable; NoComparison; NoEquality>]
type NoteEntry = {
/// The notes being added
type NoteEntry =
{ /// The notes being added
notes : string
}
/// A prayer request
[<CLIMutable; NoComparison; NoEquality>]
type Request = {
/// The ID of the request
type Request =
{ /// The ID of the request
requestId : string
/// Where to redirect after saving
returnTo : string
/// The text of the request
requestText : string
/// The additional status to record
status : string option
/// The recurrence type
recurType : string
/// The recurrence count
recurCount : int16 option
/// The recurrence interval
recurInterval : string option
}
/// The date until which a request should not appear in the journal
[<CLIMutable; NoComparison; NoEquality>]
type SnoozeUntil = {
/// The date (YYYY-MM-DD) at which the request should reappear
type SnoozeUntil =
{ /// The date (YYYY-MM-DD) at which the request should reappear
until : string
}
@ -231,41 +245,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)
return! renderComponent [ Views.Journal.journalItems now shown ] next ctx
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 ctx.TimeZone 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 ()) ctx.TimeZone 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 ()) ctx.TimeZone (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
@ -280,16 +293,14 @@ 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)
|> Option.map (fun c -> c.Value)
|> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
return! partial (sprintf "%s Prayer Journal" title) (Views.Journal.journal usr) next ctx
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
}
@ -309,11 +320,9 @@ 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
match ctx.Request.Headers.Referer[0] with
| it when it.EndsWith "/active" -> "active"
| it when it.EndsWith "/snoozed" -> "snoozed"
| _ -> "journal"
@ -322,7 +331,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
@ -332,117 +341,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 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 usrId db with
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.recurType with
| 0L -> Instant.MinValue
| duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount))
do! Data.updateShowAfter reqId usrId nextShow db
do! db.saveChanges ()
match Recurrence.duration req.Recurrence with
| 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 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 usrId db with
match! Data.tryRequestById reqId userId db with
| Some _ ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
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 ()) ctx.TimeZone 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 ctx.TimeZone 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
}
// GET /api/request/[req-id]
let get requestId : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! json req next ctx
| None -> return! Error.notFound 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 ()) ctx.TimeZone 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 ctx.TimeZone 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 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 usrId db with
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 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 usrId db with
match! Data.tryRequestById reqId userId db with
| Some _ ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
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"
@ -451,78 +436,70 @@ 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 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 usrId db with
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
}
/// Derive a recurrence and interval from its primitive representation in the form
/// Derive a recurrence from its representation in the form
let private parseRecurrence (form : Models.Request) =
(Recurrence.ofString (match form.recurInterval with Some x -> x | _ -> "Immediate"),
defaultArg form.recurCount (int16 0))
match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate"
|> Recurrence.ofString
// POST /request
let add : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let add : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx
let usrId = userId ctx
let now = now ctx
let (recur, interval) = parseRecurrence form
let db = ctx.Db
let userId = ctx.UserId
let now = ctx.Now ()
let req =
{ Request.empty with
userId = usrId
enteredOn = now
showAfter = Instant.MinValue
recurType = recur
recurCount = interval
history = [
{ asOf = now
status = Created
text = Some form.requestText
UserId = userId
EnteredOn = now
ShowAfter = None
Recurrence = parseRecurrence form
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 update : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx
let usrId = userId ctx
match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with
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, interval) = parseRecurrence form
match recur = req.recurType && interval = req.recurCount with
let recur = parseRecurrence form
match recur = req.Recurrence with
| true -> ()
| false ->
do! Data.updateRecurrence req.requestId usrId recur interval 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"
@ -537,6 +514,7 @@ module Request =
/// Handlers for /user URLs
module User =
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
// GET /user/log-on
@ -544,9 +522,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
@ -556,8 +532,8 @@ module User =
open Giraffe.EndpointRouting
/// The routes for myPrayerJournal
let routes =
[ GET_HEAD [ route "/" Home.home ]
let routes = [
GET_HEAD [ route "/" Home.home ]
subRoute "/components/" [
GET_HEAD [
route "journal-items" Components.journalItems
@ -600,4 +576,4 @@ let routes =
route "log-on" User.logOn
]
]
]
]

View File

@ -1,7 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<Version>3.0.0.0</Version>
<Version>3.1.0</Version>
<NoWarn>3391</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
@ -16,14 +17,14 @@
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
<PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="0.9.2" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="0.9.2" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
<PackageReference Include="NodaTime" Version="3.0.9" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="LiteDB" Version="5.0.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="6.0.7" />
<PackageReference Include="NodaTime" Version="3.1.0" />
</ItemGroup>
<ItemGroup>
<Folder Include="wwwroot\" />

View File

@ -47,9 +47,7 @@ module Configure =
/// Configure logging
let logging (bldr : WebApplicationBuilder) =
match bldr.Environment.IsDevelopment () with
| true -> ()
| false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
bldr.Logging.AddConsole().AddDebug() |> ignore
bldr
@ -74,27 +72,26 @@ module Configure =
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> ()
bldr.Services
.AddRouting()
.AddGiraffe()
.AddSingleton<IClock>(SystemClock.Instance)
.Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) ->
let _ = bldr.Services.AddRouting ()
let _ = bldr.Services.AddGiraffe ()
let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
let _ =
bldr.Services.Configure<CookiePolicyOptions>(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 ->
let _ =
bldr.Services.AddAuthentication(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 ->
.AddOpenIdConnect("Auth0", fun opts ->
// Configure OIDC with Auth0 options from configuration
let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg["Domain"]
opts.Authority <- $"""https://{cfg["Domain"]}/"""
opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
@ -118,30 +115,27 @@ module Configure =
| true ->
// transform to absolute
let request = ctx.Request
sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
| false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
|> ctx.Response.Redirect
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
Task.CompletedTask)
let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
Data.Startup.ensureDb db
bldr.Services.AddSingleton(jsonOptions)
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>()
.AddSingleton<LiteDatabase> db
|> ignore
let _ = bldr.Services.AddSingleton jsonOptions
let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
let _ = bldr.Services.AddSingleton<LiteDatabase> db
bldr.Build ()
@ -149,18 +143,12 @@ module Configure =
/// 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)
|> ignore
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

View File

@ -2,6 +2,7 @@
[<AutoOpen>]
module private MyPrayerJournal.Views.Helpers
open Giraffe.Htmx
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
@ -10,7 +11,7 @@ open NodaTime
/// Create a link that targets the `#top` element and pushes a URL to history
let pageLink href attrs =
attrs
|> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ]
|> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl "true" ]
|> a
/// Create a Material icon
@ -27,5 +28,5 @@ let noResults heading link buttonText text =
]
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate (date : Instant) now =
span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]
let relativeDate (date : Instant) now (tz : DateTimeZone) =
span [ _title (date.InZone(tz).ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]

View File

@ -1,60 +1,66 @@
/// Views for journal pages and components
module MyPrayerJournal.Views.Journal
open Giraffe.Htmx
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
/// Display a card for this prayer request
let journalCard now req =
let reqId = RequestId.toString req.requestId
let journalCard now tz req =
let reqId = RequestId.toString req.RequestId
let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [
div [ _class "card h-100" ] [
div [ _class "card-header p-0 d-flex"; _roleToolBar ] [
pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ]
spacer
button [
_type "button"
button [ _type "button"
_class "btn btn-secondary"
_title "Add Notes"
_data "bs-toggle" "modal"
_data "bs-target" "#notesModal"
_hxGet $"/components/request/{reqId}/add-notes"
_hxTarget "#notesBody"
_hxSwap HxSwap.InnerHtml
] [ icon "comment" ]
_hxSwap HxSwap.InnerHtml ] [
icon "comment"
]
spacer
button [
_type "button"
button [ _type "button"
_class "btn btn-secondary"
_title "Snooze Request"
_data "bs-toggle" "modal"
_data "bs-target" "#snoozeModal"
_hxGet $"/components/request/{reqId}/snooze"
_hxTarget "#snoozeBody"
_hxSwap HxSwap.InnerHtml
] [ icon "schedule" ]
_hxSwap HxSwap.InnerHtml ] [
icon "schedule"
]
div [ _class "flex-grow-1" ] []
button [
_type "button"
button [ _type "button"
_class "btn btn-success w-25"
_hxPatch $"/request/{reqId}/prayed"
_title "Mark as Prayed"
] [ icon "done" ]
_title "Mark as Prayed" ] [
icon "done"
]
]
div [ _class "card-body" ] [
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" ] [
em [] [ str "last activity "; relativeDate req.asOf now ]
em [] [
match req.LastPrayed with
| Some dt -> str "last prayed "; relativeDate dt now tz
| None -> str "last activity "; relativeDate req.AsOf now tz
]
]
]
]
/// The journal loading page
let journal user = article [ _class "container-fluid mt-3" ] [
let journal user =
article [ _class "container-fluid mt-3" ] [
h2 [ _class "pb-3" ] [
str user
match user with "Your" -> () | _ -> rawText "&rsquo;s"
@ -66,13 +72,11 @@ let journal user = article [ _class "container-fluid mt-3" ] [
p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
rawText "Loading your prayer journal&hellip;"
]
div [
_id "notesModal"
div [ _id "notesModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "nodesModalLabel"
_ariaHidden "true"
] [
_ariaHidden "true" ] [
div [ _class "modal-dialog modal-dialog-scrollable" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
@ -81,20 +85,21 @@ let journal user = article [ _class "container-fluid mt-3" ] [
]
div [ _class "modal-body"; _id "notesBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"; _id "notesDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [
button [ _type "button"
_id "notesDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close"
]
]
]
]
]
div [
_id "snoozeModal"
div [ _id "snoozeModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "snoozeModalLabel"
_ariaHidden "true"
] [
_ariaHidden "true" ] [
div [ _class "modal-dialog modal-sm" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
@ -103,7 +108,10 @@ let journal user = article [ _class "container-fluid mt-3" ] [
]
div [ _class "modal-body"; _id "snoozeBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"; _id "snoozeDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [
button [ _type "button"
_id "snoozeDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close"
]
]
@ -113,7 +121,7 @@ let journal user = article [ _class "container-fluid mt-3" ] [
]
/// The journal items
let journalItems now items =
let journalItems now tz items =
match items |> List.isEmpty with
| true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [
@ -122,27 +130,24 @@ let journalItems now items =
]
| false ->
items
|> List.map (journalCard now)
|> section [
_id "journalItems"
|> List.map (journalCard now tz)
|> section [ _id "journalItems"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
_hxTarget "this"
_hxSwap HxSwap.OuterHtml
]
_ariaLabel "Prayer Requests" ]
/// The notes edit modal body
let notesEdit requestId =
let reqId = RequestId.toString requestId
[ form [ _hxPost $"/request/{reqId}/note" ] [
div [ _class "form-floating pb-3" ] [
textarea [
_id "notes"
textarea [ _id "notes"
_name "notes"
_class "form-control"
_style "min-height: 8rem;"
_placeholder "Notes"
_autofocus; _required
] [ ]
_autofocus; _required ] [ ]
label [ _for "notes" ] [ str "Notes" ]
]
p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ]
@ -150,13 +155,13 @@ let notesEdit requestId =
hr [ _style "margin: .5rem -1rem" ]
div [ _id "priorNotes" ] [
p [ _class "text-center pt-3" ] [
button [
_type "button"
button [ _type "button"
_class "btn btn-secondary"
_hxGet $"/components/request/{reqId}/notes"
_hxSwap HxSwap.OuterHtml
_hxTarget "#priorNotes"
] [str "Load Prior Notes" ]
_hxTarget "#priorNotes" ] [
str "Load Prior Notes"
]
]
]
]
@ -164,11 +169,9 @@ let notesEdit requestId =
/// The snooze edit form
let snooze requestId =
let today = System.DateTime.Today.ToString "yyyy-MM-dd"
form [
_hxPatch $"/request/{RequestId.toString requestId}/snooze"
form [ _hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxTarget "#journalItems"
_hxSwap HxSwap.OuterHtml
] [
_hxSwap HxSwap.OuterHtml ] [
div [ _class "form-floating pb-3" ] [
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
label [ _for "until" ] [ str "Until" ]

View File

@ -1,37 +1,40 @@
/// 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
type PageRenderContext =
{ /// Whether the user is authenticated
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
let home = article [ _class "container mt-3" ] [
let home =
article [ _class "container mt-3" ] [
p [] [ rawText "&nbsp;" ]
p [] [
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for "
str "them, update them as God moves in the situation, and record a final answer received on that request. It also "
str "allows individuals to review their answered prayers."
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "prayed for them, update them as God moves in the situation, and record a final answer received on "
str "that request. It also allows individuals to review their answered prayers."
]
p [] [
str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can also "
rawText "learn more about the site at the &ldquo;Docs&rdquo; link, also above."
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
]
]
@ -46,16 +49,15 @@ 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
match ctx.isAuthenticated with
| true ->
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" ] ]
| false -> li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
li [ _class "nav-item" ] [
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
]
@ -66,7 +68,8 @@ let private navBar ctx =
]
/// The title tag with the application name appended
let titleTag ctx = title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ]
let titleTag ctx =
title [] [ str ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element
let htmlHead ctx =
@ -74,12 +77,10 @@ let htmlHead ctx =
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx
link [
_href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
_rel "stylesheet"
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
_crossorigin "anonymous"
]
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_crossorigin "anonymous" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ]
]
@ -94,7 +95,7 @@ let toaster =
let htmlFoot =
footer [ _class "container-fluid" ] [
p [ _class "text-muted text-end" ] [
str "myPrayerJournal v3"
str "myPrayerJournal v3.1"
br []
em [] [
small [] [
@ -106,24 +107,20 @@ let htmlFoot =
str "Developed"
]
str " and hosted by "
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [ str "Bit Badger Solutions" ]
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [
str "Bit Badger Solutions"
]
]
]
script [
_src "https://unpkg.com/htmx.org@1.5.0"
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
_crossorigin "anonymous"
] []
]
Htmx.Script.minified
script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
]
script [
_async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
_crossorigin "anonymous"
] []
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
_crossorigin "anonymous" ] []
script [] [
rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
@ -137,7 +134,7 @@ let view ctx =
html [ _lang "en" ] [
htmlHead ctx
body [] [
section [ _id "top" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
toaster
htmlFoot
]
@ -147,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 ] ]
]

View File

@ -4,23 +4,26 @@ module MyPrayerJournal.Views.Legal
open Giraffe.ViewEngine
/// View for the "Privacy Policy" page
let privacyPolicy = article [ _class "container mt-3" ] [
let privacyPolicy =
article [ _class "container mt-3" ] [
h2 [ _class "mb-2" ] [ str "Privacy Policy" ]
h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ]
p [] [
str "The nature of the service is one where privacy is a must. The items below will help you understand the data "
str "we collect, access, and store on your behalf as you use this service."
str "The nature of the service is one where privacy is a must. The items below will help you understand "
str "the data we collect, access, and store on your behalf as you use this service."
]
div [ _class "card" ] [
div [ _class "list-group list-group-flush" ] [
div [ _class "list-group-item"] [
h3 [] [ str "Third Party Services" ]
p [ _class "card-text" ] [
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should familiarize "
str "yourself with the privacy policy for "
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should "
str "familiarize yourself with the privacy policy for "
a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ]
str ", as well as your chosen provider ("
a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [ str "Microsoft"]
a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [
str "Microsoft"
]
str " or "
a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ]
str ")."
@ -31,22 +34,23 @@ let privacyPolicy = article [ _class "container mt-3" ] [
h4 [] [ str "Identifying Data" ]
ul [] [
li [] [
rawText "The only identifying data myPrayerJournal stores is the subscriber (&ldquo;sub&rdquo;) field from "
str "the token we receive from Auth0, once you have signed in through their hosted service. All "
str "information is associated with you via this field."
str "The only identifying data myPrayerJournal stores is the subscriber "
rawText "(&ldquo;sub&rdquo;) field from the token we receive from Auth0, once you have "
str "signed in through their hosted service. All information is associated with you via "
str "this field."
]
li [] [
str "While you are signed in, within your browser, the service has access to your first and last names, "
str "along with a URL to the profile picture (provided by your selected identity provider). This "
rawText "information is not transmitted to the server, and is removed when &ldquo;Log Off&rdquo; is "
str "clicked."
str "While you are signed in, within your browser, the service has access to your first "
str "and last names, along with a URL to the profile picture (provided by your selected "
str "identity provider). This information is not transmitted to the server, and is removed "
rawText "when &ldquo;Log Off&rdquo; is clicked."
]
]
h4 [] [ str "User Provided Data" ]
ul [ _class "mb-0" ] [
li [] [
str "myPrayerJournal stores the information you provide, including the text of prayer requests, updates, "
str "and notes; and the date/time when certain actions are taken."
str "myPrayerJournal stores the information you provide, including the text of prayer "
str "requests, updates, and notes; and the date/time when certain actions are taken."
]
]
]
@ -54,35 +58,38 @@ let privacyPolicy = article [ _class "container mt-3" ] [
h3 [] [ str "How Your Data Is Accessed / Secured" ]
ul [ _class "mb-0" ] [
li [] [
str "Your provided data is returned to you, as required, to display your journal or your answered "
str "requests. On the server, it is stored in a controlled-access database."
str "Your provided data is returned to you, as required, to display your journal or your "
str "answered requests. On the server, it is stored in a controlled-access database."
]
li [] [
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; "
str "backups are preserved for the prior 7 days, and backups from the 1"
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a "
str "rolling manner; backups are preserved for the prior 7 days, and backups from the 1"
sup [] [ str "st" ]
str " and 15"
sup [] [ str "th" ]
str " are preserved for 3 months. These backups are stored in a private cloud data repository."
str " are preserved for 3 months. These backups are stored in a private cloud data "
str "repository."
]
li [] [
str "The data collected and stored is the absolute minimum necessary for the functionality of the service. "
rawText "There are no plans to &ldquo;monetize&rdquo; this service, and storing the minimum amount of "
str "information means that the data we have is not interesting to purchasers (or those who may have more "
str "nefarious purposes)."
str "The data collected and stored is the absolute minimum necessary for the functionality "
rawText "of the service. There are no plans to &ldquo;monetize&rdquo; this service, and "
str "storing the minimum amount of information means that the data we have is not "
str "interesting to purchasers (or those who may have more nefarious purposes)."
]
li [] [
str "Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."
str "Access to servers and backups is strictly controlled and monitored for unauthorized "
str "access attempts."
]
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "Removing Your Data" ]
p [ _class "card-text" ] [
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google provide ways "
str "to revoke access from this application. However, if you want your data removed from the database, "
str "please contact daniel at bitbadger.solutions (via e-mail, replacing at with @) prior to doing so, to "
str "ensure we can determine which subscriber ID belongs to you."
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google "
str "provide ways to revoke access from this application. However, if you want your data "
str "removed from the database, please contact daniel at bitbadger.solutions (via e-mail, "
str "replacing at with @) prior to doing so, to ensure we can determine which subscriber ID "
str "belongs to you."
]
]
]
@ -90,7 +97,8 @@ let privacyPolicy = article [ _class "container mt-3" ] [
]
/// View for the "Terms of Service" page
let termsOfService = article [ _class "container mt-3" ] [
let termsOfService =
article [ _class "container mt-3" ] [
h2 [ _class "mb-2" ] [ str "Terms of Service" ]
h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ]
div [ _class "card" ] [
@ -98,17 +106,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [
h3 [] [ str "1. Acceptance of Terms" ]
p [ _class "card-text" ] [
str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you "
str "are responsible to ensure that your use of this site complies with all applicable laws. Your continued "
str "use of this site implies your acceptance of these terms."
str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, "
str "and that you are responsible to ensure that your use of this site complies with all "
str "applicable laws. Your continued use of this site implies your acceptance of these terms."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "2. Description of Service and Registration" ]
p [ _class "card-text" ] [
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer requests. It "
str "requires no registration by itself, but access is granted based on a successful login with an external "
str "identity provider. See "
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer "
str "requests. It requires no registration by itself, but access is granted based on a "
str "successful login with an external identity provider. See "
pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
str " for details on how that information is accessed and stored."
]
@ -116,11 +124,13 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [
h3 [] [ str "3. Third Party Services" ]
p [ _class "card-text" ] [
str "This service utilizes a third-party service provider for identity management. Review the terms of "
str "service for "
str "This service utilizes a third-party service provider for identity management. Review the "
str "terms of service for "
a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"]
str ", as well as those for the selected authorization provider ("
a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [ str "Microsoft"]
a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [
str "Microsoft"
]
str " or "
a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ]
str ")."
@ -129,17 +139,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [
h3 [] [ str "4. Liability" ]
p [ _class "card-text" ] [
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) exists. The "
str "service and its developers may not be held liable for any damages that may arise through the use of "
str "this service."
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) "
str "exists. The service and its developers may not be held liable for any damages that may "
str "arise through the use of this service."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "5. Updates to Terms" ]
p [ _class "card-text" ] [
str "These terms and conditions may be updated at any time, and this service does not have the capability to "
str "notify users when these change. The date at the top of the page will be updated when any of the text of "
str "these terms is updated."
str "These terms and conditions may be updated at any time, and this service does not have the "
str "capability to notify users when these change. The date at the top of the page will be "
str "updated when any of the text of these terms is updated."
]
]
]
@ -150,4 +160,3 @@ let termsOfService = article [ _class "container mt-3" ] [
str " to learn how we handle your data."
]
]

View File

@ -1,108 +1,106 @@
/// Views for request pages and components
module MyPrayerJournal.Views.Request
open Giraffe.Htmx
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
open NodaTime
open System
/// Create a request within the list
let reqListItem now req =
let reqId = RequestId.toString req.requestId
let isAnswered = req.lastStatus = Answered
let isSnoozed = req.snoozedUntil > now
let isPending = (not isSnoozed) && req.showAfter > now
let reqListItem now tz 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 = 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" ]
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"
_hxTarget "this"
_hxSwap HxSwap.OuterHtml ] [
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with
| true -> ()
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
match true with
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isPending -> restoreBtn "show" "Show Now"
| _ -> ()
if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze"
elif isPending then restoreBtn "show" "Show Now"
p [ _class "request-text mb-0" ] [
str req.text
match isSnoozed || isPending || isAnswered with
| true ->
str req.Text
if isSnoozed || isPending || isAnswered then
br []
small [ _class "text-muted" ] [
match () with
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil.Value now tz ]
elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter.Value now tz ]
else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now tz ]
|> em []
]
| false -> ()
]
]
/// Create a list of requests
let reqList now reqs =
let reqList now tz reqs =
reqs
|> List.map (reqListItem now)
|> List.map (reqListItem now tz)
|> div [ _class "list-group" ]
/// View for Active Requests page
let active now reqs = article [ _class "container mt-3" ] [
let active now tz reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Active Requests" ]
match reqs |> List.isEmpty with
| true ->
if List.isEmpty reqs then
noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ]
| false -> reqList now reqs
else reqList now tz reqs
]
/// View for Answered Requests page
let answered now reqs = article [ _class "container mt-3" ] [
let answered now tz reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Answered Requests" ]
match reqs |> List.isEmpty with
| true ->
noResults "No Active Requests" "/journal" "Return to your journal" [
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, "
str "it will appear here"
if List.isEmpty reqs then
noResults "No Answered Requests" "/journal" "Return to your journal" [
str "Your prayer journal has no answered requests; once you have marked one as "
rawText "&ldquo;Answered&rdquo;, it will appear here"
]
| false -> reqList now reqs
else reqList now tz reqs
]
/// View for Snoozed Requests page
let snoozed now reqs = article [ _class "container mt-3" ] [
let snoozed now tz reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
reqList now reqs
reqList now tz reqs
]
/// View for Full Request page
let full (clock : IClock) (req : Request) =
let full (clock : IClock) tz (req : Request) =
let now = clock.GetCurrentInstant ()
let answered =
req.history
|> List.filter RequestAction.isAnswered
|> List.tryHead
|> Option.map (fun x -> x.asOf)
let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0"
req.History
|> Array.filter History.isAnswered
|> Array.tryHead
|> Option.map (fun x -> x.AsOf)
let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0"
let daysOpen =
let asOf = defaultArg answered now
((asOf - (req.history |> List.filter RequestAction.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
req.History
|> 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 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)
req.Notes
|> 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" ]
@ -113,15 +111,16 @@ let full (clock : IClock) (req : Request) =
str "Answered "
date.ToDateTimeOffset().ToString ("D", null) |> str
str " ("
relativeDate date now
relativeDate date now tz
rawText ") &bull; "
| None -> ()
sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText
rawText $"Prayed %s{prayed} times &bull; Open %s{daysOpen} days"
]
p [ _class "card-text" ] [ str lastText ]
]
log
|> List.map (fun it -> li [ _class "list-group-item" ] [
|> List.map (fun it ->
li [ _class "list-group-item" ] [
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
@ -142,40 +141,45 @@ let edit (req : JournalRequest) returnTo isNew =
| "active" -> "/requests/active"
| "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal"
let recurCount =
match req.Recurrence with
| Immediate -> None
| Hours h -> Some h
| Days d -> Some d
| Weeks w -> Some w
|> Option.map string
|> Option.defaultValue ""
article [ _class "container" ] [
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
form [
_hxBoost
form [ _hxBoost
_hxTarget "#top"
_hxPushUrl
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch
] [
input [
_type "hidden"
_hxPushUrl "true"
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
input [ _type "hidden"
_name "requestId"
_value (match isNew with true -> "new" | false -> RequestId.toString req.requestId)
]
_value (match isNew with true -> "new" | false -> RequestId.toString req.RequestId) ]
input [ _type "hidden"; _name "returnTo"; _value returnTo ]
div [ _class "form-floating pb-3" ] [
textarea [
_id "requestText"
textarea [ _id "requestText"
_name "requestText"
_class "form-control"
_style "min-height: 8rem;"
_placeholder "Enter the text of the request"
_autofocus; _required
] [ str req.text ]
_autofocus; _required ] [ str req.Text ]
label [ _for "requestText" ] [ str "Prayer Request" ]
]
br []
match isNew with
| true -> ()
| false ->
if not isNew then
div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ]
br []
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sU"; _name "status"; _value "Updated"; _checked ]
input [ _type "radio"
_class "form-check-input"
_id "sU"
_name "status"
_value "Updated"
_checked ]
label [ _for "sU" ] [ str "Updated" ]
]
div [ _class "form-check form-check-inline" ] [
@ -195,55 +199,53 @@ let edit (req : JournalRequest) returnTo isNew =
]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [
input [
_type "radio"
input [ _type "radio"
_class "form-check-input"
_id "rI"
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> _checked | _ -> ()
]
match req.Recurrence with Immediate -> _checked | _ -> () ]
label [ _for "rI" ] [ str "Immediately" ]
]
div [ _class "form-check mx-2"] [
input [
_type "radio"
input [ _type "radio"
_class "form-check-input"
_id "rO"
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> () | _ -> _checked
]
match req.Recurrence with Immediate -> () | _ -> _checked ]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
div [ _class "form-floating mx-2"] [
input [
_type "number"
input [ _type "number"
_class "form-control"
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value (string req.recurCount)
_value recurCount
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
]
match req.Recurrence with Immediate -> _disabled | _ -> () ]
label [ _for "recurCount" ] [ str "Count" ]
]
div [ _class "form-floating mx-2" ] [
select [
_class "form-control"
select [ _class "form-control"
_id "recurInterval"
_name "recurInterval"
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
] [
option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ]
option [ _value "Days"; match req.recurType with Days -> _selected | _ -> () ] [ str "days" ]
option [ _value "Weeks"; match req.recurType with Weeks -> _selected | _ -> () ] [ str "weeks" ]
match req.Recurrence with Immediate -> _disabled | _ -> () ] [
option [ _value "Hours"; match req.Recurrence with Hours _ -> _selected | _ -> () ] [
str "hours"
]
option [ _value "Days"; match req.Recurrence with Days _ -> _selected | _ -> () ] [
str "days"
]
option [ _value "Weeks"; match req.Recurrence with Weeks _ -> _selected | _ -> () ] [
str "weeks"
]
]
label [ _form "recurInterval" ] [ str "Interval" ]
]
@ -258,9 +260,9 @@ let edit (req : JournalRequest) returnTo isNew =
]
/// Display a list of notes for a request
let notes now notes =
let notes now tz notes =
let toItem (note : Note) =
p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ]
p [] [ small [ _class "text-muted" ] [ relativeDate note.AsOf now tz ]; br []; str note.Notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@ -1,7 +1,7 @@
"use strict"
/** myPrayerJournal script */
const mpj = {
this.mpj = {
/**
* Show a message via toast
* @param {string} message The message to show
@ -66,6 +66,19 @@ const mpj = {
const isDisabled = target.value === "Immediate"
;["recurCount", "recurInterval"].forEach(it => document.getElementById(it).disabled = isDisabled)
}
},
/**
* The time zone of the current browser
* @type {string}
**/
timeZone: undefined,
/**
* Derive the time zone from the current browser
*/
deriveTimeZone () {
try {
this.timeZone = (new Intl.DateTimeFormat()).resolvedOptions().timeZone
} catch (_) { }
}
}
@ -80,3 +93,12 @@ htmx.on("htmx:afterOnLoad", function (evt) {
document.getElementById(evt.detail.xhr.getResponseHeader("x-hide-modal") + "Dismiss").click()
}
})
htmx.on("htmx:configRequest", function (evt) {
// Send the user's current time zone so that we can display local time
if (mpj.timeZone) {
evt.detail.headers["X-Time-Zone"] = mpj.timeZone
}
})
mpj.deriveTimeZone()

File diff suppressed because one or more lines are too long