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

Version 3.1 (#71)

Browse Source 
- Fix request sorting
- Send time zone, so request actions are displayed in local time
- Make recurrence a true DU
- Tweak the data store representation of a few other fields
This commit is contained in:
Daniel J. Summers 2022-07-30 17:02:58 -04:00 committed by GitHub
parent a826275510
commit d621ede7bb
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
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 module MyPrayerJournal.Data
open LiteDB open LiteDB
open NodaTime open MyPrayerJournal
open System
open System.Threading.Tasks open System.Threading.Tasks
// fsharplint:disable MemberNames
/// LiteDB extensions /// LiteDB extensions
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
/// Extensions on the LiteDatabase class /// Extensions on the LiteDatabase class
type LiteDatabase with type LiteDatabase with
/// The Request collection /// The Request collection
member this.requests member this.Requests = this.GetCollection<Request> "request"
with get () = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log) /// Async version of the checkpoint command (flushes log)
member this.saveChanges () = member this.SaveChanges () =
this.Checkpoint () this.Checkpoint ()
Task.CompletedTask Task.CompletedTask
@ -27,72 +25,61 @@ module Extensions =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Mapping = module Mapping =
/// Map a history entry to BSON open NodaTime
let historyToBson (hist : History) : BsonValue = open NodaTime.Text
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
/// Map a BSON document to a history entry /// A NodaTime instant pattern to use for parsing instants from the database
let historyFromBson (doc : BsonValue) = let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
/// Map a note entry to BSON /// Mapping for NodaTime's Instant type
let noteToBson (note : Note) : BsonValue = module Instant =
let doc = BsonDocument () let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds () let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
doc["notes"] <- note.notes
upcast doc
/// Map a BSON document to a note entry /// Mapping for option types
let noteFromBson (doc : BsonValue) = module Option =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64 let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
notes = doc["notes"].AsString let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
}
/// Map a request to its BSON representation let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let requestToBson req : BsonValue = let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
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
/// Map a BSON document to a request /// Mapping for Recurrence
let requestFromBson (doc : BsonValue) = module Recurrence =
{ id = RequestId.ofString doc["_id"].AsString let fromBson (value : BsonValue) = Recurrence.ofString value
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64 let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
userId = UserId doc["userId"].AsString
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64 /// Mapping for RequestAction
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64 module RequestAction =
recurType = Recurrence.ofString doc["recurType"].AsString let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
recurCount = int16 doc["recurCount"].AsInt32 let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq /// 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 /// Set up the mapping
let register () = let register () =
BsonMapper.Global.RegisterType<Request>( BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
Func<Request, BsonValue> requestToBson, Func<BsonValue, Request> requestFromBson) 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 /// Code to be run at startup
module Startup = module Startup =
/// Ensure the database is set up /// Ensure the database is set up
let ensureDb (db : LiteDatabase) = let ensureDb (db : LiteDatabase) =
db.requests.EnsureIndex (fun it -> it.userId) |> ignore db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
Mapping.register () Mapping.register ()
@ -112,98 +99,101 @@ module private Helpers =
/// Async wrapper around a request update /// Async wrapper around a request update
let doUpdate (db : LiteDatabase) (req : Request) = let doUpdate (db : LiteDatabase) (req : Request) =
db.requests.Update req |> ignore db.Requests.Update req |> ignore
Task.CompletedTask Task.CompletedTask
/// Retrieve a request, including its history and notes, by its ID and user ID /// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask { let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None
} }
/// Add a history entry /// Add a history entry
let addHistory reqId userId hist db = backgroundTask { let addHistory reqId userId hist db = backgroundTask {
match! tryFullRequestById reqId userId db with 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" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Add a note /// Add a note
let addNote reqId userId note db = backgroundTask { let addNote reqId userId note db = backgroundTask {
match! tryFullRequestById reqId userId db with 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" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Add a request /// Add a request
let addRequest (req : Request) (db : LiteDatabase) = let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore db.Requests.Insert req |> ignore
// FIXME: make a common function here /// 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 /// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = backgroundTask { let answeredRequests userId db = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let! reqs = getRequestsForUser userId db
return return
reqs reqs
|> Seq.map JournalRequest.ofRequestFull |> Seq.map JournalRequest.ofRequestFull
|> Seq.filter (fun it -> it.lastStatus = Answered) |> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.asOf) |> Seq.sortByDescending (fun it -> it.AsOf)
|> List.ofSeq |> List.ofSeq
} }
/// Retrieve the user's current journal /// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = backgroundTask { let journalByUserId userId db = backgroundTask {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let! reqs = getRequestsForUser userId db
return return
jrnl reqs
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.lastStatus <> Answered) |> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (fun it -> it.asOf) |> Seq.sortBy (fun it -> it.AsOf)
|> List.ofSeq |> List.ofSeq
} }
/// Does the user have any snoozed requests? /// Does the user have any snoozed requests?
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
let! jrnl = journalByUserId userId db let! jrnl = journalByUserId userId db
return jrnl |> List.exists (fun r -> 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) /// Retrieve a request by its ID and user ID (without notes and history)
let tryRequestById reqId userId db = backgroundTask { let tryRequestById reqId userId db = backgroundTask {
let! req = tryFullRequestById reqId userId db 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 /// Retrieve notes for a request by its ID and user ID
let notesById reqId userId (db : LiteDatabase) = backgroundTask { 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 /// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask { let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite return req |> Option.map JournalRequest.ofRequestLite
} }
/// Update the recurrence for a request /// 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 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" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Update a snoozed request /// Update a snoozed request
let updateSnoozed reqId userId until db = backgroundTask { let updateSnoozed reqId userId until db = backgroundTask {
match! tryFullRequestById reqId userId db with 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" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Update the "show after" timestamp for a request /// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask { let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with 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" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }

10
src/MyPrayerJournal/Dates.fs
View File

@ -46,16 +46,14 @@ let twoMonths = 86_400.
open System open System
/// Convert from a JavaScript "ticks" value to a date/time /// Format the distance between two instants in approximate English terms
let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L) let formatDistance (startOn : Instant) (endOn : Instant) =
let formatDistance (startDate : Instant) (endDate : Instant) =
let format (token, number) locale = let format (token, number) locale =
let labels = locales |> Map.find locale let labels = locales |> Map.find locale
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number
let round (it : float) = Math.Round it |> int let round (it : float) = Math.Round it |> int
let diff = startDate - endDate let diff = startOn - endOn
let minutes = Math.Abs diff.TotalMinutes let minutes = Math.Abs diff.TotalMinutes
let formatToken = let formatToken =
let months = minutes / aMonth |> round let months = minutes / aMonth |> round
@ -74,5 +72,5 @@ let formatDistance (startDate : Instant) (endDate : Instant) =
| _ -> AlmostXYears, years + 1 | _ -> AlmostXYears, years + 1
format formatToken "en-US" 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 module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames open System
open Cuid open Cuid
open NodaTime open NodaTime
/// An identifier for a request /// An identifier for a request
type RequestId = type RequestId = RequestId of Cuid
| RequestId of Cuid
/// Functions to manipulate request IDs /// Functions to manipulate request IDs
module RequestId = module RequestId =
/// The string representation of the request ID /// The string representation of the request ID
let toString = function RequestId x -> Cuid.toString x let toString = function RequestId x -> Cuid.toString x
/// Create a request ID from a string representation /// Create a request ID from a string representation
let ofString = Cuid >> RequestId let ofString = Cuid >> RequestId
/// The identifier of a user (the "sub" part of the JWT) /// The identifier of a user (the "sub" part of the JWT)
type UserId = type UserId = UserId of string
| UserId of string
/// Functions to manipulate user IDs /// Functions to manipulate user IDs
module UserId = module UserId =
/// The string representation of the user ID /// The string representation of the user ID
let toString = function UserId x -> x let toString = function UserId x -> x
/// How frequently a request should reappear after it is marked "Prayed" /// How frequently a request should reappear after it is marked "Prayed"
type Recurrence = type Recurrence =
/// A request should reappear immediately at the bottom of the list
| Immediate | Immediate
| Hours
| Days /// A request should reappear in the given number of hours
| Weeks | 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 /// Functions to manipulate recurrences
module Recurrence = module Recurrence =
/// Create a string representation of a recurrence /// Create a string representation of a recurrence
let toString = let toString =
function function
| Immediate -> "Immediate" | Immediate -> "Immediate"
| Hours -> "Hours" | Hours h -> $"{h} Hours"
| Days -> "Days" | Days d -> $"{d} Days"
| Weeks -> "Weeks" | Weeks w -> $"{w} Weeks"
/// Create a recurrence value from a string /// Create a recurrence value from a string
let ofString = let ofString =
function function
| "Immediate" -> Immediate | "Immediate" -> Immediate
| "Hours" -> Hours | it when it.Contains " " ->
| "Days" -> Days let parts = it.Split " "
| "Weeks" -> Weeks 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" | it -> invalidOp $"{it} is not a valid recurrence"
/// An hour's worth of seconds /// An hour's worth of seconds
let private oneHour = 3_600L let private oneHour = 3_600L
/// The duration of the recurrence (in milliseconds) /// The duration of the recurrence (in milliseconds)
let duration x = let duration =
(match x with function
| Immediate -> 0L | Immediate -> 0L
| Hours -> oneHour | Hours h -> int64 h * oneHour
| Days -> oneHour * 24L | Days d -> int64 d * oneHour * 24L
| Weeks -> oneHour * 24L * 7L) | Weeks w -> int64 w * oneHour * 24L * 7L
/// The action taken on a request as part of a history entry /// The action taken on a request as part of a history entry
@ -71,125 +88,9 @@ type RequestAction =
| Updated | Updated
| Answered | 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 /// Functions to manipulate request actions
module RequestAction = module RequestAction =
/// Create a string representation of an action /// Create a string representation of an action
let toString = let toString =
function function
@ -197,6 +98,7 @@ module RequestAction =
| Prayed -> "Prayed" | Prayed -> "Prayed"
| Updated -> "Updated" | Updated -> "Updated"
| Answered -> "Answered" | Answered -> "Answered"
/// Create a RequestAction from a string /// Create a RequestAction from a string
let ofString = let ofString =
function function
@ -205,9 +107,174 @@ module RequestAction =
| "Updated" -> Updated | "Updated" -> Updated
| "Answered" -> Answered | "Answered" -> Answered
| it -> invalidOp $"Bad request action {it}" | it -> invalidOp $"Bad request action {it}"
/// History is a record of action taken on a prayer request, including updates to its text
[<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` /// 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` /// 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` /// 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>] [<RequireQualifiedAccess>]
module MyPrayerJournal.Handlers module MyPrayerJournal.Handlers
// fsharplint:disable RecordFieldNames
open Giraffe open Giraffe
open Giraffe.Htmx open Giraffe.Htmx
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Http
open System open System
open System.Security.Claims
open NodaTime
/// Helper function to be able to split out log on /// Helper function to be able to split out log on
[<AutoOpen>] [<AutoOpen>]
module private LogOnHelpers = module private LogOnHelpers =
open Microsoft.AspNetCore.Authentication
/// Log on, optionally specifying a redirected URL once authentication is complete /// Log on, optionally specifying a redirected URL once authentication is complete
let logOn url : HttpHandler = let logOn url : HttpHandler = fun next ctx -> task {
fun next ctx -> backgroundTask {
match url with match url with
| Some it -> | Some it ->
do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it))
@ -26,79 +21,93 @@ module private LogOnHelpers =
| None -> return! challenge "Auth0" next ctx | None -> return! challenge "Auth0" next ctx
} }
/// Handlers for error conditions /// Handlers for error conditions
module Error = module Error =
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open System.Threading.Tasks
/// Handle errors /// Handle errors
let error (ex : Exception) (log : ILogger) = 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 clearResponse
>=> setStatusCode 500 >=> 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 >=> text ex.Message
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized reponse /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = let notAuthorized : HttpHandler = fun next ctx ->
fun next ctx -> (if ctx.Request.Method = "GET" then logOn None next else setStatusCode 401 earlyReturn) ctx
(next, ctx)
||> match ctx.Request.Method with
| "GET" -> logOn None
| _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler = let notFound : HttpHandler =
setStatusCode 404 >=> text "Not found" setStatusCode 404 >=> text "Not found"
/// Handler helpers open System.Security.Claims
[<AutoOpen>] open LiteDB
module private Helpers = open Microsoft.AspNetCore.Http
open NodaTime
open LiteDB /// Extensions on the HTTP context
open Microsoft.Extensions.Logging type HttpContext with
open Microsoft.Net.Http.Headers
let debug (ctx : HttpContext) message = /// The LiteDB database
let fac = ctx.GetService<ILoggerFactory>() member this.Db = this.GetService<LiteDatabase> ()
let log = fac.CreateLogger "Debug"
log.LogInformation message
/// Get the LiteDB database /// The "sub" for the current user (None if no user is authenticated)
let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>() member this.CurrentUser =
this.User
/// Get the user's "sub" claim
let user (ctx : HttpContext) =
ctx.User
|> Option.ofObj |> Option.ofObj
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)) |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|> Option.flatten |> Option.flatten
|> Option.map (fun claim -> claim.Value) |> Option.map (fun claim -> claim.Value)
/// Get the current user's ID /// The current user's ID
// NOTE: this may raise if you don't run the request through the requiresAuthentication handler first // NOTE: this may raise if you don't run the request through the requireUser handler first
let userId ctx = member this.UserId = UserId this.CurrentUser.Value
(user >> Option.get) ctx |> UserId
/// Get the system clock /// The system clock
let clock (ctx : HttpContext) = member this.Clock = this.GetService<IClock> ()
ctx.GetService<IClock> ()
/// Get the current instant /// Get the current instant from the system clock
let now ctx = member this.Now = this.Clock.GetCurrentInstant
(clock ctx).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 /// Return a 201 CREATED response
let created = let created =
setStatusCode 201 setStatusCode 201
/// Return a 201 CREATED response with the location header set for the created resource /// Return a 201 CREATED response with the location header set for the created resource
let createdAt url : HttpHandler = let createdAt url : HttpHandler = fun next ctx ->
fun next ctx -> Successful.CREATED
(sprintf "%s://%s%s" ctx.Request.Scheme ctx.Request.Host.Value url |> setHttpHeader HeaderNames.Location ($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location) next ctx
>=> created) next ctx
/// Return a 303 SEE OTHER response (forces a GET on the redirected URL) /// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
let seeOther (url : string) = let seeOther (url : string) =
@ -107,50 +116,50 @@ module private Helpers =
/// Render a component result /// Render a component result
let renderComponent nodes : HttpHandler = let renderComponent nodes : HttpHandler =
noResponseCaching noResponseCaching
>=> fun next ctx -> backgroundTask { >=> fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes) return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
} }
open Views.Layout open Views.Layout
open System.Threading.Tasks
/// Create a page rendering context /// Create a page rendering context
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed = backgroundTask { let! hasSnoozed =
match user ctx with match ctx.CurrentUser with
| Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx) | Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
| None -> return false | None -> Task.FromResult false
} return
return { { IsAuthenticated = Option.isSome ctx.CurrentUser
isAuthenticated = (user >> Option.isSome) ctx HasSnoozed = hasSnoozed
hasSnoozed = hasSnoozed CurrentUrl = ctx.Request.Path.Value
currentUrl = ctx.Request.Path.Value PageTitle = pageTitle
pageTitle = pageTitle Content = content
content = content
} }
} }
/// Composable handler to write a view to the output /// Composable handler to write a view to the output
let writeView view : HttpHandler = let writeView view : HttpHandler = fun _ ctx -> backgroundTask {
fun next ctx -> backgroundTask {
return! ctx.WriteHtmlViewAsync view return! ctx.WriteHtmlViewAsync view
} }
/// Hold messages across redirects /// Hold messages across redirects
module Messages = module Messages =
/// The messages being held /// 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 /// Locked update to prevent updates by multiple threads
let private upd8 = obj () let private upd8 = obj ()
/// Push a new message into the list /// Push a new message into the list
let push ctx message url = lock upd8 (fun () -> let push (ctx : HttpContext) message url = lock upd8 (fun () ->
messages <- messages.Add (ctx |> (user >> Option.get), (message, url))) messages <- messages.Add (ctx.UserId, (message, url)))
/// Add a success message header to the response /// Add a success message header to the response
let pushSuccess ctx message url = 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 /// Pop the messages for the given user
let pop userId = lock upd8 (fun () -> let pop userId = lock upd8 (fun () ->
@ -159,17 +168,16 @@ module private Helpers =
msg) msg)
/// Send a partial result if this is not a full page load (does not append no-cache headers) /// Send a partial result if this is not a full page load (does not append no-cache headers)
let partialStatic (pageTitle : string) content : HttpHandler = let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task {
fun next ctx -> backgroundTask {
let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let! pageCtx = pageContext ctx pageTitle content let! pageCtx = pageContext ctx pageTitle content
let view = (match isPartial with true -> partial | false -> view) pageCtx let view = (match isPartial with true -> partial | false -> view) pageCtx
return! return!
(next, ctx) (next, ctx)
||> match user ctx with ||> match ctx.CurrentUser with
| Some u -> | Some _ ->
match Messages.pop u with match Messages.pop ctx.UserId with
| Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> writeView view | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPushUrl url >=> writeView view
| None -> writeView view | None -> writeView view
| None -> writeView view | None -> writeView view
} }
@ -192,34 +200,40 @@ module Models =
/// An additional note /// An additional note
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type NoteEntry = { type NoteEntry =
/// The notes being added { /// The notes being added
notes : string notes : string
} }
/// A prayer request /// A prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = { type Request =
/// The ID of the request { /// The ID of the request
requestId : string requestId : string
/// Where to redirect after saving /// Where to redirect after saving
returnTo : string returnTo : string
/// The text of the request /// The text of the request
requestText : string requestText : string
/// The additional status to record /// The additional status to record
status : string option status : string option
/// The recurrence type /// The recurrence type
recurType : string recurType : string
/// The recurrence count /// The recurrence count
recurCount : int16 option recurCount : int16 option
/// The recurrence interval /// The recurrence interval
recurInterval : string option recurInterval : string option
} }
/// The date until which a request should not appear in the journal /// The date until which a request should not appear in the journal
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type SnoozeUntil = { type SnoozeUntil =
/// The date (YYYY-MM-DD) at which the request should reappear { /// The date (YYYY-MM-DD) at which the request should reappear
until : string until : string
} }
@ -231,41 +245,40 @@ open NodaTime.Text
module Components = module Components =
// GET /components/journal-items // GET /components/journal-items
let journalItems : HttpHandler = let journalItems : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let now = ctx.Now ()
>=> fun next ctx -> backgroundTask { let shouldBeShown (req : JournalRequest) =
let now = now ctx match req.SnoozedUntil, req.ShowAfter with
let! jrnl = Data.journalByUserId (userId ctx) (db ctx) | None, None -> true
let shown = jrnl |> List.filter (fun it -> now > it.snoozedUntil && now > it.showAfter) | Some snooze, Some hide when snooze < now && hide < now -> true
return! renderComponent [ Views.Journal.journalItems now shown ] next ctx | 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] // GET /components/request-item/[req-id]
let requestItem reqId : HttpHandler = let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
>=> fun next ctx -> backgroundTask { | Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx
match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with
| Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /components/request/[req-id]/add-notes // GET /components/request/[req-id]/add-notes
let addNotes requestId : HttpHandler = let addNotes requestId : HttpHandler =
requiresAuthentication Error.notAuthorized requireUser >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
>=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
// GET /components/request/[req-id]/notes // GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
>=> fun next ctx -> backgroundTask { return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx
let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx)
return! renderComponent (Views.Request.notes (now ctx) notes) next ctx
} }
// GET /components/request/[req-id]/snooze // GET /components/request/[req-id]/snooze
let snooze requestId : HttpHandler = let snooze requestId : HttpHandler =
requiresAuthentication Error.notAuthorized requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
>=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
/// / URL /// / URL
@ -280,16 +293,14 @@ module Home =
module Journal = module Journal =
// GET /journal // GET /journal
let journal : HttpHandler = let journal : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let usr = let usr =
ctx.User.Claims ctx.User.Claims
|> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName) |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
|> Option.map (fun c -> c.Value) |> Option.map (fun c -> c.Value)
|> Option.defaultValue "Your" |> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's" 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 = module Request =
// GET /request/[req-id]/edit // GET /request/[req-id]/edit
let edit requestId : HttpHandler = let edit requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let returnTo = 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 "/active" -> "active"
| it when it.EndsWith "/snoozed" -> "snoozed" | it when it.EndsWith "/snoozed" -> "snoozed"
| _ -> "journal" | _ -> "journal"
@ -322,7 +331,7 @@ module Request =
return! partial "Add Prayer Request" return! partial "Add Prayer Request"
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
| _ -> | _ ->
match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
| Some req -> | Some req ->
debug ctx "Found - sending view" debug ctx "Found - sending view"
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
@ -332,117 +341,93 @@ module Request =
} }
// PATCH /request/[req-id]/prayed // PATCH /request/[req-id]/prayed
let prayed requestId : HttpHandler = let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let db = ctx.Db
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let db = db ctx
let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId userId db with
| Some req -> | Some req ->
let now = now ctx let now = ctx.Now ()
do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db
let nextShow = let nextShow =
match Recurrence.duration req.recurType with match Recurrence.duration req.Recurrence with
| 0L -> Instant.MinValue | 0L -> None
| duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount)) | duration -> Some <| now.Plus (Duration.FromSeconds duration)
do! Data.updateShowAfter reqId usrId nextShow db do! Data.updateShowAfter reqId userId nextShow db
do! db.saveChanges () do! db.SaveChanges ()
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
/// POST /request/[req-id]/note /// POST /request/[req-id]/note
let addNote requestId : HttpHandler = let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let db = ctx.Db
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let db = db ctx
let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId userId db with
| Some _ -> | Some _ ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> () let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
do! Data.addNote reqId usrId { asOf = now ctx; notes = notes.notes } db do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
do! db.saveChanges () do! db.SaveChanges ()
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET /requests/active // GET /requests/active
let active : HttpHandler = let active : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let! reqs = Data.journalByUserId ctx.UserId ctx.Db
>=> fun next ctx -> backgroundTask { return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx
let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx
} }
// GET /requests/snoozed // GET /requests/snoozed
let snoozed : HttpHandler = let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let! reqs = Data.journalByUserId ctx.UserId ctx.Db
>=> fun next ctx -> backgroundTask { let now = ctx.Now ()
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let snoozed = reqs
let now = now ctx |> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
let snoozed = reqs |> List.filter (fun it -> it.snoozedUntil > now) return! partial "Snoozed Requests" (Views.Request.snoozed now ctx.TimeZone snoozed) next ctx
return! partial "Active Requests" (Views.Request.snoozed now snoozed) next ctx
} }
// GET /requests/answered // GET /requests/answered
let answered : HttpHandler = let answered : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let! reqs = Data.answeredRequests ctx.UserId ctx.Db
>=> fun next ctx -> backgroundTask { return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx
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
} }
// GET /request/[req-id]/full // GET /request/[req-id]/full
let getFull requestId : HttpHandler = let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with
>=> fun next ctx -> backgroundTask { | Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx
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
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/show // PATCH /request/[req-id]/show
let show requestId : HttpHandler = let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let db = ctx.Db
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let db = db ctx
let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId userId db with
| Some _ -> | Some _ ->
do! Data.updateShowAfter reqId usrId Instant.MinValue db do! Data.updateShowAfter reqId userId None db
do! db.saveChanges () do! db.SaveChanges ()
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/snooze // PATCH /request/[req-id]/snooze
let snooze requestId : HttpHandler = let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let db = ctx.Db
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let db = db ctx
let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId userId db with
| Some _ -> | Some _ ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> () let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
let date = let date =
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc) .AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant () .ToInstant ()
do! Data.updateSnoozed reqId usrId date db do! Data.updateSnoozed reqId userId (Some date) db
do! db.saveChanges () do! db.SaveChanges ()
return! return!
(withSuccessMessage $"Request snoozed until {until.until}" (withSuccessMessage $"Request snoozed until {until.until}"
>=> hideModal "snooze" >=> hideModal "snooze"
@ -451,78 +436,70 @@ module Request =
} }
// PATCH /request/[req-id]/cancel-snooze // PATCH /request/[req-id]/cancel-snooze
let cancelSnooze requestId : HttpHandler = let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized let db = ctx.Db
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let db = db ctx
let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with match! Data.tryRequestById reqId userId db with
| Some _ -> | Some _ ->
do! Data.updateSnoozed reqId usrId Instant.MinValue db do! Data.updateSnoozed reqId userId None db
do! db.saveChanges () do! db.SaveChanges ()
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
/// 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) = let private parseRecurrence (form : Models.Request) =
(Recurrence.ofString (match form.recurInterval with Some x -> x | _ -> "Immediate"), match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate"
defaultArg form.recurCount (int16 0)) |> Recurrence.ofString
// POST /request // POST /request
let add : HttpHandler = let add : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = ctx.Db
let usrId = userId ctx let userId = ctx.UserId
let now = now ctx let now = ctx.Now ()
let (recur, interval) = parseRecurrence form
let req = let req =
{ Request.empty with { Request.empty with
userId = usrId UserId = userId
enteredOn = now EnteredOn = now
showAfter = Instant.MinValue ShowAfter = None
recurType = recur Recurrence = parseRecurrence form
recurCount = interval History = [|
history = [ { AsOf = now
{ asOf = now Status = Created
status = Created Text = Some form.requestText
text = Some form.requestText
} }
] |]
} }
Data.addRequest req db Data.addRequest req db
do! db.saveChanges () do! db.SaveChanges ()
Messages.pushSuccess ctx "Added prayer request" "/journal" Messages.pushSuccess ctx "Added prayer request" "/journal"
return! seeOther "/journal" next ctx return! seeOther "/journal" next ctx
} }
// PATCH /request // PATCH /request
let update : HttpHandler = let update : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = ctx.Db
let usrId = userId ctx let userId = ctx.UserId
match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with
| Some req -> | Some req ->
// update recurrence if changed // update recurrence if changed
let (recur, interval) = parseRecurrence form let recur = parseRecurrence form
match recur = req.recurType && interval = req.recurCount with match recur = req.Recurrence with
| true -> () | true -> ()
| false -> | false ->
do! Data.updateRecurrence req.requestId usrId recur interval db do! Data.updateRecurrence req.RequestId userId recur db
match recur with match recur with
| Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db | Immediate -> do! Data.updateShowAfter req.RequestId userId None db
| _ -> () | _ -> ()
// append history // append history
let upd8Text = form.requestText.Trim () let upd8Text = form.requestText.Trim ()
let text = match upd8Text = req.text with true -> None | false -> Some upd8Text let text = if upd8Text = req.Text then None else Some upd8Text
do! Data.addHistory req.requestId usrId do! Data.addHistory req.RequestId userId
{ asOf = now ctx; status = (Option.get >> RequestAction.ofString) form.status; text = text } db { AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
do! db.saveChanges () do! db.SaveChanges ()
let nextUrl = let nextUrl =
match form.returnTo with match form.returnTo with
| "active" -> "/requests/active" | "active" -> "/requests/active"
@ -537,6 +514,7 @@ module Request =
/// Handlers for /user URLs /// Handlers for /user URLs
module User = module User =
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
// GET /user/log-on // GET /user/log-on
@ -544,9 +522,7 @@ module User =
logOn (Some "/journal") logOn (Some "/journal")
// GET /user/log-off // GET /user/log-off
let logOff : HttpHandler = let logOff : HttpHandler = requireUser >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> task {
do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/")) do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/"))
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
return! next ctx return! next ctx
@ -556,8 +532,8 @@ module User =
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// The routes for myPrayerJournal /// The routes for myPrayerJournal
let routes = let routes = [
[ GET_HEAD [ route "/" Home.home ] GET_HEAD [ route "/" Home.home ]
subRoute "/components/" [ subRoute "/components/" [
GET_HEAD [ GET_HEAD [
route "journal-items" Components.journalItems route "journal-items" Components.journalItems
@ -600,4 +576,4 @@ let routes =
route "log-on" User.logOn route "log-on" User.logOn
] ]
] ]
] ]

