Compare commits

...

11 Commits
3.1 ... main

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

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

Signed-off-by: dependabot[bot] <support@github.com>
2023-02-24 16:37:59 +00:00
8702723e01 Fix request ID generation (#72)
- Bump version
2022-08-23 08:36:17 -04:00
20 changed files with 719 additions and 795 deletions

2
.gitignore vendored
View File

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

View File

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

17
src/Dockerfile Normal file
View File

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

View File

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

View File

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

View File

@ -1,12 +1,10 @@

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

View File

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

View File

@ -1,199 +1,202 @@
module MyPrayerJournal.Data
module MyPrayerJournal.Data
open LiteDB
open MyPrayerJournal
open System.Threading.Tasks
/// Table(!) used by myPrayerJournal
module Table =
/// LiteDB extensions
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.Requests = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log)
member this.SaveChanges () =
this.Checkpoint ()
Task.CompletedTask
/// Requests
[<Literal>]
let Request = "mpj.request"
/// Map domain to LiteDB
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
/// JSON serialization customizations
[<RequireQualifiedAccess>]
module Mapping =
module Json =
open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T>()
override _.Read(reader, _, _) =
wrap (reader.GetString())
override _.Write(writer, value, _) =
writer.WriteStringValue(unwrap value)
open System.Text.Json
open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain
let options =
let opts = JsonSerializerOptions()
[ WrappedJsonConverter(Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter(RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter(RequestId.ofString, RequestId.toString)
WrappedJsonConverter(UserId, UserId.toString)
JsonFSharpConverter() ]
|> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
opts
open BitBadger.Documents.Postgres
/// Connection
[<RequireQualifiedAccess>]
module Connection =
open BitBadger.Documents
open Microsoft.Extensions.Configuration
open Npgsql
open System.Text.Json
/// Ensure the database is ready to use
let private ensureDb () = backgroundTask {
do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS mpj" []
do! Definition.ensureTable Table.Request
do! Definition.ensureDocumentIndex Table.Request Optimized
}
/// 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
open NodaTime.Text
/// Add a request
let add req =
insert<Request> Table.Request req
/// Does a request exist for the given request ID and user ID?
let existsById (reqId : RequestId) (userId : UserId) =
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
/// A NodaTime instant pattern to use for parsing instants from the database
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
/// Retrieve a request by its ID and user ID
let tryById reqId userId = backgroundTask {
match! Find.byId<string, Request> Table.Request (RequestId.toString reqId) with
| Some req when req.UserId = userId -> return Some req
| _ -> return None
}
/// Mapping for NodaTime's Instant type
module Instant =
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
/// Mapping for option types
module Option =
let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
/// Mapping for Recurrence
module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction
module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
/// Mapping for RequestId
module RequestId =
let fromBson (value : BsonValue) = RequestId.ofString value.AsString
let toBson (value : RequestId) : BsonValue = RequestId.toString value
/// Mapping for UserId
module UserId =
let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value
/// Set up the mapping
let register () =
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
/// 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"
}
/// 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 ()
/// 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"
}
/// Async wrappers for LiteDB, and request -> journal mappings
[<AutoOpen>]
module private Helpers =
open System.Linq
/// Specific manipulation of history entries
[<RequireQualifiedAccess>]
module History =
/// 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
/// 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"
}
/// 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
}
/// Data access functions for journal-style requests
[<RequireQualifiedAccess>]
module Journal =
/// 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 = Array.append [| hist |] req.History }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// 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
}
/// Add a note
let addNote reqId userId note db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// 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
}
/// Add a request
let addRequest (req : Request) (db : LiteDatabase) =
db.Requests.Insert req |> ignore
/// 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)
}
/// Find all requests for the given user
let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask {
return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync
}
let tryById reqId userId = backgroundTask {
let! req = Request.tryById reqId userId
return req |> Option.map JournalRequest.ofRequestLite
}
/// Retrieve all answered requests for the given user
let answeredRequests userId db = backgroundTask {
let! reqs = getRequestsForUser userId db
return
reqs
|> Seq.map JournalRequest.ofRequestFull
|> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.AsOf)
|> List.ofSeq
}
/// Retrieve the user's current journal
let journalByUserId userId db = backgroundTask {
let! reqs = getRequestsForUser userId db
return
reqs
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (fun it -> it.AsOf)
|> List.ofSeq
}
/// Specific manipulation of note entries
[<RequireQualifiedAccess>]
module Note =
/// 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 -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
}
/// 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 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 [||]
}
/// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite
}
/// Update the recurrence for a request
let updateRecurrence reqId userId recurType db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with Recurrence = recurType }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update a snoozed request
let updateSnoozed reqId userId until db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with ShowAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// 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

