Compare commits

...

15 Commits
3 ... main

Author SHA1 Message Date
24c503385e Merge pull request 'Version 3.4' (#78) from 3.4 into main
Reviewed-on: #78
2024-06-07 23:37:08 +00:00
b393a86bb5 Configure id field 2024-06-07 19:35:17 -04:00
8ee3c6b483 Add documentation and handler (#77) 2024-06-07 12:04:00 -04:00
b07532ab50 Update Dockerfile to .NET 8 (#75)
- Update deps
- Implement newer doc library
2024-06-06 23:07:57 -04:00
b3f62c2586 WIP on update to .NET 8 (#75) 2024-06-06 22:49:57 -04:00
20dcaf6e1b Remove LiteDB/PostgreSQL migration util 2023-10-09 22:19:34 -04:00
b9d81fb7aa
Convert Data Storage to PostgreSQL Documents (#74) 2023-10-09 22:15:38 -04:00
3df5c71d81 Update deps; move to .NET 7
- Update local htmx to v1.9.2
- Get version from assembly
2023-05-23 21:14:08 -04:00
c697001736
Merge pull request #73 from bit-badger/dependabot/nuget/src/MyPrayerJournal/LiteDB-5.0.13
Bump LiteDB from 5.0.12 to 5.0.13 in /src/MyPrayerJournal
2023-05-23 20:11:51 -04:00
dependabot[bot]
6c28cfc1ec
Bump LiteDB from 5.0.12 to 5.0.13 in /src/MyPrayerJournal
Bumps [LiteDB](https://github.com/mbdavid/LiteDB) from 5.0.12 to 5.0.13.
- [Release notes](https://github.com/mbdavid/LiteDB/releases)
- [Commits](https://github.com/mbdavid/LiteDB/compare/v5.0.12...v5.0.13)

---
updated-dependencies:
- dependency-name: LiteDB
  dependency-type: direct:production
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-02-24 16:37:59 +00:00
8702723e01 Fix request ID generation (#72)
- Bump version
2022-08-23 08:36:17 -04:00
d621ede7bb
Version 3.1 (#71)
- 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
2022-07-30 17:02:58 -04:00
a826275510 Add NuGet packages for htmx extensions 2021-11-11 19:17:14 -05:00
2a86e41fe3 Add JetBrains link
Also fix typo
2021-11-03 10:52:42 -04:00
babc77bbd0 Remove v2/v3 migration project 2021-10-26 19:50:51 -04:00
26 changed files with 1991 additions and 1867 deletions

2
.gitignore vendored
View File

@ -254,3 +254,5 @@ paket-files/
# Ionide VSCode extension # Ionide VSCode extension
.ionide .ionide
src/environment.txt

View File

@ -6,6 +6,11 @@ Journaling has a long history; it helps people remember what happened, and the a
myPrayerJournal was borne of out of a personal desire [Daniel](https://github.com/danieljsummers) had to have something that would help him with his prayer life. When it's time to pray, it's not really time to use an app, so the design goal here is to keep it simple and unobtrusive. It will also help eliminate some of the downsides to a paper prayer journal, like not remembering whether you've prayed for a request, or running out of room to write another update on one. myPrayerJournal was borne of out of a personal desire [Daniel](https://github.com/danieljsummers) had to have something that would help him with his prayer life. When it's time to pray, it's not really time to use an app, so the design goal here is to keep it simple and unobtrusive. It will also help eliminate some of the downsides to a paper prayer journal, like not remembering whether you've prayed for a request, or running out of room to write another update on one.
## Futher Reading ## Further Reading
The documentation for the site is at <https://bit-badger.github.io/myPrayerJournal/>. The documentation for the site is at <https://bit-badger.github.io/myPrayerJournal/>.
---
_Thanks to [JetBrains](https://jb.gg/OpenSource) for licensing their awesome toolset to this project._
[<img src="https://resources.jetbrains.com/storage/products/company/brand/logos/jb_beam.png" alt="JetBrains Logo (Main) logo" width="100" height="100">](https://jb.gg/OpenSource)

View File

@ -1,3 +1,3 @@
#!/snap/bin/pwsh #!/snap/bin/pwsh
Set-Location src/MyPrayerJournal Set-Location src/MyPrayerJournal
dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false --nologo

17
src/Dockerfile Normal file
View File

@ -0,0 +1,17 @@
FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
WORKDIR /mpj
COPY ./MyPrayerJournal/MyPrayerJournal.fsproj ./
RUN dotnet restore
COPY ./MyPrayerJournal ./
RUN dotnet publish -c Release -r linux-x64
RUN rm bin/Release/net8.0/linux-x64/publish/appsettings.*.json || true
FROM mcr.microsoft.com/dotnet/aspnet:8.0-alpine as final
WORKDIR /app
RUN apk add --no-cache icu-libs
ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false
COPY --from=build /mpj/bin/Release/net8.0/linux-x64/publish/ ./
EXPOSE 80
CMD [ "dotnet", "/app/MyPrayerJournal.dll" ]

View File

@ -1,22 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Data" Version="4.2.3" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup>
</Project>

View File

@ -1,57 +0,0 @@
open FSharp.Data
open FSharp.Data.CsvExtensions
open LiteDB
open MyPrayerJournal.Domain
open NodaTime
module Subdocs =
open FSharp.Data.JsonExtensions
let history json =
match JsonValue.Parse json with
| JsonValue.Array hist ->
hist
|> Array.map (fun h ->
{ asOf = (h?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
status = h?status.AsString () |> RequestAction.ofString
text = match h?text.AsString () with "" -> None | txt -> Some txt
})
|> List.ofArray
| _ -> []
let notes json =
match JsonValue.Parse json with
| JsonValue.Array notes ->
notes
|> Array.map (fun n ->
{ asOf = (n?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
notes = n?notes.AsString ()
})
|> List.ofArray
| _ -> []
let oldData = CsvFile.Load("data.csv")
let db = new LiteDatabase("Filename=./mpj.db")
MyPrayerJournal.Data.Startup.ensureDb db
let migrated =
oldData.Rows
|> Seq.map (fun r ->
{ id = r["@id"].Replace ("Requests/", "") |> RequestId.ofString
enteredOn = (r?enteredOn.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
userId = UserId r?userId
snoozedUntil = (r?snoozedUntil.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
showAfter = (r?showAfter.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
recurType = r?recurType |> Recurrence.ofString
recurCount = (r?recurCount.AsInteger >> int16) ()
history = Subdocs.history r?history
notes = Subdocs.notes r?notes
})
|> db.GetCollection<Request>("request").Insert
db.Checkpoint ()
printfn $"Migrated {migrated} requests"

26
src/MyPrayerJournal.sln Normal file
View File

@ -0,0 +1,26 @@
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
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.Build.0 = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

View File

@ -1,5 +1,2 @@
## LiteDB database file
*.db
## Development settings ## Development settings
appsettings.Development.json appsettings.Development.json

View File

@ -1,209 +1,202 @@
module MyPrayerJournal.Data module MyPrayerJournal.Data
open LiteDB /// Table(!) used by myPrayerJournal
open NodaTime module Table =
open System
open System.Threading.Tasks
// fsharplint:disable MemberNames /// Requests
[<Literal>]
/// LiteDB extensions let Request = "mpj.request"
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.requests
with get () = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log)
member this.saveChanges () =
this.Checkpoint ()
Task.CompletedTask
/// Map domain to LiteDB /// JSON serialization customizations
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Mapping = module Json =
/// Map a history entry to BSON open System.Text.Json.Serialization
let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
/// Map a BSON document to a history entry /// Convert a wrapped DU to/from its string representation
let historyFromBson (doc : BsonValue) = type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64 inherit JsonConverter<'T>()
status = RequestAction.ofString doc["status"].AsString override _.Read(reader, _, _) =
text = match doc["text"].AsString with "" -> None | txt -> Some txt wrap (reader.GetString())
override _.Write(writer, value, _) =
writer.WriteStringValue(unwrap value)
open System.Text.Json
open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain
let options =
let opts = JsonSerializerOptions()
[ WrappedJsonConverter(Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter(RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter(RequestId.ofString, RequestId.toString)
WrappedJsonConverter(UserId, UserId.toString)
JsonFSharpConverter() ]
|> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
opts
open BitBadger.Documents.Postgres
/// Connection
[<RequireQualifiedAccess>]
module Connection =
open BitBadger.Documents
open Microsoft.Extensions.Configuration
open Npgsql
open System.Text.Json
/// Ensure the database is ready to use
let private ensureDb () = backgroundTask {
do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS mpj" []
do! Definition.ensureTable Table.Request
do! Definition.ensureDocumentIndex Table.Request Optimized
} }
/// Map a note entry to BSON /// Set up the data environment
let noteToBson (note : Note) : BsonValue = let setUp (cfg : IConfiguration) = backgroundTask {
let doc = BsonDocument () let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj")
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds () let _ = builder.UseNodaTime()
doc["notes"] <- note.notes Configuration.useDataSource (builder.Build())
upcast doc Configuration.useIdField "id"
Configuration.useSerializer
/// Map a BSON document to a note entry { new IDocumentSerializer with
let noteFromBson (doc : BsonValue) = member _.Serialize<'T>(it : 'T) = JsonSerializer.Serialize(it, Json.options)
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64 member _.Deserialize<'T>(it : string) = JsonSerializer.Deserialize<'T>(it, Json.options)
notes = doc["notes"].AsString }
do! ensureDb ()
} }
/// Map a request to its BSON representation
let requestToBson req : BsonValue =
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList)
upcast doc
/// Map a BSON document to a request /// Data access functions for requests
let requestFromBson (doc : BsonValue) = [<RequireQualifiedAccess>]
{ id = RequestId.ofString doc["_id"].AsString module Request =
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString open NodaTime
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64 /// Add a request
recurType = Recurrence.ofString doc["recurType"].AsString let add req =
recurCount = int16 doc["recurCount"].AsInt32 insert<Request> Table.Request req
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq /// Does a request exist for the given request ID and user ID?
let existsById (reqId : RequestId) (userId : UserId) =
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
/// Retrieve a request by its ID and user ID
let tryById reqId userId = backgroundTask {
match! Find.byId<string, Request> Table.Request (RequestId.toString reqId) with
| Some req when req.UserId = userId -> return Some req
| _ -> return None
} }
/// Set up the mapping /// Update recurrence for a request
let register () = let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask {
BsonMapper.Global.RegisterType<Request>( let dbId = RequestId.toString reqId
Func<Request, BsonValue> requestToBson, Func<BsonValue, Request> requestFromBson) match! existsById reqId userId with
| true -> do! Patch.byId Table.Request dbId {| Recurrence = recurType |}
/// Code to be run at startup | false -> invalidOp $"Request ID {dbId} not found"
module Startup =
/// Ensure the database is set up
let ensureDb (db : LiteDatabase) =
db.requests.EnsureIndex (fun it -> it.userId) |> ignore
Mapping.register ()
/// Async wrappers for LiteDB, and request -> journal mappings
[<AutoOpen>]
module private Helpers =
open System.Linq
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let toListAsync<'T> (q : 'T seq) =
(q.ToList >> Task.FromResult) ()
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let firstAsync<'T> (q : 'T seq) =
q.FirstOrDefault () |> Task.FromResult
/// Async wrapper around a request update
let doUpdate (db : LiteDatabase) (req : Request) =
db.requests.Update req |> ignore
Task.CompletedTask
/// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
} }
/// Add a history entry /// Update the show-after time for a request
let addHistory reqId userId hist db = backgroundTask { let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
match! tryFullRequestById reqId userId db with let dbId = RequestId.toString reqId
| Some req -> do! doUpdate db { req with history = hist :: req.history } match! existsById reqId userId with
| None -> invalidOp $"{RequestId.toString reqId} not found" | true -> do! Patch.byId Table.Request dbId {| ShowAfter = showAfter |}
| false -> invalidOp $"Request ID {dbId} not found"
} }
/// Add a note /// Update the snoozed and show-after values for a request
let addNote reqId userId note db = backgroundTask { let updateSnoozed reqId userId (until : Instant option) = backgroundTask {
match! tryFullRequestById reqId userId db with let dbId = RequestId.toString reqId
| Some req -> do! doUpdate db { req with notes = note :: req.notes } match! existsById reqId userId with
| None -> invalidOp $"{RequestId.toString reqId} not found" | true -> do! Patch.byId Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
| false -> invalidOp $"Request ID {dbId} not found"
} }
/// Add a request
let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore
// FIXME: make a common function here /// Specific manipulation of history entries
[<RequireQualifiedAccess>]
module History =
/// Retrieve all answered requests for the given user /// Add a history entry
let answeredRequests userId (db : LiteDatabase) = backgroundTask { let add reqId userId hist = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Patch.byId Table.Request dbId {| History = (hist :: req.History) |> List.sortByDescending (_.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found"
}
/// Data access functions for journal-style requests
[<RequireQualifiedAccess>]
module Journal =
/// Retrieve a user's answered requests
let answered (userId : UserId) = backgroundTask {
let! reqs =
Custom.list
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
[ jsonParam "@criteria" {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ == "Answered")""" ]
fromData<Request>
return return
reqs reqs
|> Seq.map JournalRequest.ofRequestFull |> Seq.ofList
|> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.asOf)
|> List.ofSeq
}
/// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = backgroundTask {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
return
jrnl
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.lastStatus <> Answered) |> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortBy (fun it -> it.asOf) |> Seq.sortByDescending (_.AsOf)
|> List.ofSeq |> List.ofSeq
} }
/// Does the user have any snoozed requests? /// Retrieve a user's current prayer journal (includes snoozed and non-immediate recurrence)
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { let forUser (userId : UserId) = backgroundTask {
let! jrnl = journalByUserId userId db let! reqs =
return jrnl |> List.exists (fun r -> r.snoozedUntil > now) Custom.list
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
[ jsonParam "@criteria" {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ <> "Answered")""" ]
fromData<Request>
return
reqs
|> Seq.ofList
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (_.AsOf)
|> List.ofSeq
} }
/// Retrieve a request by its ID and user ID (without notes and history) /// Does the user's journal have any snoozed requests?
let tryRequestById reqId userId db = backgroundTask { let hasSnoozed userId now = backgroundTask {
let! req = tryFullRequestById reqId userId db let! jrnl = forUser userId
return req |> Option.map (fun r -> { r with history = []; notes = [] }) return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
} }
/// Retrieve notes for a request by its ID and user ID let tryById reqId userId = backgroundTask {
let notesById reqId userId (db : LiteDatabase) = backgroundTask { let! req = Request.tryById reqId userId
match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return []
}
/// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite return req |> Option.map JournalRequest.ofRequestLite
} }
/// Update the recurrence for a request
let updateRecurrence reqId userId recurType recurCount db = backgroundTask { /// Specific manipulation of note entries
match! tryFullRequestById reqId userId db with [<RequireQualifiedAccess>]
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount } module Note =
| None -> invalidOp $"{RequestId.toString reqId} not found"
/// Add a note
let add reqId userId note = backgroundTask {
let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Patch.byId Table.Request dbId {| Notes = (note :: req.Notes) |> List.sortByDescending (_.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found"
} }
/// Update a snoozed request /// Retrieve notes for a request by the request ID
let updateSnoozed reqId userId until db = backgroundTask { let byRequestId reqId userId = backgroundTask {
match! tryFullRequestById reqId userId db with match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return []
| Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with showAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
} }

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"

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,173 @@ 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 list
/// The notes for this request
Notes : Note list
}
/// 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 history = Seq.ofList req.History
let lastHistory = Seq.tryHead history
// 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 (_.AsOf) |> Option.defaultValue Instant.MinValue
let showAfter = defaultArg req.ShowAfter Instant.MinValue
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
let lastPrayed =
history
|> Seq.filter History.isPrayed
|> Seq.tryHead
|> Option.map (_.AsOf)
|> Option.defaultValue Instant.MinValue
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id
UserId = req.UserId
Text = history
|> Seq.filter (fun it -> Option.isSome it.Text)
|> Seq.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 = req.History
Notes = req.Notes
}

View File

@ -1,104 +1,111 @@
/// HTTP handlers for the myPrayerJournal API /// HTTP handlers for the myPrayerJournal API
[<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))
return! next ctx return! next ctx
| 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"
open System.Security.Claims
open Microsoft.AspNetCore.Http
open NodaTime
/// Extensions on the HTTP context
type HttpContext with
/// The "sub" for the current user (None if no user is authenticated)
member this.CurrentUser =
this.User
|> Option.ofObj
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|> Option.flatten
|> Option.map (_.Value)
/// The current user's ID
// NOTE: this may raise if you don't run the request through the requireUser handler first
member this.UserId = UserId this.CurrentUser.Value
/// The system clock
member this.Clock = this.GetService<IClock>()
/// Get the current instant from the system clock
member this.Now = this.Clock.GetCurrentInstant
/// Get the time zone from the X-Time-Zone header (default UTC)
member this.TimeZone =
match this.TryGetRequestHeader "X-Time-Zone" with
| Some tz ->
match this.GetService<IDateTimeZoneProvider>().GetZoneOrNull tz with
| null -> DateTimeZone.Utc
| zone -> zone
| None -> DateTimeZone.Utc
open MyPrayerJournal.Data
/// Handler helpers /// Handler helpers
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open LiteDB
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open Microsoft.Net.Http.Headers 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 debug (ctx : HttpContext) message =
let fac = ctx.GetService<ILoggerFactory>() let fac = ctx.GetService<ILoggerFactory>()
let log = fac.CreateLogger "Debug" let log = fac.CreateLogger "Debug"
log.LogInformation message log.LogInformation message
/// Get the LiteDB database
let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>()
/// Get the user's "sub" claim
let user (ctx : HttpContext) =
ctx.User
|> Option.ofObj
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|> Option.flatten
|> Option.map (fun claim -> claim.Value)
/// Get the current user's ID
// NOTE: this may raise if you don't run the request through the requiresAuthentication handler first
let userId ctx =
(user >> Option.get) ctx |> UserId
/// Get the system clock
let clock (ctx : HttpContext) =
ctx.GetService<IClock> ()
/// Get the current instant
let now ctx =
(clock ctx).GetCurrentInstant ()
/// Return a 201 CREATED response /// Return a 201 CREATED response
let created = let created =
setStatusCode 201 setStatusCode 201
/// 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 +114,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 _ -> Journal.hasSnoozed ctx.UserId (ctx.Now())
| 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 +166,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,104 +198,109 @@ 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
} }
open MyPrayerJournal.Data.Extensions
open NodaTime.Text open NodaTime.Text
/// Handlers for less-than-full-page HTML requests /// Handlers for less-than-full-page HTML requests
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 = Journal.forUser ctx.UserId
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! Journal.tryById (RequestId.ofString reqId) ctx.UserId 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 = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
>=> fun next ctx -> backgroundTask { return! renderComponent (Views.Request.notes (ctx.Now()) ctx.TimeZone 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 and documentation
module Home = module Home =
// GET / // GET /
let home : HttpHandler = let home : HttpHandler =
partialStatic "Welcome!" Views.Layout.home partialStatic "Welcome!" Views.Layout.home
// GET /docs
let docs : HttpHandler =
partialStatic "Documentation" Views.Docs.index
/// /journal URL /// /journal URL
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 (_.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&rsquo;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
} }
@ -308,12 +319,12 @@ module Legal =
/// /api/request and /request(s) URLs /// /api/request and /request(s) URLs
module Request = module Request =
open Cuid
// 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 +333,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! Journal.tryById (RequestId.ofString requestId) ctx.UserId 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,197 +343,153 @@ 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 userId = ctx.UserId
>=> fun next ctx -> backgroundTask {
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! Journal.tryById reqId userId 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! History.add reqId userId { AsOf = now; Status = Prayed; Text = None }
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! Request.updateShowAfter reqId userId nextShow
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 userId = ctx.UserId
>=> fun next ctx -> backgroundTask {
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! Request.existsById reqId userId with
| Some _ -> | true ->
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! Note.add reqId userId { AsOf = ctx.Now(); Notes = notes.notes }
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 | false -> 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 = Journal.forUser ctx.UserId
>=> 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 = Journal.forUser ctx.UserId
>=> 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 = Journal.answered ctx.UserId
>=> 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! Request.tryById (RequestId.ofString requestId) ctx.UserId 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 userId = ctx.UserId
>=> fun next ctx -> backgroundTask {
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! Request.existsById reqId userId with
| Some _ -> | true ->
do! Data.updateShowAfter reqId usrId Instant.MinValue db do! Request.updateShowAfter reqId userId None
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 | false -> 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 userId = ctx.UserId
>=> fun next ctx -> backgroundTask {
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! Request.existsById reqId userId with
| Some _ -> | true ->
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! Request.updateSnoozed reqId userId (Some date)
do! db.saveChanges ()
return! return!
(withSuccessMessage $"Request snoozed until {until.until}" (withSuccessMessage $"Request snoozed until {until.until}"
>=> hideModal "snooze" >=> hideModal "snooze"
>=> Components.journalItems) next ctx >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
} }
// 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 userId = ctx.UserId
>=> fun next ctx -> backgroundTask {
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! Request.existsById reqId userId with
| Some _ -> | true ->
do! Data.updateSnoozed reqId usrId Instant.MinValue db do! Request.updateSnoozed reqId userId None
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 | false -> 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 let! form = ctx.BindModelAsync<Models.Request>()
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let! form = ctx.BindModelAsync<Models.Request> () let now = ctx.Now()
let db = db ctx
let usrId = userId ctx
let now = now ctx
let (recur, interval) = parseRecurrence form
let req = let req =
{ Request.empty with { Request.empty with
userId = usrId Id = Cuid.generate () |> RequestId
enteredOn = now UserId = userId
showAfter = Instant.MinValue EnteredOn = now
recurType = recur ShowAfter = None
recurCount = interval Recurrence = parseRecurrence form
history = [ History = [
{ asOf = now { AsOf = now
status = Created Status = Created
text = Some form.requestText Text = Some form.requestText
} }
] ]
} }
Data.addRequest req db do! Request.add req
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 let! form = ctx.BindModelAsync<Models.Request>()
>=> fun next ctx -> backgroundTask { let userId = ctx.UserId
let! form = ctx.BindModelAsync<Models.Request> () // TODO: update the instance and save rather than all these little updates
let db = db ctx match! Journal.tryById (RequestId.ofString form.requestId) userId with
let usrId = userId ctx
match! Data.tryJournalById (RequestId.ofString form.requestId) usrId 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! Request.updateRecurrence req.RequestId userId recur
match recur with match recur with
| Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db | Immediate -> do! Request.updateShowAfter req.RequestId userId None
| _ -> () | _ -> ()
// 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! History.add 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 }
do! db.saveChanges ()
let nextUrl = let nextUrl =
match form.returnTo with match form.returnTo with
| "active" -> "/requests/active" | "active" -> "/requests/active"
@ -537,6 +504,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,10 +512,8 @@ 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 do! ctx.SignOutAsync("Auth0", AuthenticationProperties (RedirectUri = "/"))
>=> fun next ctx -> task {
do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/"))
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
return! next ctx return! next ctx
} }
@ -556,8 +522,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
@ -567,6 +533,7 @@ let routes =
routef "request/%s/snooze" Components.snooze routef "request/%s/snooze" Components.snooze
] ]
] ]
GET_HEAD [ route "/docs" Home.docs ]
GET_HEAD [ route "/journal" Journal.journal ] GET_HEAD [ route "/journal" Journal.journal ]
subRoute "/legal/" [ subRoute "/legal/" [
GET_HEAD [ GET_HEAD [
@ -600,4 +567,4 @@ let routes =
route "log-on" User.logOn route "log-on" User.logOn
] ]
] ]
] ]

View File

@ -1,7 +1,11 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net6.0</TargetFramework> <TargetFramework>net8.0</TargetFramework>
<Version>3.0.0.0</Version> <Version>3.4</Version>
<DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile>
<PublishSingleFile>false</PublishSingleFile>
<SelfContained>false</SelfContained>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Domain.fs" /> <Compile Include="Domain.fs" />
@ -12,20 +16,21 @@
<Compile Include="Views/Layout.fs" /> <Compile Include="Views/Layout.fs" />
<Compile Include="Views/Legal.fs" /> <Compile Include="Views/Legal.fs" />
<Compile Include="Views/Request.fs" /> <Compile Include="Views/Request.fs" />
<Compile Include="Views\Docs.fs" />
<Compile Include="Handlers.fs" /> <Compile Include="Handlers.fs" />
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" /> <PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.3.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.4.0" />
<PackageReference Include="LiteDB" Version="5.0.11" /> <PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
<PackageReference Include="NodaTime" Version="3.0.9" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" />
</ItemGroup> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.2.0" />
<ItemGroup> <PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<ProjectReference Include="../../../Giraffe.Htmx/src/Htmx/Giraffe.Htmx.fsproj" /> <PackageReference Update="FSharp.Core" Version="8.0.300" />
<ProjectReference Include="../../../Giraffe.Htmx/src/ViewEngine.Htmx/Giraffe.ViewEngine.Htmx.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />

View File

@ -1,105 +1,65 @@
module MyPrayerJournal.Api module MyPrayerJournal.Api
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Hosting
open System.IO
/// Configuration functions for the application let sameSite (opts : CookieOptions) =
module Configure =
/// Configure the content root
let contentRoot root =
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open Microsoft.Extensions.Configuration
/// Configure the application configuration
let appConfiguration (bldr : WebApplicationBuilder) =
bldr.Configuration
.SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
.AddEnvironmentVariables ()
|> ignore
bldr
open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json
let kestrel (bldr : WebApplicationBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
bldr
/// Configure the web root directory
let webRoot pathSegments (bldr : WebApplicationBuilder) =
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
bldr
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Hosting
/// Configure logging
let logging (bldr : WebApplicationBuilder) =
match bldr.Environment.IsDevelopment () with
| true -> ()
| false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
bldr.Logging.AddConsole().AddDebug() |> ignore
bldr
open Giraffe
open LiteDB
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Authentication.OpenIdConnect
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open NodaTime
open System
open System.Text.Json
open System.Text.Json.Serialization
open System.Threading.Tasks
/// Configure dependency injection
let services (bldr : WebApplicationBuilder) =
let sameSite (opts : CookieOptions) =
match opts.SameSite, opts.Secure with match opts.SameSite, opts.Secure with
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> () | _, _ -> ()
bldr.Services open Giraffe
.AddRouting() open Giraffe.EndpointRouting
.AddGiraffe() open Microsoft.AspNetCore.Authentication.Cookies
.AddSingleton<IClock>(SystemClock.Instance) open Microsoft.AspNetCore.Authentication.OpenIdConnect
.Configure<CookiePolicyOptions>( open Microsoft.AspNetCore.Builder
fun (opts : CookiePolicyOptions) -> open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Logging
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open MyPrayerJournal.Data
open NodaTime
open System
open System.Text.Json
open System.Threading.Tasks
[<EntryPoint>]
let main args =
//use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
//host.Run ()
let builder = WebApplication.CreateBuilder args
let _ = builder.Configuration.AddEnvironmentVariables "MPJ_"
let svc = builder.Services
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let _ = svc.AddRouting()
let _ = svc.AddGiraffe()
let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ = svc.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
let _ =
svc.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 svc.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 auth0 = cfg.GetSection "Auth0"
let cfg = bldr.Configuration.GetSection "Auth0" opts.Authority <- $"""https://{auth0["Domain"]}/"""
opts.Authority <- sprintf "https://%s/" cfg["Domain"] opts.ClientId <- auth0["Id"]
opts.ClientId <- cfg["Id"] opts.ClientSecret <- auth0["Secret"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear () opts.Scope.Clear()
opts.Scope.Add "openid" opts.Scope.Add "openid"
opts.Scope.Add "profile" opts.Scope.Add "profile"
@ -107,7 +67,7 @@ module Configure =
opts.ClaimsIssuer <- "Auth0" opts.ClaimsIssuer <- "Auth0"
opts.SaveTokens <- true opts.SaveTokens <- true
opts.Events <- OpenIdConnectEvents () opts.Events <- OpenIdConnectEvents()
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
let returnTo = let returnTo =
match ctx.Properties.RedirectUri with match ctx.Properties.RedirectUri with
@ -118,64 +78,34 @@ 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://{auth0["Domain"]}/v2/logout?client_id={auth0["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 uri = UriBuilder ctx.ProtocolMessage.RedirectUri
bldr.Scheme <- cfg["Scheme"] uri.Scheme <- auth0["Scheme"]
bldr.Port <- int cfg["Port"] uri.Port <- int auth0["Port"]
ctx.ProtocolMessage.RedirectUri <- string bldr ctx.ProtocolMessage.RedirectUri <- string uri
Task.CompletedTask Task.CompletedTask)
)
|> ignore
let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
Data.Startup.ensureDb db
bldr.Services.AddSingleton(jsonOptions)
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>()
.AddSingleton<LiteDatabase> db
|> ignore
bldr.Build ()
let _ = svc.AddSingleton<JsonSerializerOptions> Json.options
let _ = svc.AddSingleton<Json.ISerializer>(SystemTextJson.Serializer Json.options)
let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
open Giraffe.EndpointRouting if builder.Environment.IsDevelopment() then builder.Logging.AddFilter(fun l -> l > LogLevel.Information) |> ignore
let _ = builder.Logging.AddConsole().AddDebug() |> ignore
/// Configure the web application use app = builder.Build()
let application (app : WebApplication) = let _ = app.UseStaticFiles()
// match app.Environment.IsDevelopment () with let _ = app.UseCookiePolicy()
// | true -> app.UseDeveloperExceptionPage () let _ = app.UseRouting()
// | false -> app.UseGiraffeErrorHandler Handlers.Error.error let _ = app.UseAuthentication()
// |> ignore let _ = app.UseGiraffeErrorHandler Handlers.Error.error
app let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints Handlers.routes)
.UseStaticFiles()
.UseCookiePolicy()
.UseRouting()
.UseAuthentication()
.UseGiraffeErrorHandler(Handlers.Error.error)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
|> ignore
app
/// Compose all the configurations into one app.Run()
let webHost pathSegments =
contentRoot
>> appConfiguration
>> kestrel
>> webRoot pathSegments
>> logging
>> services
>> application
[<EntryPoint>]
let main _ =
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
host.Run ()
0 0

View File

@ -0,0 +1,184 @@
module MyPrayerJournal.Views.Docs
open Giraffe.ViewEngine
/// The "About myPrayerJournal" section
let private about = [
h3 [ _class "mb-3 mt-4" ] [ rawText "About myPrayerJournal" ]
p [] [
rawText "Journaling has a long history; it helps people remember what happened, and the act of writing helps "
rawText "people think about what happened and process it. A prayer journal is not a new concept; it helps you "
rawText "keep track of the requests for which you've prayed, you can use it to pray over things repeatedly, "
rawText "and you can write the result when the answer comes "; em [] [ rawText "(or it was &ldquo;no&rdquo;)" ]
rawText "."
]
p [] [
rawText "myPrayerJournal was borne of out of a personal desire "
a [ _href "https://daniel.summershome.org"; _target "_blank"; _rel "noopener" ] [ rawText "Daniel" ]
rawText " had to have something that would help him with his prayer life. When it&rsquo;s time to pray, "
rawText "it&rsquo;s not really time to use an app, so the design goal here is to keep it simple and "
rawText "unobtrusive. It will also help eliminate some of the downsides to a paper prayer journal, like not "
rawText "remembering whether you&rsquo;ve prayed for a request, or running out of room to write another update "
rawText "on one."
]
]
/// The "Signing Up" section
let private signUp = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Signing Up" ]
p [] [
rawText "myPrayerJournal uses login services using Google or Microsoft accounts. The only information the "
rawText "application stores in its database is your user Id token it receives from these services, so there "
rawText "are no permissions you should have to accept from these provider other than establishing that you can "
rawText "log on with that account. Because of this, you&rsquo;ll want to pick the same one each time; the "
rawText "tokens between the two accounts are different, even if you use the same e-mail address to log on to "
rawText "both."
]
]
/// The "Your Prayer Journal" section
let private yourJournal = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Your Prayer Journal" ]
p [] [
rawText "Your current requests will be presented in columns (usually three, but it could be more or less, "
rawText "depending on the size of your screen or device). Each request is in its own card, and the buttons at "
rawText "the top of each card apply to that request. The last line of each request also tells you how long it "
rawText "has been since anything has been done on that request. Any time you see something like &ldquo;a few "
rawText "minutes ago,&rdquo; you can hover over that to see the actual date/time the action was taken."
]
]
/// The "Adding a Request" section
let private addRequest = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Adding a Request" ]
p [] [
rawText "To add a request, click the &ldquo;Add a New Request&rdquo; button at the top of your journal. Then, "
rawText "enter the text of the request as you see fit; there is no right or wrong way, and you are the only "
rawText "person who will see the text you enter. When you save the request, it will go to the bottom of the "
rawText "list of requests."
]
]
/// The "Setting Request Recurrence" section
let private setRecurrence = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Setting Request Recurrence" ]
p [] [
rawText "When you add or update a request, you can choose whether requests go to the bottom of the journal "
rawText "once they have been marked &ldquo;Prayed&rdquo; or whether they will reappear after a delay. You can "
rawText "set recurrence in terms of hours, days, or weeks, but it cannot be longer than 365 days. If you "
rawText "decide you want a request to reappear sooner, you can skip the current delay; click the "
rawText "&ldquo;Active&rdquo; menu link, find the request in the list (likely near the bottom), and click the "
rawText "&ldquo;Show Now&rdquo; button."
]
]
/// The "Praying for Requests" section
let private praying = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Praying for Requests" ]
p [] [
rawText "The first button for each request has a checkmark icon; clicking this button will mark the request as "
rawText "&ldquo;Prayed&rdquo; and move it to the bottom of the list (or off, if you&rsquo;ve set a recurrence "
rawText "period for the request). This allows you, if you&rsquo;re praying through your requests, to start at "
rawText "the top left (with the request that it&rsquo;s been the longest since you&rsquo;ve prayed) and click "
rawText "the button as you pray; when the request move below or away, the next-least-recently-prayed request "
rawText "will take the top spot."
]
]
/// The "Editing Requests" section
let private editing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Editing Requests" ]
p [] [
rawText "The second button for each request has a pencil icon. This allows you to edit the text of the "
rawText "request, pretty much the same way you entered it; it starts with the current text, and you can add to "
rawText "it, modify it, or completely replace it. By default, updates will go in with an &ldquo;Updated&rdquo; "
rawText "status; you have the option to also mark this update as &ldquo;Prayed&rdquo; or "
rawText "&ldquo;Answered&rdquo;. Answered requests will drop off the journal list."
]
]
/// The "Adding Notes" section
let private addNotes = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Adding Notes" ]
p [] [
rawText "The third button for each request has an icon that looks like a speech bubble with lines on it; this "
rawText "lets you record notes about the request. If there is something you want to record that doesn&rsquo;t "
rawText "change the text of the request, this is the place to do it. For example, you may be praying for a "
rawText "long-term health issue, and that person tells you that their status is the same; or, you may want to "
rawText "record something God said to you while you were praying for that request."
]
]
/// The "Snoozing Requests" section
let private snoozing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Snoozing Requests" ]
p [] [
rawText "There may be a time where a request does not need to appear. The fourth button, with the clock icon, "
rawText "allows you to snooze requests until the day you specify. Additionally, if you have any snoozed "
rawText "requests, a &ldquo;Snoozed&rdquo; menu item will appear next to the &ldquo;Journal&rdquo; one; this "
rawText "page allows you to see what requests are snoozed, and return them to your journal by canceling the "
rawText "snooze."
]
]
/// The "Viewing a Request and Its History" section
let private viewing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Viewing a Request and Its History" ]
p [] [
rawText "myPrayerJournal tracks all of the actions related to a request; from the &ldquo;Active&rdquo; and "
rawText "&ldquo;Answered&rdquo; menu links (and &ldquo;Snoozed&rdquo;, if it&rsquo;s showing), there is a "
rawText "&ldquo;View Full Request&rdquo; button. That page will show the current text of the request; how many "
rawText "times it has been marked as prayed; how long it has been an active request; and a log of all updates, "
rawText "prayers, and notes you have recorded. That log is listed from most recent to least recent; if you "
rawText "want to read it chronologically, press the &ldquo;End&rdquo; key on your keyboard and read it from "
rawText "the bottom up."
]
p [] [
rawText "The &ldquo;Active&rdquo; link will show all requests that have not yet been marked answered, "
rawText "including snoozed and recurring requests. If requests are snoozed, or in a recurrence period off the "
rawText "journal, there will be a button where you can return the request to the list (either &ldquo;Cancel "
rawText "Snooze&rdquo; or &ldquo;Show Now&rdquo;). The &ldquo;Answered&rdquo; link shows all requests that "
rawText "have been marked answered. The &ldquo;Snoozed&rdquo; link only shows snoozed requests."
]
]
/// The "Final Notes" section
let private finalNotes = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Final Notes" ]
ul [] [
li [] [
rawText "If you encounter errors, please "
a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal/issues"; _target "_blank" ] [
rawText "file an issue"
]; rawText " (or "
a [ _href "mailto:daniel@bitbadger.solutions?subject=myPrayerJournal+Issue" ] [ rawText "e-mail Daniel" ]
rawText " if you do not have an account on that server) with as much detail as possible. You can also "
rawText "provide suggestions, or browse the list of currently open issues."
]
li [] [
rawText "Prayer requests and their history are securely backed up nightly along with other Bit Badger "
rawText "Solutions data."
]
li [] [
rawText "Prayer changes things - most of all, the one doing the praying. I pray that this tool enables you "
rawText "to deepen and strengthen your prayer life."
]
]
]
/// The documentation page
let index =
article [ _class "container mt-3" ] [
h2 [ _class "mb-3" ] [ rawText "Documentation" ]
yield! about
yield! signUp
yield! yourJournal
yield! addRequest
yield! setRecurrence
yield! praying
yield! editing
yield! addNotes
yield! snoozing
yield! viewing
yield! finalNotes
]

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,15 @@ 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 ]
/// The version of myPrayerJournal
let version =
let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
seq {
string v.Major
if v.Minor > 0 then
$".{v.Minor}"
if v.Revision > 0 then $".{v.Revision}"
} |> Seq.reduce (+)

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" ]