17
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

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

68
src/MyPrayerJournal/Program.fs
View File

@ -47,9 +47,7 @@ module Configure =
/// Configure logging /// Configure logging
let logging (bldr : WebApplicationBuilder) = let logging (bldr : WebApplicationBuilder) =
match bldr.Environment.IsDevelopment () with if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
| true -> ()
| false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
bldr.Logging.AddConsole().AddDebug() |> ignore bldr.Logging.AddConsole().AddDebug() |> ignore
bldr bldr
@ -74,27 +72,26 @@ module Configure =
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> () | _, _ -> ()
bldr.Services let _ = bldr.Services.AddRouting ()
.AddRouting() let _ = bldr.Services.AddGiraffe ()
.AddGiraffe() let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
.AddSingleton<IClock>(SystemClock.Instance) let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
.Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) -> let _ =
bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions) opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
.AddAuthentication( let _ =
/// Use HTTP "Bearer" authentication with JWTs bldr.Services.AddAuthentication(fun opts ->
fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme) opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie() .AddCookie()
.AddOpenIdConnect("Auth0", .AddOpenIdConnect("Auth0", fun opts ->
/// Configure OIDC with Auth0 options from configuration // Configure OIDC with Auth0 options from configuration
fun opts ->
let cfg = bldr.Configuration.GetSection "Auth0" let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg["Domain"] opts.Authority <- $"""https://{cfg["Domain"]}/"""
opts.ClientId <- cfg["Id"] opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"] opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code opts.ResponseType <- OpenIdConnectResponseType.Code
@ -118,30 +115,27 @@ module Configure =
| true -> | true ->
// transform to absolute // transform to absolute
let request = ctx.Request 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 | false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s" Uri.EscapeDataString $"&returnTo={finalRedirUri}"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
|> ctx.Response.Redirect
ctx.HandleResponse () ctx.HandleResponse ()
Task.CompletedTask Task.CompletedTask
opts.Events.OnRedirectToIdentityProvider <- fun ctx -> opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
bldr.Scheme <- cfg["Scheme"] bldr.Scheme <- cfg["Scheme"]
bldr.Port <- int cfg["Port"] bldr.Port <- int cfg["Port"]
ctx.ProtocolMessage.RedirectUri <- string bldr ctx.ProtocolMessage.RedirectUri <- string bldr
Task.CompletedTask Task.CompletedTask)
)
|> ignore
let jsonOptions = JsonSerializerOptions () let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ()) jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db") let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
Data.Startup.ensureDb db Data.Startup.ensureDb db
bldr.Services.AddSingleton(jsonOptions) let _ = bldr.Services.AddSingleton jsonOptions
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>() let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
.AddSingleton<LiteDatabase> db let _ = bldr.Services.AddSingleton<LiteDatabase> db
|> ignore
bldr.Build () bldr.Build ()
@ -149,18 +143,12 @@ module Configure =
/// Configure the web application /// Configure the web application
let application (app : WebApplication) = let application (app : WebApplication) =
// match app.Environment.IsDevelopment () with let _ = app.UseStaticFiles ()
// | true -> app.UseDeveloperExceptionPage () let _ = app.UseCookiePolicy ()
// | false -> app.UseGiraffeErrorHandler Handlers.Error.error let _ = app.UseRouting ()
// |> ignore let _ = app.UseAuthentication ()
app let _ = app.UseGiraffeErrorHandler Handlers.Error.error
.UseStaticFiles() let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
.UseCookiePolicy()
.UseRouting()
.UseAuthentication()
.UseGiraffeErrorHandler(Handlers.Error.error)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
|> ignore
app app
/// Compose all the configurations into one /// Compose all the configurations into one

