Compare commits
10 Commits
Author | SHA1 | Date | |
---|---|---|---|
24c503385e | |||
b393a86bb5 | |||
8ee3c6b483 | |||
b07532ab50 | |||
b3f62c2586 | |||
20dcaf6e1b | |||
b9d81fb7aa | |||
3df5c71d81 | |||
c697001736 | |||
|
6c28cfc1ec |
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -254,3 +254,5 @@ paket-files/
|
|||
|
||||
# Ionide VSCode extension
|
||||
.ionide
|
||||
|
||||
src/environment.txt
|
||||
|
|
17
src/Dockerfile
Normal file
17
src/Dockerfile
Normal 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" ]
|
|
@ -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>
|
|
@ -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"
|
|
@ -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
|
||||
|
|
3
src/MyPrayerJournal/.gitignore
vendored
3
src/MyPrayerJournal/.gitignore
vendored
|
@ -1,5 +1,2 @@
|
|||
## LiteDB database file
|
||||
*.db
|
||||
|
||||
## Development settings
|
||||
appsettings.Development.json
|
||||
|
|
|
@ -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 []
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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’s"
|
||||
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
|
||||
}
|
||||
|
||||
|
@ -333,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
|
||||
|
@ -344,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
|
||||
|
@ -392,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
|
||||
|
@ -457,10 +447,9 @@ 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
|
||||
|
@ -468,41 +457,39 @@ module Request =
|
|||
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"
|
||||
|
@ -526,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
|
||||
}
|
||||
|
@ -546,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 [
|
||||
|
|
|
@ -1,8 +1,11 @@
|
|||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
<Version>3.1.1</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,19 +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.8" />
|
||||
<PackageReference Include="NodaTime" Version="3.1.2" />
|
||||
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
||||
<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\" />
|
||||
|
|
|
@ -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
|
||||
|
|
184
src/MyPrayerJournal/Views/Docs.fs
Normal file
184
src/MyPrayerJournal/Views/Docs.fs
Normal 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 “no”)" ]
|
||||
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’s time to pray, "
|
||||
rawText "it’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’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’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 “a few "
|
||||
rawText "minutes ago,” 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 “Add a New Request” 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 “Prayed” 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 "“Active” menu link, find the request in the list (likely near the bottom), and click the "
|
||||
rawText "“Show Now” 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 "“Prayed” and move it to the bottom of the list (or off, if you’ve set a recurrence "
|
||||
rawText "period for the request). This allows you, if you’re praying through your requests, to start at "
|
||||
rawText "the top left (with the request that it’s been the longest since you’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 “Updated” "
|
||||
rawText "status; you have the option to also mark this update as “Prayed” or "
|
||||
rawText "“Answered”. 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’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 “Snoozed” menu item will appear next to the “Journal” 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 “Active” and "
|
||||
rawText "“Answered” menu links (and “Snoozed”, if it’s showing), there is a "
|
||||
rawText "“View Full Request” 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 “End” key on your keyboard and read it from "
|
||||
rawText "the bottom up."
|
||||
]
|
||||
p [] [
|
||||
rawText "The “Active” 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 “Cancel "
|
||||
rawText "Snooze” or “Show Now”). The “Answered” link shows all requests that "
|
||||
rawText "have been marked answered. The “Snoozed” 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
|
||||
]
|
|
@ -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 (+)
|
||||
|
|
|
@ -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 " " ]
|
||||
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 "“Log On” link above, and log on with either a Microsoft or Google account. You can "
|
||||
rawText "also learn more about the site at the “Docs” link, also above."
|
||||
]
|
||||
]
|
||||
article [ _class "container mt-3" ]
|
||||
[ p [] [ rawText " " ]
|
||||
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 "“Log On” link above, and log on with either a Microsoft or Google account. You can "
|
||||
rawText "also learn more about the site at the “Docs” 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 " « myPrayerJournal" ]
|
||||
title [] [ rawText ctx.PageTitle; rawText " « 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.1"
|
||||
br []
|
||||
em [] [
|
||||
small [] [
|
||||
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
|
||||
rawText " • "
|
||||
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
|
||||
rawText " • "
|
||||
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 " • "
|
||||
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
|
||||
rawText " • "
|
||||
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 ] ] ]
|
||||
|
|
|
@ -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 ") • "
|
||||
|
@ -124,7 +127,7 @@ let full (clock : IClock) tz (req : Request) =
|
|||
p [ _class "m-0" ] [
|
||||
str it.status
|
||||
rawText " "
|
||||
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 ]
|
||||
|
|
|
@ -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
66
src/MyPrayerJournal/wwwroot/script/htmx.min.js
vendored
66
src/MyPrayerJournal/wwwroot/script/htmx.min.js
vendored
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Reference in New Issue
Block a user