@ -1,4 +1,4 @@
/// The data model for myPrayerJournal
/// The data model for myPrayerJournal
[<AutoOpen>]
module MyPrayerJournal.Domain
@ -169,10 +169,10 @@ type Request =
Recurrence : Recurrence
/// The history entries for this request
History : History[]
History : History list
/// The notes for this request
Notes : Note[]
Notes : Note list
}
/// Functions to support requests
@ -186,8 +186,8 @@ module Request =
SnoozedUntil = None
ShowAfter = None
Recurrence = Immediate
History = [||]
Notes = [||]
History = []
Notes = []
}
@ -234,7 +234,8 @@ module JournalRequest =
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
let ofRequestLite (req : Request) =
let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead
let history = Seq.ofList req.History
let lastHistory = Seq.tryHead history
// Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the
// largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled,
// we will use the last activity date. This will mean that:
@ -243,23 +244,21 @@ module JournalRequest =
// them at the bottom of the list.
// - Snoozed requests will reappear at the bottom of the list when they return.
// - New requests will go to the bottom of the list, but will rise as others are marked as prayed.
let lastActivity = lastHistory |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue
let lastActivity = lastHistory |> Option.map (_.AsOf) |> Option.defaultValue Instant.MinValue
let showAfter = defaultArg req.ShowAfter Instant.MinValue
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
let lastPrayed =
req.History
|> Array.sortByDescending (fun it -> it.AsOf)
|> Array.filter History.isPrayed
|> Array.tryHead
|> Option.map (fun it -> it.AsOf)
history
|> Seq.filter History.isPrayed
|> Seq.tryHead
|> Option.map (_.AsOf)
|> Option.defaultValue Instant.MinValue
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id
UserId = req.UserId
Text = req.History
|> Array.filter (fun it -> Option.isSome it.Text)
|> Array.sortByDescending (fun it -> it.AsOf)
|> Array.tryHead
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
@ -275,6 +274,6 @@ module JournalRequest =
/// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req =
{ ofRequestLite req with
History = List.ofArray req.History
Notes = List.ofArray req.Notes
History = req.History
Notes = req.Notes
}

View File