7
src/MyPrayerJournal/Views/Helpers.fs
View File

@ -2,6 +2,7 @@
[<AutoOpen>] [<AutoOpen>]
module private MyPrayerJournal.Views.Helpers module private MyPrayerJournal.Views.Helpers
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
@ -10,7 +11,7 @@ open NodaTime
/// Create a link that targets the `#top` element and pushes a URL to history /// Create a link that targets the `#top` element and pushes a URL to history
let pageLink href attrs = let pageLink href attrs =
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 |> a
/// Create a Material icon /// 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 /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate (date : Instant) now = let relativeDate (date : Instant) now (tz : DateTimeZone) =
span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ] 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 /// Views for journal pages and components
module MyPrayerJournal.Views.Journal module MyPrayerJournal.Views.Journal
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
/// Display a card for this prayer request /// Display a card for this prayer request
let journalCard now req = let journalCard now tz req =
let reqId = RequestId.toString req.requestId let reqId = RequestId.toString req.RequestId
let spacer = span [] [ rawText "&nbsp;" ] let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [ div [ _class "col" ] [
div [ _class "card h-100" ] [ div [ _class "card h-100" ] [
div [ _class "card-header p-0 d-flex"; _roleToolBar ] [ div [ _class "card-header p-0 d-flex"; _roleToolBar ] [
pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ] pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ]
spacer spacer
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_title "Add Notes" _title "Add Notes"
_data "bs-toggle" "modal" _data "bs-toggle" "modal"
_data "bs-target" "#notesModal" _data "bs-target" "#notesModal"
_hxGet $"/components/request/{reqId}/add-notes" _hxGet $"/components/request/{reqId}/add-notes"
_hxTarget "#notesBody" _hxTarget "#notesBody"
_hxSwap HxSwap.InnerHtml _hxSwap HxSwap.InnerHtml ] [
] [ icon "comment" ] icon "comment"
]
spacer spacer
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_title "Snooze Request" _title "Snooze Request"
_data "bs-toggle" "modal" _data "bs-toggle" "modal"
_data "bs-target" "#snoozeModal" _data "bs-target" "#snoozeModal"
_hxGet $"/components/request/{reqId}/snooze" _hxGet $"/components/request/{reqId}/snooze"
_hxTarget "#snoozeBody" _hxTarget "#snoozeBody"
_hxSwap HxSwap.InnerHtml _hxSwap HxSwap.InnerHtml ] [
] [ icon "schedule" ] icon "schedule"
]
div [ _class "flex-grow-1" ] [] div [ _class "flex-grow-1" ] []
button [ button [ _type "button"
_type "button"
_class "btn btn-success w-25" _class "btn btn-success w-25"
_hxPatch $"/request/{reqId}/prayed" _hxPatch $"/request/{reqId}/prayed"
_title "Mark as Prayed" _title "Mark as Prayed" ] [
] [ icon "done" ] icon "done"
]
] ]
div [ _class "card-body" ] [ 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" ] [ 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 /// 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" ] [ h2 [ _class "pb-3" ] [
str user str user
match user with "Your" -> () | _ -> rawText "&rsquo;s" 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 ] [ p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
rawText "Loading your prayer journal&hellip;" rawText "Loading your prayer journal&hellip;"
] ]
div [ div [ _id "notesModal"
_id "notesModal"
_class "modal fade" _class "modal fade"
_tabindex "-1" _tabindex "-1"
_ariaLabelledBy "nodesModalLabel" _ariaLabelledBy "nodesModalLabel"
_ariaHidden "true" _ariaHidden "true" ] [
] [
div [ _class "modal-dialog modal-dialog-scrollable" ] [ div [ _class "modal-dialog modal-dialog-scrollable" ] [
div [ _class "modal-content" ] [ div [ _class "modal-content" ] [
div [ _class "modal-header" ] [ 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-body"; _id "notesBody" ] [ ]
div [ _class "modal-footer" ] [ 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" str "Close"
] ]
] ]
] ]
] ]
] ]
div [ div [ _id "snoozeModal"
_id "snoozeModal"
_class "modal fade" _class "modal fade"
_tabindex "-1" _tabindex "-1"
_ariaLabelledBy "snoozeModalLabel" _ariaLabelledBy "snoozeModalLabel"
_ariaHidden "true" _ariaHidden "true" ] [
] [
div [ _class "modal-dialog modal-sm" ] [ div [ _class "modal-dialog modal-sm" ] [
div [ _class "modal-content" ] [ div [ _class "modal-content" ] [
div [ _class "modal-header" ] [ 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-body"; _id "snoozeBody" ] [ ]
div [ _class "modal-footer" ] [ 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" str "Close"
] ]
] ]
@ -113,7 +121,7 @@ let journal user = article [ _class "container-fluid mt-3" ] [
] ]
/// The journal items /// The journal items
let journalItems now items = let journalItems now tz items =
match items |> List.isEmpty with match items |> List.isEmpty with
| true -> | true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [ noResults "No Active Requests" "/request/new/edit" "Add a Request" [
@ -122,27 +130,24 @@ let journalItems now items =
] ]
| false -> | false ->
items items
|> List.map (journalCard now) |> List.map (journalCard now tz)
|> section [ |> section [ _id "journalItems"
_id "journalItems"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
_hxTarget "this" _hxTarget "this"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml
] _ariaLabel "Prayer Requests" ]
/// The notes edit modal body /// The notes edit modal body
let notesEdit requestId = let notesEdit requestId =
let reqId = RequestId.toString requestId let reqId = RequestId.toString requestId
[ form [ _hxPost $"/request/{reqId}/note" ] [ [ form [ _hxPost $"/request/{reqId}/note" ] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
textarea [ textarea [ _id "notes"
_id "notes"
_name "notes" _name "notes"
_class "form-control" _class "form-control"
_style "min-height: 8rem;" _style "min-height: 8rem;"
_placeholder "Notes" _placeholder "Notes"
_autofocus; _required _autofocus; _required ] [ ]
] [ ]
label [ _for "notes" ] [ str "Notes" ] label [ _for "notes" ] [ str "Notes" ]
] ]
p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add 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" ] hr [ _style "margin: .5rem -1rem" ]
div [ _id "priorNotes" ] [ div [ _id "priorNotes" ] [
p [ _class "text-center pt-3" ] [ p [ _class "text-center pt-3" ] [
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_hxGet $"/components/request/{reqId}/notes" _hxGet $"/components/request/{reqId}/notes"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml
_hxTarget "#priorNotes" _hxTarget "#priorNotes" ] [
] [str "Load Prior Notes" ] str "Load Prior Notes"
]
] ]
] ]
] ]
@ -164,11 +169,9 @@ let notesEdit requestId =
/// The snooze edit form /// The snooze edit form
let snooze requestId = let snooze requestId =
let today = System.DateTime.Today.ToString "yyyy-MM-dd" let today = System.DateTime.Today.ToString "yyyy-MM-dd"
form [ form [ _hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxTarget "#journalItems" _hxTarget "#journalItems"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml ] [
] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ] input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
label [ _for "until" ] [ str "Until" ] label [ _for "until" ] [ str "Until" ]

