bit-badger/myPrayerJournal
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 36 Activity

Version 3.1 #71

Merged
danieljsummers merged 9 commits from v3.1 into main 2022-07-30 21:02:58 +00:00
Conversation 0 Commits 9 Files Changed 19 +1952 -1676
19 changed files with 1952 additions and 1676 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/MyPrayerJournal.ConvertRecurrence/MyPrayerJournal.ConvertRecurrence.fsproj Normal file
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>

114
src/MyPrayerJournal.ConvertRecurrence/Program.fs Normal file
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

178
src/MyPrayerJournal/Data.fs
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"
}
}

10
src/MyPrayerJournal/Dates.fs
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"

351
src/MyPrayerJournal/Domain.fs
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
}

426
src/MyPrayerJournal/Handlers.fs
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
]
]
]
]

17
src/MyPrayerJournal/MyPrayerJournal.fsproj
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\" />

68
src/MyPrayerJournal/Program.fs
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

7
src/MyPrayerJournal/Views/Helpers.fs
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 ]

91
src/MyPrayerJournal/Views/Journal.fs
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" ]

81
src/MyPrayerJournal/Views/Layout.fs
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 ] ]
]

101
src/MyPrayerJournal/Views/Legal.fs
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."
]
]

196
src/MyPrayerJournal/Views/Request.fs
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" ]

6
src/MyPrayerJournal/wwwroot/script/bootstrap.bundle.min.js vendored
View File

File diff suppressed because one or more lines are too long

1
src/MyPrayerJournal/wwwroot/script/htmx-1.5.0.min.js vendored
View File

File diff suppressed because one or more lines are too long

65
src/MyPrayerJournal/wwwroot/script/htmx.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

24
src/MyPrayerJournal/wwwroot/script/mpj.js
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()

8
src/MyPrayerJournal/wwwroot/style/bootstrap.min.css vendored
View File

File diff suppressed because one or more lines are too long