@ -1,4 +1,4 @@
/// HTTP handlers for the myPrayerJournal API
/// HTTP handlers for the myPrayerJournal API
[<RequireQualifiedAccess>]
module MyPrayerJournal.Handlers
@ -16,7 +16,7 @@ module private LogOnHelpers =
let logOn url : HttpHandler = fun next ctx -> task {
match url with
| Some it ->
do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it))
do! ctx.ChallengeAsync("Auth0", AuthenticationProperties(RedirectUri = it))
return! next ctx
| None -> return! challenge "Auth0" next ctx
}
@ -45,30 +45,26 @@ module Error =
open System.Security.Claims
open LiteDB
open Microsoft.AspNetCore.Http
open NodaTime
/// Extensions on the HTTP context
type HttpContext with
/// The LiteDB database
member this.Db = this.GetService<LiteDatabase> ()
/// The "sub" for the current user (None if no user is authenticated)
member this.CurrentUser =
this.User
|> Option.ofObj
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|> Option.flatten
|> Option.map (fun claim -> claim.Value)
|> Option.map (_.Value)
/// The current user's ID
// NOTE: this may raise if you don't run the request through the requireUser handler first
member this.UserId = UserId this.CurrentUser.Value
/// The system clock
member this.Clock = this.GetService<IClock> ()
member this.Clock = this.GetService<IClock>()
/// Get the current instant from the system clock
member this.Now = this.Clock.GetCurrentInstant
@ -83,6 +79,8 @@ type HttpContext with
| None -> DateTimeZone.Utc
open MyPrayerJournal.Data
/// Handler helpers
[<AutoOpen>]
module private Helpers =
@ -96,7 +94,7 @@ module private Helpers =
/// Debug logger
let debug (ctx : HttpContext) message =
let fac = ctx.GetService<ILoggerFactory> ()
let fac = ctx.GetService<ILoggerFactory>()
let log = fac.CreateLogger "Debug"
log.LogInformation message
@ -117,7 +115,7 @@ module private Helpers =
let renderComponent nodes : HttpHandler =
noResponseCaching
>=> fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
return! ctx.WriteHtmlStringAsync(ViewEngine.RenderView.AsString.htmlNodes nodes)
}
open Views.Layout
@ -127,7 +125,7 @@ module private Helpers =
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed =
match ctx.CurrentUser with
| Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
| Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now())
| None -> Task.FromResult false
return
{ IsAuthenticated = Option.isSome ctx.CurrentUser
@ -155,17 +153,17 @@ module private Helpers =
/// Push a new message into the list
let push (ctx : HttpContext) message url = lock upd8 (fun () ->
messages <- messages.Add (ctx.UserId, (message, url)))
messages <- messages.Add(ctx.UserId, (message, url)))
/// Add a success message header to the response
let pushSuccess ctx message url =
push ctx $"success|||%s{message}" url
push ctx $"success|||%s{message}" url
/// Pop the messages for the given user
let pop userId = lock upd8 (fun () ->
let msg = messages.TryFind userId
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
msg)
let msg = messages.TryFind userId
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
msg)
/// Send a partial result if this is not a full page load (does not append no-cache headers)
let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task {
@ -238,7 +236,6 @@ module Models =
}
open MyPrayerJournal.Data.Extensions
open NodaTime.Text
/// Handlers for less-than-full-page HTML requests
@ -254,15 +251,15 @@ module Components =
| Some snooze, _ when snooze < now -> true
| _, Some hide when hide < now -> true
| _, _ -> false
let! journal = Data.journalByUserId ctx.UserId ctx.Db
let! journal = Journal.forUser ctx.UserId
let shown = journal |> List.filter shouldBeShown
return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx
}
// GET /components/request-item/[req-id]
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx
match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now()) ctx.TimeZone req ] next ctx
| None -> return! Error.notFound next ctx
}
@ -272,8 +269,8 @@ module Components =
// GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx
let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
return! renderComponent (Views.Request.notes (ctx.Now()) ctx.TimeZone notes) next ctx
}
// GET /components/request/[req-id]/snooze
@ -281,13 +278,16 @@ module Components =
requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
/// / URL
/// / URL and documentation
module Home =
// GET /
let home : HttpHandler =
partialStatic "Welcome!" Views.Layout.home
// GET /docs
let docs : HttpHandler =
partialStatic "Documentation" Views.Docs.index
/// /journal URL
module Journal =
@ -297,9 +297,9 @@ module Journal =
let usr =
ctx.User.Claims
|> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
|> Option.map (fun c -> c.Value)
|> Option.map (_.Value)
|> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s&rsquo;s"
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
}
@ -318,7 +318,9 @@ module Legal =
/// /api/request and /request(s) URLs
module Request =
open Cuid
// GET /request/[req-id]/edit
let edit requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let returnTo =
@ -331,7 +333,7 @@ module Request =
return! partial "Add Prayer Request"
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
| _ ->
match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
match! Journal.tryById (RequestId.ofString requestId) ctx.UserId with
| Some req ->
debug ctx "Found - sending view"
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
@ -342,47 +344,43 @@ module Request =
// PATCH /request/[req-id]/prayed
let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId userId db with
match! Journal.tryById reqId userId with
| Some req ->
let now = ctx.Now ()
do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db
do! History.add reqId userId { AsOf = now; Status = Prayed; Text = None }
let nextShow =
match Recurrence.duration req.Recurrence with
| 0L -> None
| duration -> Some <| now.Plus (Duration.FromSeconds duration)
do! Data.updateShowAfter reqId userId nextShow db
do! db.SaveChanges ()
do! Request.updateShowAfter reqId userId nextShow
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx
}
/// POST /request/[req-id]/note
// POST /request/[req-id]/note
let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId userId db with
| Some _ ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
do! db.SaveChanges ()
match! Request.existsById reqId userId with
| true ->
let! notes = ctx.BindFormAsync<Models.NoteEntry>()
do! Note.add reqId userId { AsOf = ctx.Now(); Notes = notes.notes }
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// GET /requests/active
let active : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx
let! reqs = Journal.forUser ctx.UserId
return! partial "Active Requests" (Views.Request.active (ctx.Now()) ctx.TimeZone reqs) next ctx
}
// GET /requests/snoozed
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
let now = ctx.Now ()
let! reqs = Journal.forUser ctx.UserId
let now = ctx.Now()
let snoozed = reqs
|> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
return! partial "Snoozed Requests" (Views.Request.snoozed now ctx.TimeZone snoozed) next ctx
@ -390,62 +388,56 @@ module Request =
// GET /requests/answered
let answered : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Data.answeredRequests ctx.UserId ctx.Db
return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx
let! reqs = Journal.answered ctx.UserId
return! partial "Answered Requests" (Views.Request.answered (ctx.Now()) ctx.TimeZone reqs) next ctx
}
// GET /request/[req-id]/full
let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with
match! Request.tryById (RequestId.ofString requestId) ctx.UserId with
| Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx
| None -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/show
let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId userId db with
| Some _ ->
do! Data.updateShowAfter reqId userId None db
do! db.SaveChanges ()
match! Request.existsById reqId userId with
| true ->
do! Request.updateShowAfter reqId userId None
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/snooze
let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId userId db with
| Some _ ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
match! Request.existsById reqId userId with
| true ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil>()
let date =
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant ()
do! Data.updateSnoozed reqId userId (Some date) db
do! db.SaveChanges ()
.ToInstant()
do! Request.updateSnoozed reqId userId (Some date)
return!
(withSuccessMessage $"Request snoozed until {until.until}"
>=> hideModal "snooze"
>=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
// PATCH /request/[req-id]/cancel-snooze
let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let db = ctx.Db
let userId = ctx.UserId
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId userId db with
| Some _ ->
do! Data.updateSnoozed reqId userId None db
do! db.SaveChanges ()
match! Request.existsById reqId userId with
| true ->
do! Request.updateSnoozed reqId userId None
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
| false -> return! Error.notFound next ctx
}
/// Derive a recurrence from its representation in the form
@ -455,51 +447,49 @@ module Request =
// POST /request
let add : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = ctx.Db
let! form = ctx.BindModelAsync<Models.Request>()
let userId = ctx.UserId
let now = ctx.Now ()
let now = ctx.Now()
let req =
{ Request.empty with
Id = Cuid.generate () |> RequestId
UserId = userId
EnteredOn = now
ShowAfter = None
Recurrence = parseRecurrence form
History = [|
History = [
{ AsOf = now
Status = Created
Text = Some form.requestText
}
|]
]
}
Data.addRequest req db
do! db.SaveChanges ()
do! Request.add req
Messages.pushSuccess ctx "Added prayer request" "/journal"
return! seeOther "/journal" next ctx
}
// PATCH /request
let update : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = ctx.Db
let! form = ctx.BindModelAsync<Models.Request>()
let userId = ctx.UserId
match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with
// TODO: update the instance and save rather than all these little updates
match! Journal.tryById (RequestId.ofString form.requestId) userId with
| Some req ->
// update recurrence if changed
let recur = parseRecurrence form
match recur = req.Recurrence with
| true -> ()
| false ->
do! Data.updateRecurrence req.RequestId userId recur db
do! Request.updateRecurrence req.RequestId userId recur
match recur with
| Immediate -> do! Data.updateShowAfter req.RequestId userId None db
| Immediate -> do! Request.updateShowAfter req.RequestId userId None
| _ -> ()
// append history
let upd8Text = form.requestText.Trim ()
let upd8Text = form.requestText.Trim()
let text = if upd8Text = req.Text then None else Some upd8Text
do! Data.addHistory req.RequestId userId
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
do! db.SaveChanges ()
do! History.add req.RequestId userId
{ AsOf = ctx.Now(); Status = (Option.get >> RequestAction.ofString) form.status; Text = text }
let nextUrl =
match form.returnTo with
| "active" -> "/requests/active"
@ -523,7 +513,7 @@ module User =
// GET /user/log-off
let logOff : HttpHandler = requireUser >=> fun next ctx -> task {
do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/"))
do! ctx.SignOutAsync("Auth0", AuthenticationProperties (RedirectUri = "/"))
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
return! next ctx
}
@ -543,6 +533,7 @@ let routes = [
routef "request/%s/snooze" Components.snooze
]
]
GET_HEAD [ route "/docs" Home.docs ]
GET_HEAD [ route "/journal" Journal.journal ]
subRoute "/legal/" [
GET_HEAD [

View File

@ -1,8 +1,11 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<Version>3.1.0</Version>
<NoWarn>3391</NoWarn>
<TargetFramework>net8.0</TargetFramework>
<Version>3.4</Version>
<DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile>
<PublishSingleFile>false</PublishSingleFile>
<SelfContained>false</SelfContained>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
@ -13,18 +16,21 @@
<Compile Include="Views/Layout.fs" />
<Compile Include="Views/Legal.fs" />
<Compile Include="Views/Request.fs" />
<Compile Include="Views\Docs.fs" />
<Compile Include="Handlers.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.3.13" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="LiteDB" Version="5.0.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="6.0.7" />
<PackageReference Include="NodaTime" Version="3.1.0" />
<PackageReference Include="Giraffe" Version="6.4.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.2.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
</ItemGroup>
<ItemGroup>
<Folder Include="wwwroot\" />

View File

@ -1,169 +1,111 @@
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.Hosting
open System.IO
/// Configuration functions for the application
module Configure =
/// Configure the content root
let contentRoot root =
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open Microsoft.Extensions.Configuration
/// Configure the application configuration
let appConfiguration (bldr : WebApplicationBuilder) =
bldr.Configuration
.SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
.AddEnvironmentVariables ()
|> ignore
bldr
open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json
let kestrel (bldr : WebApplicationBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
bldr
/// Configure the web root directory
let webRoot pathSegments (bldr : WebApplicationBuilder) =
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
bldr
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Hosting
/// Configure logging
let logging (bldr : WebApplicationBuilder) =
if bldr.Environment.IsDevelopment () then 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
| _, _ -> ()
let _ = bldr.Services.AddRouting ()
let _ = bldr.Services.AddGiraffe ()
let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
let _ =
bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
let _ =
bldr.Services.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 cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- $"""https://{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
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
| false -> redirUri
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
ctx.HandleResponse ()
Task.CompletedTask
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
bldr.Scheme <- cfg["Scheme"]
bldr.Port <- int cfg["Port"]
ctx.ProtocolMessage.RedirectUri <- string bldr
Task.CompletedTask)
let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
Data.Startup.ensureDb db
let _ = bldr.Services.AddSingleton jsonOptions
let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
let _ = bldr.Services.AddSingleton<LiteDatabase> db
bldr.Build ()
open Giraffe.EndpointRouting
/// Configure the web application
let application (app : WebApplication) =
let _ = app.UseStaticFiles ()
let _ = app.UseCookiePolicy ()
let _ = app.UseRouting ()
let _ = app.UseAuthentication ()
let _ = app.UseGiraffeErrorHandler Handlers.Error.error
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
app
/// Compose all the configurations into one
let webHost pathSegments =
contentRoot
>> appConfiguration
>> kestrel
>> webRoot pathSegments
>> logging
>> services
>> application
open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Logging
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open MyPrayerJournal.Data
open NodaTime
open System
open System.Text.Json
open System.Threading.Tasks
[<EntryPoint>]
let main _ =
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
host.Run ()
let main args =
//use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
//host.Run ()
let builder = WebApplication.CreateBuilder args
let _ = builder.Configuration.AddEnvironmentVariables "MPJ_"
let svc = builder.Services
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let _ = svc.AddRouting()
let _ = svc.AddGiraffe()
let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ = svc.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
let _ =
svc.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.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

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

View File

@ -29,4 +29,14 @@ let noResults heading link buttonText text =
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate (date : Instant) now (tz : DateTimeZone) =
span [ _title (date.InZone(tz).ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]
span [ _title (date.InZone(tz).ToDateTimeOffset().ToString("f", null)) ] [ Dates.formatDistance now date |> str ]
/// The version of myPrayerJournal
let version =
let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
seq {
string v.Major
if v.Minor > 0 then
$".{v.Minor}"
if v.Revision > 0 then $".{v.Revision}"
} |> Seq.reduce (+)

View File

@ -6,48 +6,44 @@ open Giraffe.ViewEngine.Accessibility
/// The data needed to render a page-level view
type PageRenderContext =
{ /// Whether the user is authenticated
IsAuthenticated : bool
/// Whether the user has snoozed requests
HasSnoozed : bool
/// The current URL
CurrentUrl : string
/// The title for the page to be rendered
PageTitle : string
/// The content of the page
Content : XmlNode
}
{ /// Whether the user is authenticated
IsAuthenticated: bool
/// Whether the user has snoozed requests
HasSnoozed: bool
/// The current URL
CurrentUrl: string
/// The title for the page to be rendered
PageTitle: string
/// The content of the page
Content: XmlNode }
/// The home page
let home =
article [ _class "container mt-3" ] [
p [] [ rawText "&nbsp;" ]
p [] [
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "prayed for them, update them as God moves in the situation, and record a final answer received on "
str "that request. It also allows individuals to review their answered prayers."
]
p [] [
str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
]
]
article [ _class "container mt-3" ]
[ p [] [ rawText "&nbsp;" ]
p []
[ str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "prayed for them, update them as God moves in the situation, and record a final answer received on "
str "that request. It also allows individuals to review their answered prayers." ]
p []
[ str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above." ] ]
/// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs
let private navBar ctx =
nav [ _class "navbar navbar-dark"; _roleNavigation ] [
div [ _class "container-fluid" ] [
pageLink "/" [ _class "navbar-brand" ] [
span [ _class "m" ] [ str "my" ]
span [ _class "p" ] [ str "Prayer" ]
span [ _class "j" ] [ str "Journal" ]
]
seq {
nav [ _class "navbar navbar-dark"; _roleNavigation ]
[ div [ _class "container-fluid" ]
[ pageLink
"/" [ _class "navbar-brand" ]
[ span [ _class "m" ] [ str "my" ]
span [ _class "p" ] [ str "Prayer" ]
span [ _class "j" ] [ str "Journal" ] ]
seq {
let navLink (matchUrl : string) =
match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
|> pageLink matchUrl
@ -58,91 +54,72 @@ let private navBar ctx =
li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
li [ _class "nav-item" ] [
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
]
}
|> List.ofSeq
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ]
]
]
li [ _class "nav-item" ] [ navLink "/docs" [ str "Docs" ] ]
}
|> List.ofSeq
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ] ]
/// The title tag with the application name appended
let titleTag ctx =
title [] [ str ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
title [] [ rawText ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element
let htmlHead ctx =
head [ _lang "en" ] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
_rel "stylesheet"
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_crossorigin "anonymous" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ]
]
head [ _lang "en" ]
[ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/css/bootstrap.min.css"
_rel "stylesheet"
_integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN"
_crossorigin "anonymous" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ] ]
/// Element used to display toasts
let toaster =
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [
div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] []
]
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ]
[ div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] ]
/// The page's `footer` element
let htmlFoot =
footer [ _class "container-fluid" ] [
p [ _class "text-muted text-end" ] [
str "myPrayerJournal v3.1"
br []
em [] [
small [] [
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
rawText " &bull; "
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
rawText " &bull; "
a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [
str "Developed"
]
str " and hosted by "
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [
str "Bit Badger Solutions"
]
]
]
]
Htmx.Script.minified
script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
]
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
_crossorigin "anonymous" ] []
script [] [
rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
rawText "}, 2000)"
]
script [ _src "/script/mpj.js" ] []
]
footer [ _class "container-fluid" ]
[ p [ _class "text-muted text-end" ]
[ str $"myPrayerJournal {version}"
br []
em []
[ small []
[ pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
rawText " &bull; "
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
rawText " &bull; "
a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal"
_target "_blank"
_rel "noopener" ] [ str "Developed" ]
str " and hosted by "
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ]
[ str "Bit Badger Solutions" ] ] ] ]
Htmx.Script.minified
script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')" ]
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL"
_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
let view ctx =
html [ _lang "en" ] [
htmlHead ctx
body [] [
section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
toaster
htmlFoot
]
]
html [ _lang "en" ]
[ htmlHead ctx
body []
[ section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
toaster
htmlFoot ] ]
/// Create a partial view
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

@ -74,31 +74,34 @@ let snoozed now tz reqs =
/// View for Full Request page
let full (clock : IClock) tz (req : Request) =
let now = clock.GetCurrentInstant ()
let now = clock.GetCurrentInstant()
let answered =
req.History
|> Array.filter History.isAnswered
|> Array.tryHead
|> Option.map (fun x -> x.AsOf)
let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0"
|> Seq.ofList
|> Seq.filter History.isAnswered
|> Seq.tryHead
|> Option.map (_.AsOf)
let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0"
let daysOpen =
let asOf = defaultArg answered now
((asOf - (req.History |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0"
((asOf - (req.History |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0"
let lastText =
req.History
|> Array.filter (fun h -> Option.isSome h.Text)
|> Array.sortByDescending (fun h -> h.AsOf)
|> Array.map (fun h -> Option.get h.Text)
|> Array.head
|> Seq.ofList
|> Seq.filter (fun h -> Option.isSome h.Text)
|> Seq.sortByDescending (_.AsOf)
|> Seq.map (fun h -> Option.get h.Text)
|> Seq.head
// The history log including notes (and excluding the final entry for answered requests)
let log =
let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
let all =
req.Notes
|> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> Array.append (req.History |> Array.map toDisp)
|> Array.sortByDescending (fun it -> it.asOf)
|> List.ofArray
|> Seq.ofList
|> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> Seq.append (req.History |> List.map toDisp)
|> Seq.sortByDescending (_.asOf)
|> List.ofSeq
// Skip the first entry for answered requests; that info is already displayed
match answered with Some _ -> all.Tail | None -> all
article [ _class "container mt-3" ] [
@ -109,7 +112,7 @@ let full (clock : IClock) tz (req : Request) =
match answered with
| Some date ->
str "Answered "
date.ToDateTimeOffset().ToString ("D", null) |> str
date.ToDateTimeOffset().ToString("D", null) |> str
str " ("
relativeDate date now tz
rawText ") &bull; "
@ -124,7 +127,7 @@ let full (clock : IClock) tz (req : Request) =
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]

View File

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

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long