81
src/MyPrayerJournal/Views/Layout.fs
View File

@ -1,37 +1,40 @@
/// Layout / home views /// Layout / home views
module MyPrayerJournal.Views.Layout module MyPrayerJournal.Views.Layout
// fsharplint:disable RecordFieldNames
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
/// The data needed to render a page-level view /// The data needed to render a page-level view
type PageRenderContext = { type PageRenderContext =
/// Whether the user is authenticated { /// Whether the user is authenticated
isAuthenticated : bool IsAuthenticated : bool
/// Whether the user has snoozed requests /// Whether the user has snoozed requests
hasSnoozed : bool HasSnoozed : bool
/// The current URL /// The current URL
currentUrl : string CurrentUrl : string
/// The title for the page to be rendered /// The title for the page to be rendered
pageTitle : string PageTitle : string
/// The content of the page /// The content of the page
content : XmlNode Content : XmlNode
} }
/// The home page /// The home page
let home = article [ _class "container mt-3" ] [ let home =
article [ _class "container mt-3" ] [
p [] [ rawText "&nbsp;" ] p [] [ rawText "&nbsp;" ]
p [] [ p [] [
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for " str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "them, update them as God moves in the situation, and record a final answer received on that request. It also " str "prayed for them, update them as God moves in the situation, and record a final answer received on "
str "allows individuals to review their answered prayers." str "that request. It also allows individuals to review their answered prayers."
] ]
p [] [ p [] [
str "This site is open and available to the general public. To get started, simply click the " 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 "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "learn more about the site at the &ldquo;Docs&rdquo; link, also above." rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
] ]
] ]
@ -46,16 +49,15 @@ let private navBar ctx =
] ]
seq { seq {
let navLink (matchUrl : string) = 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 |> pageLink matchUrl
match ctx.isAuthenticated with if ctx.IsAuthenticated then
| true ->
li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] 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" ] [ navLink "/requests/answered" [ str "Answered" ] ]
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] 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" ] [ li [ _class "nav-item" ] [
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ] 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 /// 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 /// The HTML `head` element
let htmlHead ctx = let htmlHead ctx =
@ -74,12 +77,10 @@ let htmlHead ctx =
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx titleTag ctx
link [ link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
_href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
_rel "stylesheet" _rel "stylesheet"
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" _integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_crossorigin "anonymous" _crossorigin "anonymous" ]
]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ] link [ _href "/style/style.css"; _rel "stylesheet" ]
] ]
@ -94,7 +95,7 @@ let toaster =
let htmlFoot = let htmlFoot =
footer [ _class "container-fluid" ] [ footer [ _class "container-fluid" ] [
p [ _class "text-muted text-end" ] [ p [ _class "text-muted text-end" ] [
str "myPrayerJournal v3" str "myPrayerJournal v3.1"
br [] br []
em [] [ em [] [
small [] [ small [] [
@ -106,24 +107,20 @@ let htmlFoot =
str "Developed" str "Developed"
] ]
str " and hosted by " 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" Htmx.Script.minified
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
_crossorigin "anonymous"
] []
script [] [ 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 [ script [ _async
_async _src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" _integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" _crossorigin "anonymous" ] []
_crossorigin "anonymous"
] []
script [] [ script [] [
rawText "setTimeout(function () { " rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') " rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
@ -137,7 +134,7 @@ let view ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [
htmlHead ctx htmlHead ctx
body [] [ body [] [
section [ _id "top" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
toaster toaster
htmlFoot htmlFoot
] ]
@ -147,5 +144,5 @@ let view ctx =
let partial ctx = let partial ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [
head [] [ titleTag ctx ] 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 open Giraffe.ViewEngine
/// View for the "Privacy Policy" page /// 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" ] h2 [ _class "mb-2" ] [ str "Privacy Policy" ]
h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ] h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ]
p [] [ p [] [
str "The nature of the service is one where privacy is a must. The items below will help you understand the data " str "The nature of the service is one where privacy is a must. The items below will help you understand "
str "we collect, access, and store on your behalf as you use this service." str "the data we collect, access, and store on your behalf as you use this service."
] ]
div [ _class "card" ] [ div [ _class "card" ] [
div [ _class "list-group list-group-flush" ] [ div [ _class "list-group list-group-flush" ] [
div [ _class "list-group-item"] [ div [ _class "list-group-item"] [
h3 [] [ str "Third Party Services" ] h3 [] [ str "Third Party Services" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should familiarize " str "myPrayerJournal utilizes a third-party authentication and identity provider. You should "
str "yourself with the privacy policy for " str "familiarize yourself with the privacy policy for "
a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ] a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ]
str ", as well as your chosen provider (" 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 " str " or "
a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ] a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ]
str ")." str ")."
@ -31,22 +34,23 @@ let privacyPolicy = article [ _class "container mt-3" ] [
h4 [] [ str "Identifying Data" ] h4 [] [ str "Identifying Data" ]
ul [] [ ul [] [
li [] [ li [] [
rawText "The only identifying data myPrayerJournal stores is the subscriber (&ldquo;sub&rdquo;) field from " str "The only identifying data myPrayerJournal stores is the subscriber "
str "the token we receive from Auth0, once you have signed in through their hosted service. All " rawText "(&ldquo;sub&rdquo;) field from the token we receive from Auth0, once you have "
str "information is associated with you via this field." str "signed in through their hosted service. All information is associated with you via "
str "this field."
] ]
li [] [ li [] [
str "While you are signed in, within your browser, the service has access to your first and last names, " str "While you are signed in, within your browser, the service has access to your first "
str "along with a URL to the profile picture (provided by your selected identity provider). This " str "and last names, along with a URL to the profile picture (provided by your selected "
rawText "information is not transmitted to the server, and is removed when &ldquo;Log Off&rdquo; is " str "identity provider). This information is not transmitted to the server, and is removed "
str "clicked." rawText "when &ldquo;Log Off&rdquo; is clicked."
] ]
] ]
h4 [] [ str "User Provided Data" ] h4 [] [ str "User Provided Data" ]
ul [ _class "mb-0" ] [ ul [ _class "mb-0" ] [
li [] [ li [] [
str "myPrayerJournal stores the information you provide, including the text of prayer requests, updates, " str "myPrayerJournal stores the information you provide, including the text of prayer "
str "and notes; and the date/time when certain actions are taken." 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" ] h3 [] [ str "How Your Data Is Accessed / Secured" ]
ul [ _class "mb-0" ] [ ul [ _class "mb-0" ] [
li [] [ li [] [
str "Your provided data is returned to you, as required, to display your journal or your answered " str "Your provided data is returned to you, as required, to display your journal or your "
str "requests. On the server, it is stored in a controlled-access database." str "answered requests. On the server, it is stored in a controlled-access database."
] ]
li [] [ li [] [
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; " str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a "
str "backups are preserved for the prior 7 days, and backups from the 1" str "rolling manner; backups are preserved for the prior 7 days, and backups from the 1"
sup [] [ str "st" ] sup [] [ str "st" ]
str " and 15" str " and 15"
sup [] [ str "th" ] 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 [] [ li [] [
str "The data collected and stored is the absolute minimum necessary for the functionality of the service. " str "The data collected and stored is the absolute minimum necessary for the functionality "
rawText "There are no plans to &ldquo;monetize&rdquo; this service, and storing the minimum amount of " rawText "of the service. There are no plans to &ldquo;monetize&rdquo; this service, and "
str "information means that the data we have is not interesting to purchasers (or those who may have more " str "storing the minimum amount of information means that the data we have is not "
str "nefarious purposes)." str "interesting to purchasers (or those who may have more nefarious purposes)."
] ]
li [] [ 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" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "Removing Your Data" ] h3 [] [ str "Removing Your Data" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google provide ways " str "At any time, you may choose to discontinue using this service. Both Microsoft and Google "
str "to revoke access from this application. However, if you want your data removed from the database, " str "provide ways to revoke access from this application. However, if you want your data "
str "please contact daniel at bitbadger.solutions (via e-mail, replacing at with @) prior to doing so, to " str "removed from the database, please contact daniel at bitbadger.solutions (via e-mail, "
str "ensure we can determine which subscriber ID belongs to you." 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 /// 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" ] h2 [ _class "mb-2" ] [ str "Terms of Service" ]
h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ] h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ]
div [ _class "card" ] [ div [ _class "card" ] [
@ -98,17 +106,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "1. Acceptance of Terms" ] h3 [] [ str "1. Acceptance of Terms" ]
p [ _class "card-text" ] [ 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 "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, "
str "are responsible to ensure that your use of this site complies with all applicable laws. Your continued " str "and that you are responsible to ensure that your use of this site complies with all "
str "use of this site implies your acceptance of these terms." str "applicable laws. Your continued use of this site implies your acceptance of these terms."
] ]
] ]
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "2. Description of Service and Registration" ] h3 [] [ str "2. Description of Service and Registration" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer requests. It " str "myPrayerJournal is a service that allows individuals to enter and amend their prayer "
str "requires no registration by itself, but access is granted based on a successful login with an external " str "requests. It requires no registration by itself, but access is granted based on a "
str "identity provider. See " str "successful login with an external identity provider. See "
pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ] pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
str " for details on how that information is accessed and stored." 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" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "3. Third Party Services" ] h3 [] [ str "3. Third Party Services" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "This service utilizes a third-party service provider for identity management. Review the terms of " str "This service utilizes a third-party service provider for identity management. Review the "
str "service for " str "terms of service for "
a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"] a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"]
str ", as well as those for the selected authorization provider (" 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 " str " or "
a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ] a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ]
str ")." str ")."
@ -129,17 +139,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "4. Liability" ] h3 [] [ str "4. Liability" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) exists. The " rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) "
str "service and its developers may not be held liable for any damages that may arise through the use of " str "exists. The service and its developers may not be held liable for any damages that may "
str "this service." str "arise through the use of this service."
] ]
] ]
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "5. Updates to Terms" ] h3 [] [ str "5. Updates to Terms" ]
p [ _class "card-text" ] [ 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 "These terms and conditions may be updated at any time, and this service does not have the "
str "notify users when these change. The date at the top of the page will be updated when any of the text of " str "capability to notify users when these change. The date at the top of the page will be "
str "these terms is updated." 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." 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 /// Views for request pages and components
module MyPrayerJournal.Views.Request module MyPrayerJournal.Views.Request
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
open NodaTime open NodaTime
open System
/// Create a request within the list /// Create a request within the list
let reqListItem now req = let reqListItem now tz req =
let reqId = RequestId.toString req.requestId let isFuture instant = defaultArg (instant |> Option.map (fun it -> it > now)) false
let isAnswered = req.lastStatus = Answered let reqId = RequestId.toString req.RequestId
let isSnoozed = req.snoozedUntil > now let isAnswered = req.LastStatus = Answered
let isPending = (not isSnoozed) && req.showAfter > now let isSnoozed = isFuture req.SnoozedUntil
let isPending = (not isSnoozed) && isFuture req.ShowAfter
let btnClass = _class "btn btn-light mx-2" let btnClass = _class "btn btn-light mx-2"
let restoreBtn (link : string) title = let restoreBtn (link : string) title =
button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ] 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" ] pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
| true -> () if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze"
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ] elif isPending then restoreBtn "show" "Show Now"
match true with
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isPending -> restoreBtn "show" "Show Now"
| _ -> ()
p [ _class "request-text mb-0" ] [ p [ _class "request-text mb-0" ] [
str req.text str req.Text
match isSnoozed || isPending || isAnswered with if isSnoozed || isPending || isAnswered then
| true ->
br [] br []
small [ _class "text-muted" ] [ small [ _class "text-muted" ] [
match () with if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil.Value now tz ]
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ] elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter.Value now tz ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ] else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now tz ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em [] |> em []
] ]
| false -> ()
] ]
] ]
/// Create a list of requests /// Create a list of requests
let reqList now reqs = let reqList now tz reqs =
reqs reqs
|> List.map (reqListItem now) |> List.map (reqListItem now tz)
|> div [ _class "list-group" ] |> div [ _class "list-group" ]
/// View for Active Requests page /// 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" ] h2 [ _class "pb-3" ] [ str "Active Requests" ]
match reqs |> List.isEmpty with if List.isEmpty reqs then
| true ->
noResults "No Active Requests" "/journal" "Return to your journal" noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ] [ str "Your prayer journal has no active requests" ]
| false -> reqList now reqs else reqList now tz reqs
] ]
/// View for Answered Requests page /// 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" ] h2 [ _class "pb-3" ] [ str "Answered Requests" ]
match reqs |> List.isEmpty with if List.isEmpty reqs then
| true -> noResults "No Answered Requests" "/journal" "Return to your journal" [
noResults "No Active Requests" "/journal" "Return to your journal" [ str "Your prayer journal has no answered requests; once you have marked one as "
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, " rawText "&ldquo;Answered&rdquo;, it will appear here"
str "it will appear here"
] ]
| false -> reqList now reqs else reqList now tz reqs
] ]
/// View for Snoozed Requests page /// 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" ] h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
reqList now reqs reqList now tz reqs
] ]
/// View for Full Request page /// View for Full Request page
let full (clock : IClock) (req : Request) = let full (clock : IClock) tz (req : Request) =
let now = clock.GetCurrentInstant () let now = clock.GetCurrentInstant ()
let answered = let answered =
req.history req.History
|> List.filter RequestAction.isAnswered |> Array.filter History.isAnswered
|> List.tryHead |> Array.tryHead
|> Option.map (fun x -> x.asOf) |> Option.map (fun x -> x.AsOf)
let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0" let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0"
let daysOpen = let daysOpen =
let asOf = defaultArg answered now 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 = let lastText =
req.history req.History
|> List.filter (fun h -> Option.isSome h.text) |> Array.filter (fun h -> Option.isSome h.Text)
|> List.sortByDescending (fun h -> h.asOf) |> Array.sortByDescending (fun h -> h.AsOf)
|> List.map (fun h -> Option.get h.text) |> Array.map (fun h -> Option.get h.Text)
|> List.head |> Array.head
// The history log including notes (and excluding the final entry for answered requests) // The history log including notes (and excluding the final entry for answered requests)
let log = let log =
let toDisp (h : History) = {| asOf = h.asOf; text = h.text; status = RequestAction.toString h.status |} let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
let all = let all =
req.notes req.Notes
|> List.map (fun n -> {| asOf = n.asOf; text = Some n.notes; status = "Notes" |}) |> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> List.append (req.history |> List.map toDisp) |> Array.append (req.History |> Array.map toDisp)
|> List.sortByDescending (fun it -> it.asOf) |> Array.sortByDescending (fun it -> it.asOf)
|> List.ofArray
// Skip the first entry for answered requests; that info is already displayed // 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" ] [ article [ _class "container mt-3" ] [
div [_class "card" ] [ div [_class "card" ] [
h5 [ _class "card-header" ] [ str "Full Prayer Request" ] h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
@ -113,15 +111,16 @@ let full (clock : IClock) (req : Request) =
str "Answered " str "Answered "
date.ToDateTimeOffset().ToString ("D", null) |> str date.ToDateTimeOffset().ToString ("D", null) |> str
str " (" str " ("
relativeDate date now relativeDate date now tz
rawText ") &bull; " rawText ") &bull; "
| None -> () | 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 ] p [ _class "card-text" ] [ str lastText ]
] ]
log log
|> List.map (fun it -> li [ _class "list-group-item" ] [ |> List.map (fun it ->
li [ _class "list-group-item" ] [
p [ _class "m-0" ] [ p [ _class "m-0" ] [
str it.status str it.status
rawText "&nbsp; " rawText "&nbsp; "
@ -142,40 +141,45 @@ let edit (req : JournalRequest) returnTo isNew =
| "active" -> "/requests/active" | "active" -> "/requests/active"
| "snoozed" -> "/requests/snoozed" | "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal" | _ (* "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" ] [ article [ _class "container" ] [
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ] h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
form [ form [ _hxBoost
_hxBoost
_hxTarget "#top" _hxTarget "#top"
_hxPushUrl _hxPushUrl "true"
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch "/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
] [ input [ _type "hidden"
input [
_type "hidden"
_name "requestId" _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 ] input [ _type "hidden"; _name "returnTo"; _value returnTo ]
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
textarea [ textarea [ _id "requestText"
_id "requestText"
_name "requestText" _name "requestText"
_class "form-control" _class "form-control"
_style "min-height: 8rem;" _style "min-height: 8rem;"
_placeholder "Enter the text of the request" _placeholder "Enter the text of the request"
_autofocus; _required _autofocus; _required ] [ str req.Text ]
] [ str req.text ]
label [ _for "requestText" ] [ str "Prayer Request" ] label [ _for "requestText" ] [ str "Prayer Request" ]
] ]
br [] br []
match isNew with if not isNew then
| true -> ()
| false ->
div [ _class "pb-3" ] [ div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ] label [] [ str "Also Mark As" ]
br [] br []
div [ _class "form-check form-check-inline" ] [ 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" ] label [ _for "sU" ] [ str "Updated" ]
] ]
div [ _class "form-check form-check-inline" ] [ 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 "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [ div [ _class "form-check mx-2" ] [
input [ input [ _type "radio"
_type "radio"
_class "form-check-input" _class "form-check-input"
_id "rI" _id "rI"
_name "recurType" _name "recurType"
_value "Immediate" _value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)" _onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> _checked | _ -> () match req.Recurrence with Immediate -> _checked | _ -> () ]
]
label [ _for "rI" ] [ str "Immediately" ] label [ _for "rI" ] [ str "Immediately" ]
] ]
div [ _class "form-check mx-2"] [ div [ _class "form-check mx-2"] [
input [ input [ _type "radio"
_type "radio"
_class "form-check-input" _class "form-check-input"
_id "rO" _id "rO"
_name "recurType" _name "recurType"
_value "Other" _value "Other"
_onclick "mpj.edit.toggleRecurrence(event)" _onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> () | _ -> _checked match req.Recurrence with Immediate -> () | _ -> _checked ]
]
label [ _for "rO" ] [ rawText "Every&hellip;" ] label [ _for "rO" ] [ rawText "Every&hellip;" ]
] ]
div [ _class "form-floating mx-2"] [ div [ _class "form-floating mx-2"] [
input [ input [ _type "number"
_type "number"
_class "form-control" _class "form-control"
_id "recurCount" _id "recurCount"
_name "recurCount" _name "recurCount"
_placeholder "0" _placeholder "0"
_value (string req.recurCount) _value recurCount
_style "width:6rem;" _style "width:6rem;"
_required _required
match req.recurType with Immediate -> _disabled | _ -> () match req.Recurrence with Immediate -> _disabled | _ -> () ]
]
label [ _for "recurCount" ] [ str "Count" ] label [ _for "recurCount" ] [ str "Count" ]
] ]
div [ _class "form-floating mx-2" ] [ div [ _class "form-floating mx-2" ] [
select [ select [ _class "form-control"
_class "form-control"
_id "recurInterval" _id "recurInterval"
_name "recurInterval" _name "recurInterval"
_style "width:6rem;" _style "width:6rem;"
_required _required
match req.recurType with Immediate -> _disabled | _ -> () match req.Recurrence with Immediate -> _disabled | _ -> () ] [
] [ option [ _value "Hours"; match req.Recurrence with Hours _ -> _selected | _ -> () ] [
option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ] str "hours"
option [ _value "Days"; match req.recurType with Days -> _selected | _ -> () ] [ str "days" ] ]
option [ _value "Weeks"; match req.recurType with Weeks -> _selected | _ -> () ] [ str "weeks" ] 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" ] label [ _form "recurInterval" ] [ str "Interval" ]
] ]
@ -258,9 +260,9 @@ let edit (req : JournalRequest) returnTo isNew =
] ]
/// Display a list of notes for a request /// Display a list of notes for a request
let notes now notes = let notes now tz notes =
let toItem (note : Note) = 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" ] ] [ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ] | [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]

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" "use strict"
/** myPrayerJournal script */ /** myPrayerJournal script */
const mpj = { this.mpj = {
/** /**
* Show a message via toast * Show a message via toast
* @param {string} message The message to show * @param {string} message The message to show
@ -66,6 +66,19 @@ const mpj = {
const isDisabled = target.value === "Immediate" const isDisabled = target.value === "Immediate"
;["recurCount", "recurInterval"].forEach(it => document.getElementById(it).disabled = isDisabled) ;["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() 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