Compare commits

..

No commits in common. "main" and "3" have entirely different histories.
main ... 3

26 changed files with 1866 additions and 1990 deletions

2
.gitignore vendored
View File

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

View File

@ -6,11 +6,6 @@ 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.
## Further Reading ## Futher 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 --nologo dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false

View File

@ -1,17 +0,0 @@
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

@ -0,0 +1,22 @@
<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

@ -0,0 +1,57 @@
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"

View File

@ -1,26 +0,0 @@
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,2 +1,5 @@
## LiteDB database file
*.db
## Development settings ## Development settings
appsettings.Development.json appsettings.Development.json

View File

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

View File

@ -5,39 +5,39 @@ module MyPrayerJournal.Dates
open NodaTime open NodaTime
type internal FormatDistanceToken = type internal FormatDistanceToken =
| LessThanXMinutes | LessThanXMinutes
| XMinutes | XMinutes
| AboutXHours | AboutXHours
| XHours | XHours
| XDays | XDays
| AboutXWeeks | AboutXWeeks
| XWeeks | XWeeks
| AboutXMonths | AboutXMonths
| XMonths | XMonths
| AboutXYears | AboutXYears
| XYears | XYears
| OverXYears | OverXYears
| AlmostXYears | AlmostXYears
let internal locales = let internal locales =
let format = PrintfFormat<int -> string, unit, string, string> let format = PrintfFormat<int -> string, unit, string, string>
Map.ofList [ Map.ofList [
"en-US", Map.ofList [ "en-US", Map.ofList [
LessThanXMinutes, ("less than a minute", format "less than %i minutes") LessThanXMinutes, ("less than a minute", format "less than %i minutes")
XMinutes, ("a minute", format "%i minutes") XMinutes, ("a minute", format "%i minutes")
AboutXHours, ("about an hour", format "about %i hours") AboutXHours, ("about an hour", format "about %i hours")
XHours, ("an hour", format "%i hours") XHours, ("an hour", format "%i hours")
XDays, ("a day", format "%i days") XDays, ("a day", format "%i days")
AboutXWeeks, ("about a week", format "about %i weeks") AboutXWeeks, ("about a week", format "about %i weeks")
XWeeks, ("a week", format "%i weeks") XWeeks, ("a week", format "%i weeks")
AboutXMonths, ("about a month", format "about %i months") AboutXMonths, ("about a month", format "about %i months")
XMonths, ("a month", format "%i months") XMonths, ("a month", format "%i months")
AboutXYears, ("about a year", format "about %i years") AboutXYears, ("about a year", format "about %i years")
XYears, ("a year", format "%i years") XYears, ("a year", format "%i years")
OverXYears, ("over a year", format "over %i years") OverXYears, ("over a year", format "over %i years")
AlmostXYears, ("almost a year", format "almost %i years") AlmostXYears, ("almost a year", format "almost %i years")
]
] ]
]
let aDay = 1_440. let aDay = 1_440.
let almost2Days = 2_520. let almost2Days = 2_520.
@ -46,31 +46,33 @@ let twoMonths = 86_400.
open System open System
/// Format the distance between two instants in approximate English terms /// Convert from a JavaScript "ticks" value to a date/time
let formatDistance (startOn : Instant) (endOn : Instant) = let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
let format (token, number) locale =
let labels = locales |> Map.find locale
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number
let round (it : float) = Math.Round it |> int
let diff = startOn - endOn let formatDistance (startDate : Instant) (endDate : Instant) =
let minutes = Math.Abs diff.TotalMinutes let format (token, number) locale =
let formatToken = let labels = locales |> Map.find locale
let months = minutes / aMonth |> round match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number
let years = months / 12 let round (it : float) = Math.Round it |> int
match true with
| _ when minutes < 1. -> LessThanXMinutes, 1 let diff = startDate - endDate
| _ when minutes < 45. -> XMinutes, round minutes let minutes = Math.Abs diff.TotalMinutes
| _ when minutes < 90. -> AboutXHours, 1 let formatToken =
| _ when minutes < aDay -> AboutXHours, round (minutes / 60.) let months = minutes / aMonth |> round
| _ when minutes < almost2Days -> XDays, 1 let years = months / 12
| _ when minutes < aMonth -> XDays, round (minutes / aDay) match true with
| _ when minutes < twoMonths -> AboutXMonths, round (minutes / aMonth) | _ when minutes < 1. -> LessThanXMinutes, 1
| _ when months < 12 -> XMonths, round (minutes / aMonth) | _ when minutes < 45. -> XMinutes, round minutes
| _ when months % 12 < 3 -> AboutXYears, years | _ when minutes < 90. -> AboutXHours, 1
| _ when months % 12 < 9 -> OverXYears, years | _ when minutes < aDay -> AboutXHours, round (minutes / 60.)
| _ -> AlmostXYears, years + 1 | _ when minutes < almost2Days -> XDays, 1
| _ when minutes < aMonth -> XDays, round (minutes / aDay)
| _ when minutes < twoMonths -> AboutXMonths, round (minutes / aMonth)
| _ when months < 12 -> XMonths, round (minutes / aMonth)
| _ when months % 12 < 3 -> AboutXYears, years
| _ when months % 12 < 9 -> OverXYears, years
| _ -> AlmostXYears, years + 1
format formatToken "en-US" format formatToken "en-US"
|> match startOn > endOn with true -> sprintf "%s ago" | false -> sprintf "in %s" |> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s"