View File

@ -1,151 +1,125 @@
/// 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 =
p [] [ rawText "&nbsp;" ] article [ _class "container mt-3" ]
p [] [ [ p [] [ rawText "&nbsp;" ]
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for " p []
str "them, update them as God moves in the situation, and record a final answer received on that request. It also " [ str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "allows individuals to review their answered prayers." str "prayed for them, update them as God moves in the situation, and record a final answer received on "
] str "that request. It also allows individuals to review their answered prayers." ]
p [] [ 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." ] ]
]
]
/// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs /// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs
let private navBar ctx = let private navBar ctx =
nav [ _class "navbar navbar-dark"; _roleNavigation ] [ nav [ _class "navbar navbar-dark"; _roleNavigation ]
div [ _class "container-fluid" ] [ [ div [ _class "container-fluid" ]
pageLink "/" [ _class "navbar-brand" ] [ [ pageLink
span [ _class "m" ] [ str "my" ] "/" [ _class "navbar-brand" ]
[ span [ _class "m" ] [ str "my" ]
span [ _class "p" ] [ str "Prayer" ] span [ _class "p" ] [ str "Prayer" ]
span [ _class "j" ] [ str "Journal" ] span [ _class "j" ] [ str "Journal" ] ]
]
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" ] [ navLink "/docs" [ str "Docs" ] ]
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
]
} }
|> List.ofSeq |> List.ofSeq
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] |> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ] ]
]
]
/// 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 [] [ rawText ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element /// The HTML `head` element
let htmlHead ctx = let htmlHead ctx =
head [ _lang "en" ] [ head [ _lang "en" ]
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.3.2/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-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN"
_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" ] ]
]
/// Element used to display toasts /// Element used to display toasts
let toaster = let toaster =
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [ div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ]
div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] [ div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] ]
]
/// The page's `footer` element /// The page's `footer` element
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 {version}"
br [] br []
em [] [ em []
small [] [ [ small []
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ] [ pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
rawText " &bull; " rawText " &bull; "
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ] pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
rawText " &bull; " rawText " &bull; "
a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [ a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal"
str "Developed" _target "_blank"
] _rel "noopener" ] [ 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" ] ] ] ]
] Htmx.Script.minified
] script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')" ]
script [ script [ _async
_src "https://unpkg.com/htmx.org@1.5.0" _src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI" _integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL"
_crossorigin "anonymous" _crossorigin "anonymous" ] []
] [] script []
script [] [ [ rawText "setTimeout(function () { "
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
]
script [
_async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
_crossorigin "anonymous"
] []
script [] [
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>') "
rawText "}, 2000)" rawText "}, 2000)" ]
] script [ _src "/script/mpj.js" ] [] ]
script [ _src "/script/mpj.js" ] []
]
/// Create the full view of the page /// Create the full view of the page
let view ctx = 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 ] ]
]
]
/// Create a partial view /// Create a partial view
let partial ctx = let partial ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [ head [] [ titleTag ctx ]; body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] ]
head [] [ titleTag ctx ]
body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
]

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."
] ]
] ]