View File

@ -1,279 +1,213 @@
[<AutoOpen>]
/// The data model for myPrayerJournal /// The data model for myPrayerJournal
[<AutoOpen>]
module MyPrayerJournal.Domain module MyPrayerJournal.Domain
open System // fsharplint:disable RecordFieldNames
open Cuid open Cuid
open NodaTime open NodaTime
/// An identifier for a request /// An identifier for a request
type RequestId = RequestId of Cuid type RequestId =
| 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
let ofString = Cuid >> RequestId
/// Create a request ID from a string representation
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 = UserId of string type UserId =
| 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 =
| Immediate
/// A request should reappear immediately at the bottom of the list | Hours
| Immediate | Days
| Weeks
/// A request should reappear in the given number of hours
| Hours of int16
/// A request should reappear in the given number of days
| Days of int16
/// A request should reappear in the given number of weeks (7-day increments)
| Weeks of int16
/// Functions to manipulate recurrences /// 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
let ofString =
/// Create a recurrence value from a string function
let ofString = | "Immediate" -> Immediate
function | "Hours" -> Hours
| "Immediate" -> Immediate | "Days" -> Days
| it when it.Contains " " -> | "Weeks" -> Weeks
let parts = it.Split " " | it -> invalidOp $"{it} is not a valid recurrence"
let length = Convert.ToInt16 parts[0] /// An hour's worth of seconds
match parts[1] with let private oneHour = 3_600L
| "Hours" -> Hours length /// The duration of the recurrence (in milliseconds)
| "Days" -> Days length let duration x =
| "Weeks" -> Weeks length (match x with
| _ -> invalidOp $"{parts[1]} is not a valid recurrence" | Immediate -> 0L
| it -> invalidOp $"{it} is not a valid recurrence" | Hours -> oneHour
| Days -> oneHour * 24L
/// An hour's worth of seconds | Weeks -> oneHour * 24L * 7L)
let private oneHour = 3_600L
/// The duration of the recurrence (in milliseconds)
let duration =
function
| Immediate -> 0L
| Hours h -> int64 h * oneHour
| Days d -> int64 d * oneHour * 24L
| Weeks w -> int64 w * oneHour * 24L * 7L
/// The action taken on a request as part of a history entry /// The action taken on a request as part of a history entry
type RequestAction = type RequestAction =
| Created | Created
| Prayed | Prayed
| Updated | Updated
| Answered | Answered
/// Functions to manipulate request actions
module RequestAction =
/// Create a string representation of an action
let toString =
function
| Created -> "Created"
| Prayed -> "Prayed"
| Updated -> "Updated"
| Answered -> "Answered"
/// Create a RequestAction from a string
let ofString =
function
| "Created" -> Created
| "Prayed" -> Prayed
| "Updated" -> Updated
| "Answered" -> Answered
| it -> invalidOp $"Bad request action {it}"
/// History is a record of action taken on a prayer request, including updates to its text /// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type History = type History = {
{ /// The time when this history entry was made /// The time when this history entry was made
AsOf : Instant asOf : Instant
/// The status for this history entry
/// The status for this history entry status : RequestAction
Status : RequestAction /// The text of the update, if applicable
text : string option
/// The text of the update, if applicable }
Text : string option
}
/// Functions to manipulate history entries
module History =
/// Determine if a history's status is `Created`
let isCreated hist = hist.Status = Created
/// Determine if a history's status is `Prayed`
let isPrayed hist = hist.Status = Prayed
/// Determine if a history's status is `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 /// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Note = type Note = {
{ /// The time when this note was made /// The time when this note was made
AsOf : Instant asOf : Instant
/// The text of the notes
/// The text of the notes notes : string
Notes : string }
}
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = type Request = {
{ /// The ID of the request /// The ID of the request
Id : RequestId id : RequestId
/// The time this request was initially entered
/// The time this request was initially entered enteredOn : Instant
EnteredOn : Instant /// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId
/// The ID of the user to whom this request belongs ("sub" from the JWT) /// The time at which this request should reappear in the user's journal by manual user choice
UserId : UserId snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence
/// The time at which this request should reappear in the user's journal by manual user choice showAfter : Instant
SnoozedUntil : Instant option /// The type of recurrence for this request
recurType : Recurrence
/// The time at which this request should reappear in the user's journal by recurrence /// How many of the recurrence intervals should occur between appearances in the journal
ShowAfter : Instant option recurCount : int16
/// The history entries for this request
/// The recurrence for this request history : History list
Recurrence : Recurrence /// The notes for this request
notes : Note list
/// The history entries for this request }
History : History list with
/// An empty request
/// The notes for this request static member empty =
Notes : Note list { id = Cuid.generate () |> RequestId
} enteredOn = Instant.MinValue
userId = UserId ""
/// Functions to support requests snoozedUntil = Instant.MinValue
module Request = showAfter = Instant.MinValue
recurType = Immediate
/// An empty request recurCount = 0s
let empty = history = []
{ Id = Cuid.generate () |> RequestId notes = []
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 /// 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. /// properties that may be filled for history and notes.
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type JournalRequest = type JournalRequest = {
{ /// The ID of the request (just the CUID part) /// The ID of the request (just the CUID part)
RequestId : RequestId requestId : RequestId
/// The ID of the user to whom the request belongs
/// The ID of the user to whom the request belongs userId : UserId
UserId : UserId /// The current text of the request
text : string
/// The current text of the request /// The last time action was taken on the request
Text : string asOf : Instant
/// The last status for the request
/// The last time action was taken on the request lastStatus : RequestAction
AsOf : Instant /// The time that this request should reappear in the user's journal
snoozedUntil : Instant
/// The last time a request was marked as prayed /// The time after which this request should reappear in the user's journal by configured recurrence
LastPrayed : Instant option showAfter : Instant
/// The type of recurrence for this request
/// The last status for the request recurType : Recurrence
LastStatus : RequestAction /// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// The time that this request should reappear in the user's journal /// History entries for the request
SnoozedUntil : Instant option history : History list
/// Note entries for the request
/// The time after which this request should reappear in the user's journal by configured recurrence notes : Note list
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 /// Functions to manipulate journal requests
module JournalRequest = module JournalRequest =
/// Convert a request to the form used for the journal (precomputed values, no notes or history) /// Convert a request to the form used for the journal (precomputed values, no notes or history)
let ofRequestLite (req : Request) = let ofRequestLite (req : Request) =
let history = Seq.ofList req.History let hist = req.history |> List.sortByDescending (fun it -> it.asOf) |> List.tryHead
let lastHistory = Seq.tryHead history { requestId = req.id
// Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the userId = req.userId
// largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled, text = req.history
// we will use the last activity date. This will mean that: |> List.filter (fun it -> Option.isSome it.text)
// - Immediately shown requests will be at the top of the list, in order from least recently prayed to most. |> List.sortByDescending (fun it -> it.asOf)
// - Non-immediate requests will enter the list as if they were marked as prayed at that time; this will put |> List.tryHead
// them at the bottom of the list. |> Option.map (fun h -> Option.get h.text)
// - Snoozed requests will reappear at the bottom of the list when they return. |> Option.defaultValue ""
// - New requests will go to the bottom of the list, but will rise as others are marked as prayed. asOf = match hist with Some h -> h.asOf | None -> Instant.MinValue
let lastActivity = lastHistory |> Option.map (_.AsOf) |> Option.defaultValue Instant.MinValue lastStatus = match hist with Some h -> h.status | None -> Created
let showAfter = defaultArg req.ShowAfter Instant.MinValue snoozedUntil = req.snoozedUntil
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue showAfter = req.showAfter
let lastPrayed = recurType = req.recurType
history recurCount = req.recurCount
|> Seq.filter History.isPrayed history = []
|> Seq.tryHead notes = []
|> 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 /// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req = let ofRequestFull req =
{ ofRequestLite req with { ofRequestLite req with
History = req.History history = req.history
Notes = req.Notes notes = req.notes
} }
/// Functions to manipulate request actions
module RequestAction =
/// Create a string representation of an action
let toString =
function
| Created -> "Created"
| Prayed -> "Prayed"
| Updated -> "Updated"
| Answered -> "Answered"
/// Create a RequestAction from a string
let ofString =
function
| "Created" -> Created
| "Prayed" -> Prayed
| "Updated" -> Updated
| "Answered" -> Answered
| it -> invalidOp $"Bad request action {it}"
/// Determine if a history's status is `Created`
let isCreated hist = hist.status = Created
/// Determine if a history's status is `Prayed`
let isPrayed hist = hist.status = Prayed
/// Determine if a history's status is `Answered`
let isAnswered hist = hist.status = Answered

File diff suppressed because it is too large Load Diff

View File

@ -1,11 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net8.0</TargetFramework> <TargetFramework>net6.0</TargetFramework>
<Version>3.4</Version> <Version>3.0.0.0</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" />
@ -16,21 +12,20 @@
<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="BitBadger.Documents.Postgres" Version="3.1.0" /> <PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
<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="6.4.0" /> <PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" /> <PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" /> <PackageReference Include="NodaTime" Version="3.0.9" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.2.0" /> </ItemGroup>
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" /> <ItemGroup>
<PackageReference Update="FSharp.Core" Version="8.0.300" /> <ProjectReference Include="../../../Giraffe.Htmx/src/Htmx/Giraffe.Htmx.fsproj" />
<ProjectReference Include="../../../Giraffe.Htmx/src/ViewEngine.Htmx/Giraffe.ViewEngine.Htmx.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />

View File

@ -1,111 +1,181 @@
module MyPrayerJournal.Api module MyPrayerJournal.Api
open Microsoft.AspNetCore.Http
let sameSite (opts : CookieOptions) =
match opts.SameSite, opts.Secure with
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> ()
open Giraffe
open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Authentication.OpenIdConnect
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides open Microsoft.AspNetCore.Hosting
open Microsoft.Extensions.Configuration open System.IO
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting /// Configuration functions for the application
open Microsoft.Extensions.Logging module Configure =
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open MyPrayerJournal.Data /// Configure the content root
open NodaTime let contentRoot root =
open System WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open System.Text.Json
open System.Threading.Tasks
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
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> ()
bldr.Services
.AddRouting()
.AddGiraffe()
.AddSingleton<IClock>(SystemClock.Instance)
.Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
.AddAuthentication(
/// Use HTTP "Bearer" authentication with JWTs
fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie()
.AddOpenIdConnect("Auth0",
/// Configure OIDC with Auth0 options from configuration
fun opts ->
let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg["Domain"]
opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear ()
opts.Scope.Add "openid"
opts.Scope.Add "profile"
opts.CallbackPath <- PathString "/user/log-on/success"
opts.ClaimsIssuer <- "Auth0"
opts.SaveTokens <- true
opts.Events <- OpenIdConnectEvents ()
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
let returnTo =
match ctx.Properties.RedirectUri with
| it when isNull it || it = "" -> ""
| redirUri ->
let finalRedirUri =
match redirUri.StartsWith "/" with
| true ->
// transform to absolute
let request = ctx.Request
sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
| false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
|> ctx.Response.Redirect
ctx.HandleResponse ()
Task.CompletedTask
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
bldr.Scheme <- cfg["Scheme"]
bldr.Port <- int cfg["Port"]
ctx.ProtocolMessage.RedirectUri <- string bldr
Task.CompletedTask
)
|> ignore
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 ()
open Giraffe.EndpointRouting
/// Configure the web application
let application (app : WebApplication) =
// match app.Environment.IsDevelopment () with
// | true -> app.UseDeveloperExceptionPage ()
// | false -> app.UseGiraffeErrorHandler Handlers.Error.error
// |> ignore
app
.UseStaticFiles()
.UseCookiePolicy()
.UseRouting()
.UseAuthentication()
.UseGiraffeErrorHandler(Handlers.Error.error)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
|> ignore
app
/// Compose all the configurations into one
let webHost pathSegments =
contentRoot
>> appConfiguration
>> kestrel
>> webRoot pathSegments
>> logging
>> services
>> application
[<EntryPoint>] [<EntryPoint>]
let main args = let main _ =
//use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
//host.Run () host.Run ()
let builder = WebApplication.CreateBuilder args 0
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.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
let _ =
svc.AddAuthentication(fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie()
.AddOpenIdConnect("Auth0", fun opts ->
// Configure OIDC with Auth0 options from configuration
let auth0 = cfg.GetSection "Auth0"
opts.Authority <- $"""https://{auth0["Domain"]}/"""
opts.ClientId <- auth0["Id"]
opts.ClientSecret <- auth0["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear()
opts.Scope.Add "openid"
opts.Scope.Add "profile"
opts.CallbackPath <- PathString "/user/log-on/success"
opts.ClaimsIssuer <- "Auth0"
opts.SaveTokens <- true
opts.Events <- OpenIdConnectEvents()
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
let returnTo =
match ctx.Properties.RedirectUri with
| it when isNull it || it = "" -> ""
| redirUri ->
let finalRedirUri =
match redirUri.StartsWith "/" with
| true ->
// transform to absolute
let request = ctx.Request
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
| false -> redirUri
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}"""
ctx.HandleResponse()
Task.CompletedTask
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let uri = UriBuilder ctx.ProtocolMessage.RedirectUri
uri.Scheme <- auth0["Scheme"]
uri.Port <- int auth0["Port"]
ctx.ProtocolMessage.RedirectUri <- string uri
Task.CompletedTask)
let _ = svc.AddSingleton<JsonSerializerOptions> Json.options
let _ = svc.AddSingleton<Json.ISerializer>(SystemTextJson.Serializer Json.options)
let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
if builder.Environment.IsDevelopment() then builder.Logging.AddFilter(fun l -> l > LogLevel.Information) |> ignore
let _ = builder.Logging.AddConsole().AddDebug() |> ignore
use app = builder.Build()
let _ = app.UseStaticFiles()
let _ = app.UseCookiePolicy()
let _ = app.UseRouting()
let _ = app.UseAuthentication()
let _ = app.UseGiraffeErrorHandler Handlers.Error.error
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints Handlers.routes)
app.Run()
0

View File

@ -1,184 +0,0 @@
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,7 +2,6 @@
[<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,33 +9,23 @@ 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 "true" ] |> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ]
|> a |> a
/// Create a Material icon /// Create a Material icon
let icon name = span [ _class "material-icons" ] [ str name ] let icon name = span [ _class "material-icons" ] [ str name ]
/// Create a card when there are no results found /// Create a card when there are no results found
let noResults heading link buttonText text = let noResults heading link buttonText text =
div [ _class "card" ] [ div [ _class "card" ] [
h5 [ _class "card-header"] [ str heading ] h5 [ _class "card-header"] [ str heading ]
div [ _class "card-body text-center" ] [ div [ _class "card-body text-center" ] [
p [ _class "card-text" ] text p [ _class "card-text" ] text
pageLink link [ _class "btn btn-primary" ] [ str buttonText ] pageLink link [ _class "btn btn-primary" ] [ str buttonText ]
] ]
] ]
/// 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 (tz : DateTimeZone) = let relativeDate (date : Instant) now =
span [ _title (date.InZone(tz).ToDateTimeOffset().ToString("f", null)) ] [ Dates.formatDistance now date |> str ] span [ _title (date.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,180 +1,177 @@
/// 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 tz req = let journalCard now req =
let reqId = RequestId.toString req.RequestId let reqId = RequestId.toString req.requestId
let spacer = span [] [ rawText "&nbsp;" ] let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [ div [ _class "col" ] [
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 [ _type "button" button [
_class "btn btn-secondary" _type "button"
_title "Add Notes" _class "btn btn-secondary"
_data "bs-toggle" "modal" _title "Add Notes"
_data "bs-target" "#notesModal" _data "bs-toggle" "modal"
_hxGet $"/components/request/{reqId}/add-notes" _data "bs-target" "#notesModal"
_hxTarget "#notesBody" _hxGet $"/components/request/{reqId}/add-notes"
_hxSwap HxSwap.InnerHtml ] [ _hxTarget "#notesBody"
icon "comment" _hxSwap HxSwap.InnerHtml
] ] [ icon "comment" ]
spacer spacer
button [ _type "button" button [
_class "btn btn-secondary" _type "button"
_title "Snooze Request" _class "btn btn-secondary"
_data "bs-toggle" "modal" _title "Snooze Request"
_data "bs-target" "#snoozeModal" _data "bs-toggle" "modal"
_hxGet $"/components/request/{reqId}/snooze" _data "bs-target" "#snoozeModal"
_hxTarget "#snoozeBody" _hxGet $"/components/request/{reqId}/snooze"
_hxSwap HxSwap.InnerHtml ] [ _hxTarget "#snoozeBody"
icon "schedule" _hxSwap HxSwap.InnerHtml
] ] [ icon "schedule" ]
div [ _class "flex-grow-1" ] [] div [ _class "flex-grow-1" ] []
button [ _type "button" button [
_class "btn btn-success w-25" _type "button"
_hxPatch $"/request/{reqId}/prayed" _class "btn btn-success w-25"
_title "Mark as Prayed" ] [ _hxPatch $"/request/{reqId}/prayed"
icon "done" _title "Mark as Prayed"
] ] [ icon "done" ]
]
div [ _class "card-body" ] [
p [ _class "request-text" ] [ str req.Text ]
]
div [ _class "card-footer text-end text-muted px-1 py-0" ] [
em [] [
match req.LastPrayed with
| Some dt -> str "last prayed "; relativeDate dt now tz
| None -> str "last activity "; relativeDate req.AsOf now tz
]
]
] ]
div [ _class "card-body" ] [
p [ _class "request-text" ] [ str req.text ]
]
div [ _class "card-footer text-end text-muted px-1 py-0" ] [
em [] [ str "last activity "; relativeDate req.asOf now ]
]
]
] ]
/// The journal loading page /// The journal loading page
let journal user = let journal user = article [ _class "container-fluid mt-3" ] [
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" str " Prayer Journal"
str " Prayer Journal"
]
p [ _class "pb-3 text-center" ] [
pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ]
]
p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
rawText "Loading your prayer journal&hellip;"
]
div [ _id "notesModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "nodesModalLabel"
_ariaHidden "true" ] [
div [ _class "modal-dialog modal-dialog-scrollable" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
]
div [ _class "modal-body"; _id "notesBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"
_id "notesDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close"
]
]
]
]
]
div [ _id "snoozeModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "snoozeModalLabel"
_ariaHidden "true" ] [
div [ _class "modal-dialog modal-sm" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
h5 [ _class "modal-title"; _id "snoozeModalLabel" ] [ str "Snooze Prayer Request" ]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
]
div [ _class "modal-body"; _id "snoozeBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"
_id "snoozeDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close"
]
]
]
]
]
] ]
p [ _class "pb-3 text-center" ] [
pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ]
]
p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
rawText "Loading your prayer journal&hellip;"
]
div [
_id "notesModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "nodesModalLabel"
_ariaHidden "true"
] [
div [ _class "modal-dialog modal-dialog-scrollable" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
]
div [ _class "modal-body"; _id "notesBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"; _id "notesDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [
str "Close"
]
]
]
]
]
div [
_id "snoozeModal"
_class "modal fade"
_tabindex "-1"
_ariaLabelledBy "snoozeModalLabel"
_ariaHidden "true"
] [
div [ _class "modal-dialog modal-sm" ] [
div [ _class "modal-content" ] [
div [ _class "modal-header" ] [
h5 [ _class "modal-title"; _id "snoozeModalLabel" ] [ str "Snooze Prayer Request" ]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
]
div [ _class "modal-body"; _id "snoozeBody" ] [ ]
div [ _class "modal-footer" ] [
button [ _type "button"; _id "snoozeDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [
str "Close"
]
]
]
]
]
]
/// The journal items /// The journal items
let journalItems now tz items = let journalItems now items =
match items |> List.isEmpty with match items |> List.isEmpty with
| true -> | true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [ noResults "No Active Requests" "/request/new/edit" "Add a Request" [
rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or deferred " rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or deferred "
rawText "requests, and the &ldquo;Answered&rdquo; link for answered requests" rawText "requests, and the &ldquo;Answered&rdquo; link for answered requests"
] ]
| false -> | false ->
items items
|> List.map (journalCard now tz) |> List.map (journalCard now)
|> section [ _id "journalItems" |> section [
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" _id "journalItems"
_hxTarget "this" _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
_hxSwap HxSwap.OuterHtml _hxTarget "this"
_ariaLabel "Prayer Requests" ] _hxSwap HxSwap.OuterHtml
]
/// 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 [ _id "notes" textarea [
_name "notes" _id "notes"
_class "form-control" _name "notes"
_style "min-height: 8rem;" _class "form-control"
_placeholder "Notes" _style "min-height: 8rem;"
_autofocus; _required ] [ ] _placeholder "Notes"
label [ _for "notes" ] [ str "Notes" ] _autofocus; _required
] ] [ ]
p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ] label [ _for "notes" ] [ str "Notes" ]
] ]
hr [ _style "margin: .5rem -1rem" ] p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ]
div [ _id "priorNotes" ] [ ]
p [ _class "text-center pt-3" ] [ hr [ _style "margin: .5rem -1rem" ]
button [ _type "button" div [ _id "priorNotes" ] [
_class "btn btn-secondary" p [ _class "text-center pt-3" ] [
_hxGet $"/components/request/{reqId}/notes" button [
_hxSwap HxSwap.OuterHtml _type "button"
_hxTarget "#priorNotes" ] [ _class "btn btn-secondary"
str "Load Prior Notes" _hxGet $"/components/request/{reqId}/notes"
] _hxSwap HxSwap.OuterHtml
] _hxTarget "#priorNotes"
] [str "Load Prior Notes" ]
] ]
]
] ]
/// 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 [ _hxPatch $"/request/{RequestId.toString requestId}/snooze" form [
_hxTarget "#journalItems" _hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxSwap HxSwap.OuterHtml ] [ _hxTarget "#journalItems"
div [ _class "form-floating pb-3" ] [ _hxSwap HxSwap.OuterHtml
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ] ] [
label [ _for "until" ] [ str "Until" ] div [ _class "form-floating pb-3" ] [
] input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ] label [ _for "until" ] [ str "Until" ]
]
p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ]
] ]

View File

@ -1,125 +1,151 @@
/// 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
currentUrl : string
/// The current URL /// The title for the page to be rendered
CurrentUrl: string pageTitle : string
/// The content of the page
/// The title for the page to be rendered content : XmlNode
PageTitle: string }
/// The content of the page
Content: XmlNode }
/// The home page /// The home page
let home = let home = article [ _class "container mt-3" ] [
article [ _class "container mt-3" ] p [] [ rawText "&nbsp;" ]
[ p [] [ rawText "&nbsp;" ] p [] [
p [] str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for "
[ str "myPrayerJournal is a place where individuals can record their prayer requests, record that they " str "them, update them as God moves in the situation, and record a final answer received on that request. It also "
str "prayed for them, update them as God moves in the situation, and record a final answer received on " str "allows individuals to review their answered prayers."
str "that request. It also allows individuals to review their answered prayers." ] ]
p [] p [] [
[ str "This site is open and available to the general public. To get started, simply click the " str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can " rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can also "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above." ] ] rawText "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 pageLink "/" [ _class "navbar-brand" ] [
"/" [ _class "navbar-brand" ] span [ _class "m" ] [ str "my" ]
[ 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
if ctx.IsAuthenticated then match ctx.isAuthenticated with
li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] | true ->
li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
if ctx.HasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ] li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ]
li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ] if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ]
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
li [ _class "nav-item" ] [ navLink "/docs" [ str "Docs" ] ] | false -> li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
} li [ _class "nav-item" ] [
|> List.ofSeq a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ] ] ]
}
|> List.ofSeq
|> 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 = let titleTag ctx = title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ]
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 [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/css/bootstrap.min.css" link [
_rel "stylesheet" _href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
_integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN" _rel "stylesheet"
_crossorigin "anonymous" ] _integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] _crossorigin "anonymous"
link [ _href "/style/style.css"; _rel "stylesheet" ] ] ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _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 {version}" str "myPrayerJournal v3"
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://git.bitbadger.solutions/bit-badger/myPrayerJournal" a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [
_target "_blank" str "Developed"
_rel "noopener" ] [ str "Developed" ] ]
str " and hosted by " str " and hosted by "
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [ str "Bit Badger Solutions" ]
[ str "Bit Badger Solutions" ] ] ] ] ]
Htmx.Script.minified ]
script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')" ] ]
script [ _async script [
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js" _src "https://unpkg.com/htmx.org@1.5.0"
_integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL" _integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
_crossorigin "anonymous" ] [] _crossorigin "anonymous"
script [] ] []
[ rawText "setTimeout(function () { " script [] [
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') " rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
rawText "}, 2000)" ] ]
script [ _src "/script/mpj.js" ] [] ] 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 "}, 2000)"
]
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"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] section [ _id "top" ] [ 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" ] [ head [] [ titleTag ctx ]; body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] ] html [ _lang "en" ] [
head [] [ titleTag ctx ]
body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
]

View File

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

View File

@ -1,273 +1,268 @@
/// 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 tz req = let reqListItem now req =
let isFuture instant = defaultArg (instant |> Option.map (fun it -> it > now)) false let reqId = RequestId.toString req.requestId
let reqId = RequestId.toString req.RequestId let isAnswered = req.lastStatus = Answered
let isAnswered = req.LastStatus = Answered let isSnoozed = req.snoozedUntil > now
let isSnoozed = isFuture req.SnoozedUntil let isPending = (not isSnoozed) && req.showAfter > now
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" pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
_hxTarget "this" match isAnswered with
_hxSwap HxSwap.OuterHtml ] [ | true -> ()
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] | false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ] match true with
if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze" | _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
elif isPending then restoreBtn "show" "Show Now" | _ when isPending -> restoreBtn "show" "Show Now"
p [ _class "request-text mb-0" ] [ | _ -> ()
str req.Text p [ _class "request-text mb-0" ] [
if isSnoozed || isPending || isAnswered then str req.text
br [] match isSnoozed || isPending || isAnswered with
small [ _class "text-muted" ] [ | true ->
if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil.Value now tz ] br []
elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter.Value now tz ] small [ _class "text-muted" ] [
else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now tz ] match () with
|> em [] | _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
] | _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ]
] | _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em []
]
| false -> ()
]
] ]
/// Create a list of requests /// Create a list of requests
let reqList now tz reqs = let reqList now reqs =
reqs reqs
|> List.map (reqListItem now tz) |> List.map (reqListItem now)
|> div [ _class "list-group" ] |> div [ _class "list-group" ]
/// View for Active Requests page /// View for Active Requests page
let active now tz reqs = let active now reqs = article [ _class "container mt-3" ] [
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" ]
else reqList now tz reqs | false -> reqList now reqs
] ]
/// View for Answered Requests page /// View for Answered Requests page
let answered now tz reqs = let answered now reqs = article [ _class "container mt-3" ] [
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"
] ]
else reqList now tz reqs | false -> reqList now reqs
] ]
/// View for Snoozed Requests page /// View for Snoozed Requests page
let snoozed now tz reqs = let snoozed now reqs = article [ _class "container mt-3" ] [
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) tz (req : Request) = let full (clock : IClock) (req : Request) =
let now = clock.GetCurrentInstant() let now = clock.GetCurrentInstant ()
let answered = let answered =
req.History req.history
|> Seq.ofList |> List.filter RequestAction.isAnswered
|> Seq.filter History.isAnswered |> List.tryHead
|> Seq.tryHead |> Option.map (fun x -> x.asOf)
|> Option.map (_.AsOf) let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0"
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) // The history log including notes (and excluding the final entry for answered requests)
|> Seq.head let log =
// The history log including notes (and excluding the final entry for answered requests) let toDisp (h : History) = {| asOf = h.asOf; text = h.text; status = RequestAction.toString h.status |}
let log = let all =
let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |} req.notes
let all = |> List.map (fun n -> {| asOf = n.asOf; text = Some n.notes; status = "Notes" |})
req.Notes |> List.append (req.history |> List.map toDisp)
|> Seq.ofList |> List.sortByDescending (fun it -> it.asOf)
|> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) // Skip the first entry for answered requests; that info is already displayed
|> Seq.append (req.History |> List.map toDisp) match answered with Some _ -> all |> List.skip 1 | None -> all
|> Seq.sortByDescending (_.asOf) article [ _class "container mt-3" ] [
|> List.ofSeq div [_class "card" ] [
// Skip the first entry for answered requests; that info is already displayed h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
match answered with Some _ -> all.Tail | None -> all div [ _class "card-body" ] [
article [ _class "container mt-3" ] [ h6 [ _class "card-subtitle text-muted mb-2"] [
div [_class "card" ] [ match answered with
h5 [ _class "card-header" ] [ str "Full Prayer Request" ] | Some date ->
div [ _class "card-body" ] [ str "Answered "
h6 [ _class "card-subtitle text-muted mb-2"] [ date.ToDateTimeOffset().ToString ("D", null) |> str
match answered with str " ("
| Some date -> relativeDate date now
str "Answered " rawText ") &bull; "
date.ToDateTimeOffset().ToString("D", null) |> str | None -> ()
str " (" sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText
relativeDate date now tz ]
rawText ") &bull; " p [ _class "card-text" ] [ str lastText ]
| None -> ()
rawText $"Prayed %s{prayed} times &bull; Open %s{daysOpen} days"
]
p [ _class "card-text" ] [ str lastText ]
]
log
|> List.map (fun it ->
li [ _class "list-group-item" ] [
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
| None -> ()
])
|> ul [ _class "list-group list-group-flush" ]
] ]
log
|> List.map (fun it -> li [ _class "list-group-item" ] [
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
| None -> ()
])
|> ul [ _class "list-group list-group-flush" ]
]
] ]
/// View for the edit request component /// View for the edit request component
let edit (req : JournalRequest) returnTo isNew = let edit (req : JournalRequest) returnTo isNew =
let cancelLink = let cancelLink =
match returnTo with match returnTo with
| "active" -> "/requests/active" | "active" -> "/requests/active"
| "snoozed" -> "/requests/snoozed" | "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal" | _ (* "journal" *) -> "/journal"
let recurCount = article [ _class "container" ] [
match req.Recurrence with h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
| Immediate -> None form [
| Hours h -> Some h _hxBoost
| Days d -> Some d _hxTarget "#top"
| Weeks w -> Some w _hxPushUrl
|> Option.map string "/request" |> match isNew with true -> _hxPost | false -> _hxPatch
|> Option.defaultValue "" ] [
article [ _class "container" ] [ input [
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ] _type "hidden"
form [ _hxBoost _name "requestId"
_hxTarget "#top" _value (match isNew with true -> "new" | false -> RequestId.toString req.requestId)
_hxPushUrl "true"
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
input [ _type "hidden"
_name "requestId"
_value (match isNew with true -> "new" | false -> RequestId.toString req.RequestId) ]
input [ _type "hidden"; _name "returnTo"; _value returnTo ]
div [ _class "form-floating pb-3" ] [
textarea [ _id "requestText"
_name "requestText"
_class "form-control"
_style "min-height: 8rem;"
_placeholder "Enter the text of the request"
_autofocus; _required ] [ str req.Text ]
label [ _for "requestText" ] [ str "Prayer Request" ]
]
br []
if not isNew then
div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ]
br []
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"
_class "form-check-input"
_id "sU"
_name "status"
_value "Updated"
_checked ]
label [ _for "sU" ] [ str "Updated" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sP"; _name "status"; _value "Prayed" ]
label [ _for "sP" ] [ str "Prayed" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sA"; _name "status"; _value "Answered" ]
label [ _for "sA" ] [ str "Answered" ]
]
]
div [ _class "row" ] [
div [ _class "col-12 offset-md-2 col-md-8 offset-lg-3 col-lg-6" ] [
p [] [
strong [] [ rawText "Recurrence &nbsp; " ]
em [ _class "text-muted" ] [ rawText "After prayer, request reappears&hellip;" ]
]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [
input [ _type "radio"
_class "form-check-input"
_id "rI"
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.Recurrence with Immediate -> _checked | _ -> () ]
label [ _for "rI" ] [ str "Immediately" ]
]
div [ _class "form-check mx-2"] [
input [ _type "radio"
_class "form-check-input"
_id "rO"
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.Recurrence with Immediate -> () | _ -> _checked ]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
div [ _class "form-floating mx-2"] [
input [ _type "number"
_class "form-control"
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value recurCount
_style "width:6rem;"
_required
match req.Recurrence with Immediate -> _disabled | _ -> () ]
label [ _for "recurCount" ] [ str "Count" ]
]
div [ _class "form-floating mx-2" ] [
select [ _class "form-control"
_id "recurInterval"
_name "recurInterval"
_style "width:6rem;"
_required
match req.Recurrence with Immediate -> _disabled | _ -> () ] [
option [ _value "Hours"; match req.Recurrence with Hours _ -> _selected | _ -> () ] [
str "hours"
]
option [ _value "Days"; match req.Recurrence with Days _ -> _selected | _ -> () ] [
str "days"
]
option [ _value "Weeks"; match req.Recurrence with Weeks _ -> _selected | _ -> () ] [
str "weeks"
]
]
label [ _form "recurInterval" ] [ str "Interval" ]
]
]
]
]
div [ _class "text-end pt-3" ] [
button [ _class "btn btn-primary me-2"; _type "submit" ] [ icon "save"; str " Save" ]
pageLink cancelLink [ _class "btn btn-secondary ms-2" ] [ icon "arrow_back"; str " Cancel" ]
]
] ]
input [ _type "hidden"; _name "returnTo"; _value returnTo ]
div [ _class "form-floating pb-3" ] [
textarea [
_id "requestText"
_name "requestText"
_class "form-control"
_style "min-height: 8rem;"
_placeholder "Enter the text of the request"
_autofocus; _required
] [ str req.text ]
label [ _for "requestText" ] [ str "Prayer Request" ]
]
br []
match isNew with
| true -> ()
| false ->
div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ]
br []
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sU"; _name "status"; _value "Updated"; _checked ]
label [ _for "sU" ] [ str "Updated" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sP"; _name "status"; _value "Prayed" ]
label [ _for "sP" ] [ str "Prayed" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sA"; _name "status"; _value "Answered" ]
label [ _for "sA" ] [ str "Answered" ]
]
]
div [ _class "row" ] [
div [ _class "col-12 offset-md-2 col-md-8 offset-lg-3 col-lg-6" ] [
p [] [
strong [] [ rawText "Recurrence &nbsp; " ]
em [ _class "text-muted" ] [ rawText "After prayer, request reappears&hellip;" ]
]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [
input [
_type "radio"
_class "form-check-input"
_id "rI"
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> _checked | _ -> ()
]
label [ _for "rI" ] [ str "Immediately" ]
]
div [ _class "form-check mx-2"] [
input [
_type "radio"
_class "form-check-input"
_id "rO"
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> () | _ -> _checked
]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
div [ _class "form-floating mx-2"] [
input [
_type "number"
_class "form-control"
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value (string req.recurCount)
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
]
label [ _for "recurCount" ] [ str "Count" ]
]
div [ _class "form-floating mx-2" ] [
select [
_class "form-control"
_id "recurInterval"
_name "recurInterval"
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
] [
option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ]
option [ _value "Days"; match req.recurType with Days -> _selected | _ -> () ] [ str "days" ]
option [ _value "Weeks"; match req.recurType with Weeks -> _selected | _ -> () ] [ str "weeks" ]
]
label [ _form "recurInterval" ] [ str "Interval" ]
]
]
]
]
div [ _class "text-end pt-3" ] [
button [ _class "btn btn-primary me-2"; _type "submit" ] [ icon "save"; str " Save" ]
pageLink cancelLink [ _class "btn btn-secondary ms-2" ] [ icon "arrow_back"; str " Cancel" ]
]
]
] ]
/// Display a list of notes for a request /// Display a list of notes for a request
let notes now tz notes = let notes now notes =
let toItem (note : Note) = let toItem (note : Note) =
p [] [ small [ _class "text-muted" ] [ relativeDate note.AsOf now tz ]; br []; str note.Notes ] p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ] [ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ] | [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]
| _ -> yield! notes |> List.map toItem | _ -> yield! notes |> List.map toItem
] ]

View File

@ -1,2 +1,12 @@
{ {
"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 */
this.mpj = { const 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,19 +66,6 @@ this.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 (_) { }
} }
} }
@ -93,12 +80,3 @@ 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