View File

@ -1,108 +1,109 @@
/// 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 |> Seq.ofList
|> List.tryHead |> Seq.filter History.isAnswered
|> Option.map (fun x -> x.asOf) |> Seq.tryHead
let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0" |> Option.map (_.AsOf)
let prayed = (req.History |> List.filter History.isPrayed |> List.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 |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0"
let lastText = let lastText =
req.history req.History
|> List.filter (fun h -> Option.isSome h.text) |> Seq.ofList
|> List.sortByDescending (fun h -> h.asOf) |> Seq.filter (fun h -> Option.isSome h.Text)
|> List.map (fun h -> Option.get h.text) |> Seq.sortByDescending (_.AsOf)
|> List.head |> Seq.map (fun h -> Option.get h.Text)
|> Seq.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" |}) |> Seq.ofList
|> List.append (req.history |> List.map toDisp) |> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> List.sortByDescending (fun it -> it.asOf) |> Seq.append (req.History |> List.map toDisp)
|> Seq.sortByDescending (_.asOf)
|> List.ofSeq
// 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" ]
@ -111,21 +112,22 @@ let full (clock : IClock) (req : Request) =
match answered with match answered with
| Some date -> | Some date ->
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; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ] small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString("D", null) |> str ] ]
] ]
match it.text with match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ] | Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
@ -142,40 +144,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 +202,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 +263,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" ]

View File

@ -1,12 +1,2 @@
{ {
"ConnectionStrings": {
"db": "Filename=./mpj.db"
},
"Kestrel": {
"EndPoints": {
"Http": {
"Url": "http://localhost:3000"
}
}
}
} }

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@ -1,7 +1,7 @@
"use strict" "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()

File diff suppressed because one or more lines are too long