Compare commits
7 Commits
Author | SHA1 | Date | |
---|---|---|---|
24c503385e | |||
b393a86bb5 | |||
8ee3c6b483 | |||
b07532ab50 | |||
b3f62c2586 | |||
20dcaf6e1b | |||
b9d81fb7aa |
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -254,3 +254,5 @@ paket-files/
|
||||||
|
|
||||||
# Ionide VSCode extension
|
# Ionide VSCode extension
|
||||||
.ionide
|
.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
|
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||||
# Visual Studio Version 16
|
# Visual Studio Version 16
|
||||||
VisualStudioVersion = 16.0.30114.105
|
VisualStudioVersion = 16.0.30114.105
|
||||||
MinimumVisualStudioVersion = 10.0.40219.1
|
MinimumVisualStudioVersion = 10.0.40219.1
|
||||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
|
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
|
||||||
EndProject
|
EndProject
|
||||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ConvertRecurrence", "MyPrayerJournal.ConvertRecurrence\MyPrayerJournal.ConvertRecurrence.fsproj", "{72B57736-8721-4636-A309-49FA4222416E}"
|
|
||||||
EndProject
|
|
||||||
Global
|
Global
|
||||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||||
Debug|Any CPU = Debug|Any CPU
|
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
|
## Development settings
|
||||||
appsettings.Development.json
|
appsettings.Development.json
|
||||||
|
|
|
@ -1,199 +1,202 @@
|
||||||
module MyPrayerJournal.Data
|
module MyPrayerJournal.Data
|
||||||
|
|
||||||
open LiteDB
|
/// Table(!) used by myPrayerJournal
|
||||||
open MyPrayerJournal
|
module Table =
|
||||||
open System.Threading.Tasks
|
|
||||||
|
|
||||||
/// LiteDB extensions
|
/// Requests
|
||||||
[<AutoOpen>]
|
[<Literal>]
|
||||||
module Extensions =
|
let Request = "mpj.request"
|
||||||
|
|
||||||
/// 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
|
|
||||||
|
|
||||||
|
|
||||||
/// Map domain to LiteDB
|
/// JSON serialization customizations
|
||||||
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module Mapping =
|
module Json =
|
||||||
|
|
||||||
|
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
|
||||||
open NodaTime.Text
|
|
||||||
|
|
||||||
/// A NodaTime instant pattern to use for parsing instants from the database
|
/// Add a request
|
||||||
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
|
let add req =
|
||||||
|
insert<Request> Table.Request req
|
||||||
|
|
||||||
/// Mapping for NodaTime's Instant type
|
/// Does a request exist for the given request ID and user ID?
|
||||||
module Instant =
|
let existsById (reqId : RequestId) (userId : UserId) =
|
||||||
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
|
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
|
||||||
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
|
|
||||||
|
|
||||||
/// Mapping for option types
|
/// Retrieve a request by its ID and user ID
|
||||||
module Option =
|
let tryById reqId userId = backgroundTask {
|
||||||
let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
|
match! Find.byId<string, Request> Table.Request (RequestId.toString reqId) with
|
||||||
let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
|
| Some req when req.UserId = userId -> return Some req
|
||||||
|
| _ -> return None
|
||||||
|
}
|
||||||
|
|
||||||
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
|
/// Update recurrence for a request
|
||||||
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
|
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"
|
||||||
|
}
|
||||||
|
|
||||||
/// Mapping for Recurrence
|
/// Update the show-after time for a request
|
||||||
module Recurrence =
|
let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
|
||||||
let fromBson (value : BsonValue) = Recurrence.ofString value
|
let dbId = RequestId.toString reqId
|
||||||
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
|
match! existsById reqId userId with
|
||||||
|
| true -> do! Patch.byId Table.Request dbId {| ShowAfter = showAfter |}
|
||||||
|
| false -> invalidOp $"Request ID {dbId} not found"
|
||||||
|
}
|
||||||
|
|
||||||
/// Mapping for RequestAction
|
/// Update the snoozed and show-after values for a request
|
||||||
module RequestAction =
|
let updateSnoozed reqId userId (until : Instant option) = backgroundTask {
|
||||||
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
|
let dbId = RequestId.toString reqId
|
||||||
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
|
match! existsById reqId userId with
|
||||||
|
| true -> do! Patch.byId Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
|
||||||
/// Mapping for RequestId
|
| false -> invalidOp $"Request ID {dbId} not found"
|
||||||
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)
|
|
||||||
|
|
||||||
/// Code to be run at startup
|
|
||||||
module Startup =
|
|
||||||
|
|
||||||
/// Ensure the database is set up
|
|
||||||
let ensureDb (db : LiteDatabase) =
|
|
||||||
db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
|
|
||||||
Mapping.register ()
|
|
||||||
|
|
||||||
|
|
||||||
/// Async wrappers for LiteDB, and request -> journal mappings
|
/// Specific manipulation of history entries
|
||||||
[<AutoOpen>]
|
[<RequireQualifiedAccess>]
|
||||||
module private Helpers =
|
module History =
|
||||||
|
|
||||||
open System.Linq
|
/// Add a history entry
|
||||||
|
let add reqId userId hist = backgroundTask {
|
||||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
let dbId = RequestId.toString reqId
|
||||||
let toListAsync<'T> (q : 'T seq) =
|
match! Request.tryById reqId userId with
|
||||||
(q.ToList >> Task.FromResult) ()
|
| Some req ->
|
||||||
|
do! Patch.byId Table.Request dbId {| History = (hist :: req.History) |> List.sortByDescending (_.AsOf) |}
|
||||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
| None -> invalidOp $"Request ID {dbId} not found"
|
||||||
let firstAsync<'T> (q : 'T seq) =
|
}
|
||||||
q.FirstOrDefault () |> Task.FromResult
|
|
||||||
|
|
||||||
/// Async wrapper around a request update
|
|
||||||
let doUpdate (db : LiteDatabase) (req : Request) =
|
|
||||||
db.Requests.Update req |> ignore
|
|
||||||
Task.CompletedTask
|
|
||||||
|
|
||||||
|
|
||||||
/// Retrieve a request, including its history and notes, by its ID and user ID
|
/// Data access functions for journal-style requests
|
||||||
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
|
[<RequireQualifiedAccess>]
|
||||||
let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
|
module Journal =
|
||||||
return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Add a history entry
|
/// Retrieve a user's answered requests
|
||||||
let addHistory reqId userId hist db = backgroundTask {
|
let answered (userId : UserId) = backgroundTask {
|
||||||
match! tryFullRequestById reqId userId db with
|
let! reqs =
|
||||||
| Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History }
|
Custom.list
|
||||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
|
||||||
}
|
[ jsonParam "@criteria" {| UserId = userId |}
|
||||||
|
"@stat", Sql.string """$.history[0].status ? (@ == "Answered")""" ]
|
||||||
/// Add a note
|
fromData<Request>
|
||||||
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"
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Add a request
|
|
||||||
let addRequest (req : Request) (db : LiteDatabase) =
|
|
||||||
db.Requests.Insert req |> ignore
|
|
||||||
|
|
||||||
/// Find all requests for the given user
|
|
||||||
let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask {
|
|
||||||
return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Retrieve all answered requests for the given user
|
|
||||||
let answeredRequests userId db = backgroundTask {
|
|
||||||
let! reqs = getRequestsForUser userId db
|
|
||||||
return
|
return
|
||||||
reqs
|
reqs
|
||||||
|> Seq.map JournalRequest.ofRequestFull
|
|> Seq.ofList
|
||||||
|
|> Seq.map JournalRequest.ofRequestLite
|
||||||
|> Seq.filter (fun it -> it.LastStatus = Answered)
|
|> Seq.filter (fun it -> it.LastStatus = Answered)
|
||||||
|> Seq.sortByDescending (fun it -> it.AsOf)
|
|> Seq.sortByDescending (_.AsOf)
|
||||||
|> List.ofSeq
|
|> List.ofSeq
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Retrieve the user's current journal
|
/// Retrieve a user's current prayer journal (includes snoozed and non-immediate recurrence)
|
||||||
let journalByUserId userId db = backgroundTask {
|
let forUser (userId : UserId) = backgroundTask {
|
||||||
let! reqs = getRequestsForUser userId db
|
let! reqs =
|
||||||
|
Custom.list
|
||||||
|
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
|
||||||
|
[ jsonParam "@criteria" {| UserId = userId |}
|
||||||
|
"@stat", Sql.string """$.history[0].status ? (@ <> "Answered")""" ]
|
||||||
|
fromData<Request>
|
||||||
return
|
return
|
||||||
reqs
|
reqs
|
||||||
|
|> Seq.ofList
|
||||||
|> Seq.map JournalRequest.ofRequestLite
|
|> Seq.map JournalRequest.ofRequestLite
|
||||||
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|
||||||
|> Seq.sortBy (fun it -> it.AsOf)
|
|> Seq.sortBy (_.AsOf)
|
||||||
|> List.ofSeq
|
|> List.ofSeq
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Does the user have any snoozed requests?
|
/// Does the user's journal have any snoozed requests?
|
||||||
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
|
let hasSnoozed userId now = backgroundTask {
|
||||||
let! jrnl = journalByUserId userId db
|
let! jrnl = forUser userId
|
||||||
return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Retrieve a request by its ID and user ID (without notes and history)
|
let tryById reqId userId = backgroundTask {
|
||||||
let tryRequestById reqId userId db = backgroundTask {
|
let! req = Request.tryById reqId userId
|
||||||
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
|
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
|
/// Specific manipulation of note entries
|
||||||
let updateSnoozed reqId userId until db = backgroundTask {
|
[<RequireQualifiedAccess>]
|
||||||
match! tryFullRequestById reqId userId db with
|
module Note =
|
||||||
| 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
|
/// Add a note
|
||||||
let updateShowAfter reqId userId showAfter db = backgroundTask {
|
let add reqId userId note = backgroundTask {
|
||||||
match! tryFullRequestById reqId userId db with
|
let dbId = RequestId.toString reqId
|
||||||
| Some req -> do! doUpdate db { req with ShowAfter = showAfter }
|
match! Request.tryById reqId userId with
|
||||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
| Some req ->
|
||||||
}
|
do! Patch.byId Table.Request dbId {| Notes = (note :: req.Notes) |> List.sortByDescending (_.AsOf) |}
|
||||||
|
| None -> invalidOp $"Request ID {dbId} not found"
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Retrieve notes for a request by the request ID
|
||||||
|
let byRequestId reqId userId = backgroundTask {
|
||||||
|
match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return []
|
||||||
|
}
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/// The data model for myPrayerJournal
|
/// The data model for myPrayerJournal
|
||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
module MyPrayerJournal.Domain
|
module MyPrayerJournal.Domain
|
||||||
|
|
||||||
|
@ -169,10 +169,10 @@ type Request =
|
||||||
Recurrence : Recurrence
|
Recurrence : Recurrence
|
||||||
|
|
||||||
/// The history entries for this request
|
/// The history entries for this request
|
||||||
History : History[]
|
History : History list
|
||||||
|
|
||||||
/// The notes for this request
|
/// The notes for this request
|
||||||
Notes : Note[]
|
Notes : Note list
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Functions to support requests
|
/// Functions to support requests
|
||||||
|
@ -186,8 +186,8 @@ module Request =
|
||||||
SnoozedUntil = None
|
SnoozedUntil = None
|
||||||
ShowAfter = None
|
ShowAfter = None
|
||||||
Recurrence = Immediate
|
Recurrence = Immediate
|
||||||
History = [||]
|
History = []
|
||||||
Notes = [||]
|
Notes = []
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -234,7 +234,8 @@ module JournalRequest =
|
||||||
|
|
||||||
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
|
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
|
||||||
let ofRequestLite (req : Request) =
|
let ofRequestLite (req : Request) =
|
||||||
let 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
|
// 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,
|
// 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:
|
// we will use the last activity date. This will mean that:
|
||||||
|
@ -243,23 +244,21 @@ module JournalRequest =
|
||||||
// them at the bottom of the list.
|
// them at the bottom of the list.
|
||||||
// - Snoozed requests will reappear at the bottom of the list when they return.
|
// - 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.
|
// - 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 showAfter = defaultArg req.ShowAfter Instant.MinValue
|
||||||
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
|
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
|
||||||
let lastPrayed =
|
let lastPrayed =
|
||||||
req.History
|
history
|
||||||
|> Array.sortByDescending (fun it -> it.AsOf)
|
|> Seq.filter History.isPrayed
|
||||||
|> Array.filter History.isPrayed
|
|> Seq.tryHead
|
||||||
|> Array.tryHead
|
|> Option.map (_.AsOf)
|
||||||
|> Option.map (fun it -> it.AsOf)
|
|
||||||
|> Option.defaultValue Instant.MinValue
|
|> Option.defaultValue Instant.MinValue
|
||||||
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
|
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
|
||||||
{ RequestId = req.Id
|
{ RequestId = req.Id
|
||||||
UserId = req.UserId
|
UserId = req.UserId
|
||||||
Text = req.History
|
Text = history
|
||||||
|> Array.filter (fun it -> Option.isSome it.Text)
|
|> Seq.filter (fun it -> Option.isSome it.Text)
|
||||||
|> Array.sortByDescending (fun it -> it.AsOf)
|
|> Seq.tryHead
|
||||||
|> Array.tryHead
|
|
||||||
|> Option.map (fun h -> Option.get h.Text)
|
|> Option.map (fun h -> Option.get h.Text)
|
||||||
|> Option.defaultValue ""
|
|> Option.defaultValue ""
|
||||||
AsOf = if asOf > Instant.MinValue then asOf else lastActivity
|
AsOf = if asOf > Instant.MinValue then asOf else lastActivity
|
||||||
|
@ -275,6 +274,6 @@ module JournalRequest =
|
||||||
/// Same as `ofRequestLite`, but with notes and history
|
/// Same as `ofRequestLite`, but with notes and history
|
||||||
let ofRequestFull req =
|
let ofRequestFull req =
|
||||||
{ ofRequestLite req with
|
{ ofRequestLite req with
|
||||||
History = List.ofArray req.History
|
History = req.History
|
||||||
Notes = List.ofArray req.Notes
|
Notes = req.Notes
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/// HTTP handlers for the myPrayerJournal API
|
/// HTTP handlers for the myPrayerJournal API
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module MyPrayerJournal.Handlers
|
module MyPrayerJournal.Handlers
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@ module private LogOnHelpers =
|
||||||
let logOn url : HttpHandler = fun next ctx -> task {
|
let logOn url : HttpHandler = fun next ctx -> task {
|
||||||
match url with
|
match url with
|
||||||
| Some it ->
|
| Some it ->
|
||||||
do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it))
|
do! ctx.ChallengeAsync("Auth0", AuthenticationProperties(RedirectUri = it))
|
||||||
return! next ctx
|
return! next ctx
|
||||||
| None -> return! challenge "Auth0" next ctx
|
| None -> return! challenge "Auth0" next ctx
|
||||||
}
|
}
|
||||||
|
@ -45,30 +45,26 @@ module Error =
|
||||||
|
|
||||||
|
|
||||||
open System.Security.Claims
|
open System.Security.Claims
|
||||||
open LiteDB
|
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open NodaTime
|
open NodaTime
|
||||||
|
|
||||||
/// Extensions on the HTTP context
|
/// Extensions on the HTTP context
|
||||||
type HttpContext with
|
type HttpContext with
|
||||||
|
|
||||||
/// The LiteDB database
|
|
||||||
member this.Db = this.GetService<LiteDatabase> ()
|
|
||||||
|
|
||||||
/// The "sub" for the current user (None if no user is authenticated)
|
/// The "sub" for the current user (None if no user is authenticated)
|
||||||
member this.CurrentUser =
|
member this.CurrentUser =
|
||||||
this.User
|
this.User
|
||||||
|> Option.ofObj
|
|> Option.ofObj
|
||||||
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|
||||||
|> Option.flatten
|
|> Option.flatten
|
||||||
|> Option.map (fun claim -> claim.Value)
|
|> Option.map (_.Value)
|
||||||
|
|
||||||
/// The current user's ID
|
/// The current user's ID
|
||||||
// NOTE: this may raise if you don't run the request through the requireUser handler first
|
// NOTE: this may raise if you don't run the request through the requireUser handler first
|
||||||
member this.UserId = UserId this.CurrentUser.Value
|
member this.UserId = UserId this.CurrentUser.Value
|
||||||
|
|
||||||
/// The system clock
|
/// The system clock
|
||||||
member this.Clock = this.GetService<IClock> ()
|
member this.Clock = this.GetService<IClock>()
|
||||||
|
|
||||||
/// Get the current instant from the system clock
|
/// Get the current instant from the system clock
|
||||||
member this.Now = this.Clock.GetCurrentInstant
|
member this.Now = this.Clock.GetCurrentInstant
|
||||||
|
@ -83,6 +79,8 @@ type HttpContext with
|
||||||
| None -> DateTimeZone.Utc
|
| None -> DateTimeZone.Utc
|
||||||
|
|
||||||
|
|
||||||
|
open MyPrayerJournal.Data
|
||||||
|
|
||||||
/// Handler helpers
|
/// Handler helpers
|
||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
module private Helpers =
|
module private Helpers =
|
||||||
|
@ -96,7 +94,7 @@ module private Helpers =
|
||||||
|
|
||||||
/// Debug logger
|
/// Debug logger
|
||||||
let debug (ctx : HttpContext) message =
|
let debug (ctx : HttpContext) message =
|
||||||
let fac = ctx.GetService<ILoggerFactory> ()
|
let fac = ctx.GetService<ILoggerFactory>()
|
||||||
let log = fac.CreateLogger "Debug"
|
let log = fac.CreateLogger "Debug"
|
||||||
log.LogInformation message
|
log.LogInformation message
|
||||||
|
|
||||||
|
@ -117,7 +115,7 @@ module private Helpers =
|
||||||
let renderComponent nodes : HttpHandler =
|
let renderComponent nodes : HttpHandler =
|
||||||
noResponseCaching
|
noResponseCaching
|
||||||
>=> fun _ ctx -> backgroundTask {
|
>=> fun _ ctx -> backgroundTask {
|
||||||
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
|
return! ctx.WriteHtmlStringAsync(ViewEngine.RenderView.AsString.htmlNodes nodes)
|
||||||
}
|
}
|
||||||
|
|
||||||
open Views.Layout
|
open Views.Layout
|
||||||
|
@ -127,7 +125,7 @@ module private Helpers =
|
||||||
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
|
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
|
||||||
let! hasSnoozed =
|
let! hasSnoozed =
|
||||||
match ctx.CurrentUser with
|
match ctx.CurrentUser with
|
||||||
| Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
|
| Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now())
|
||||||
| None -> Task.FromResult false
|
| None -> Task.FromResult false
|
||||||
return
|
return
|
||||||
{ IsAuthenticated = Option.isSome ctx.CurrentUser
|
{ IsAuthenticated = Option.isSome ctx.CurrentUser
|
||||||
|
@ -155,7 +153,7 @@ module private Helpers =
|
||||||
|
|
||||||
/// Push a new message into the list
|
/// Push a new message into the list
|
||||||
let push (ctx : HttpContext) message url = lock upd8 (fun () ->
|
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
|
/// Add a success message header to the response
|
||||||
let pushSuccess ctx message url =
|
let pushSuccess ctx message url =
|
||||||
|
@ -238,7 +236,6 @@ module Models =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
open MyPrayerJournal.Data.Extensions
|
|
||||||
open NodaTime.Text
|
open NodaTime.Text
|
||||||
|
|
||||||
/// Handlers for less-than-full-page HTML requests
|
/// Handlers for less-than-full-page HTML requests
|
||||||
|
@ -254,15 +251,15 @@ module Components =
|
||||||
| Some snooze, _ when snooze < now -> true
|
| Some snooze, _ when snooze < now -> true
|
||||||
| _, Some hide when hide < now -> true
|
| _, Some hide when hide < now -> true
|
||||||
| _, _ -> false
|
| _, _ -> false
|
||||||
let! journal = Data.journalByUserId ctx.UserId ctx.Db
|
let! journal = Journal.forUser ctx.UserId
|
||||||
let shown = journal |> List.filter shouldBeShown
|
let shown = journal |> List.filter shouldBeShown
|
||||||
return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx
|
return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// GET /components/request-item/[req-id]
|
// GET /components/request-item/[req-id]
|
||||||
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
|
match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with
|
||||||
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx
|
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now()) ctx.TimeZone req ] next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -272,8 +269,8 @@ module Components =
|
||||||
|
|
||||||
// GET /components/request/[req-id]/notes
|
// GET /components/request/[req-id]/notes
|
||||||
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
|
let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
|
||||||
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx
|
return! renderComponent (Views.Request.notes (ctx.Now()) ctx.TimeZone notes) next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// GET /components/request/[req-id]/snooze
|
// GET /components/request/[req-id]/snooze
|
||||||
|
@ -281,13 +278,16 @@ module Components =
|
||||||
requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
|
requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
|
||||||
|
|
||||||
|
|
||||||
/// / URL
|
/// / URL and documentation
|
||||||
module Home =
|
module Home =
|
||||||
|
|
||||||
// GET /
|
// GET /
|
||||||
let home : HttpHandler =
|
let home : HttpHandler =
|
||||||
partialStatic "Welcome!" Views.Layout.home
|
partialStatic "Welcome!" Views.Layout.home
|
||||||
|
|
||||||
|
// GET /docs
|
||||||
|
let docs : HttpHandler =
|
||||||
|
partialStatic "Documentation" Views.Docs.index
|
||||||
|
|
||||||
/// /journal URL
|
/// /journal URL
|
||||||
module Journal =
|
module Journal =
|
||||||
|
@ -297,9 +297,9 @@ module Journal =
|
||||||
let usr =
|
let usr =
|
||||||
ctx.User.Claims
|
ctx.User.Claims
|
||||||
|> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
|
|> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
|
||||||
|> Option.map (fun c -> c.Value)
|
|> Option.map (_.Value)
|
||||||
|> Option.defaultValue "Your"
|
|> Option.defaultValue "Your"
|
||||||
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
|
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s’s"
|
||||||
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
|
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -333,7 +333,7 @@ module Request =
|
||||||
return! partial "Add Prayer Request"
|
return! partial "Add Prayer Request"
|
||||||
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
|
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
|
||||||
| _ ->
|
| _ ->
|
||||||
match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
|
match! Journal.tryById (RequestId.ofString requestId) ctx.UserId with
|
||||||
| Some req ->
|
| Some req ->
|
||||||
debug ctx "Found - sending view"
|
debug ctx "Found - sending view"
|
||||||
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
|
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
|
||||||
|
@ -344,47 +344,43 @@ module Request =
|
||||||
|
|
||||||
// PATCH /request/[req-id]/prayed
|
// PATCH /request/[req-id]/prayed
|
||||||
let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let reqId = RequestId.ofString requestId
|
let reqId = RequestId.ofString requestId
|
||||||
match! Data.tryRequestById reqId userId db with
|
match! Journal.tryById reqId userId with
|
||||||
| Some req ->
|
| Some req ->
|
||||||
let now = ctx.Now ()
|
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 =
|
let nextShow =
|
||||||
match Recurrence.duration req.Recurrence with
|
match Recurrence.duration req.Recurrence with
|
||||||
| 0L -> None
|
| 0L -> None
|
||||||
| duration -> Some <| now.Plus (Duration.FromSeconds duration)
|
| duration -> Some <| now.Plus (Duration.FromSeconds duration)
|
||||||
do! Data.updateShowAfter reqId userId nextShow db
|
do! Request.updateShowAfter reqId userId nextShow
|
||||||
do! db.SaveChanges ()
|
|
||||||
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
|
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
/// POST /request/[req-id]/note
|
// POST /request/[req-id]/note
|
||||||
let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let reqId = RequestId.ofString requestId
|
let reqId = RequestId.ofString requestId
|
||||||
match! Data.tryRequestById reqId userId db with
|
match! Request.existsById reqId userId with
|
||||||
| Some _ ->
|
| true ->
|
||||||
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
|
let! notes = ctx.BindFormAsync<Models.NoteEntry>()
|
||||||
do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
|
do! Note.add reqId userId { AsOf = ctx.Now(); Notes = notes.notes }
|
||||||
do! db.SaveChanges ()
|
|
||||||
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
|
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| false -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// GET /requests/active
|
// GET /requests/active
|
||||||
let active : HttpHandler = requireUser >=> fun next ctx -> task {
|
let active : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
|
let! reqs = Journal.forUser ctx.UserId
|
||||||
return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx
|
return! partial "Active Requests" (Views.Request.active (ctx.Now()) ctx.TimeZone reqs) next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// GET /requests/snoozed
|
// GET /requests/snoozed
|
||||||
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
|
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
|
let! reqs = Journal.forUser ctx.UserId
|
||||||
let now = ctx.Now ()
|
let now = ctx.Now()
|
||||||
let snoozed = reqs
|
let snoozed = reqs
|
||||||
|> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
|> 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
|
return! partial "Snoozed Requests" (Views.Request.snoozed now ctx.TimeZone snoozed) next ctx
|
||||||
|
@ -392,62 +388,56 @@ module Request =
|
||||||
|
|
||||||
// GET /requests/answered
|
// GET /requests/answered
|
||||||
let answered : HttpHandler = requireUser >=> fun next ctx -> task {
|
let answered : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! reqs = Data.answeredRequests ctx.UserId ctx.Db
|
let! reqs = Journal.answered ctx.UserId
|
||||||
return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx
|
return! partial "Answered Requests" (Views.Request.answered (ctx.Now()) ctx.TimeZone reqs) next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// GET /request/[req-id]/full
|
// GET /request/[req-id]/full
|
||||||
let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
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
|
| Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| None -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// PATCH /request/[req-id]/show
|
// PATCH /request/[req-id]/show
|
||||||
let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let reqId = RequestId.ofString requestId
|
let reqId = RequestId.ofString requestId
|
||||||
match! Data.tryRequestById reqId userId db with
|
match! Request.existsById reqId userId with
|
||||||
| Some _ ->
|
| true ->
|
||||||
do! Data.updateShowAfter reqId userId None db
|
do! Request.updateShowAfter reqId userId None
|
||||||
do! db.SaveChanges ()
|
|
||||||
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
|
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| false -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// PATCH /request/[req-id]/snooze
|
// PATCH /request/[req-id]/snooze
|
||||||
let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let reqId = RequestId.ofString requestId
|
let reqId = RequestId.ofString requestId
|
||||||
match! Data.tryRequestById reqId userId db with
|
match! Request.existsById reqId userId with
|
||||||
| Some _ ->
|
| true ->
|
||||||
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
|
let! until = ctx.BindFormAsync<Models.SnoozeUntil>()
|
||||||
let date =
|
let date =
|
||||||
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
|
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
|
||||||
.AtStartOfDayInZone(DateTimeZone.Utc)
|
.AtStartOfDayInZone(DateTimeZone.Utc)
|
||||||
.ToInstant ()
|
.ToInstant()
|
||||||
do! Data.updateSnoozed reqId userId (Some date) db
|
do! Request.updateSnoozed reqId userId (Some date)
|
||||||
do! db.SaveChanges ()
|
|
||||||
return!
|
return!
|
||||||
(withSuccessMessage $"Request snoozed until {until.until}"
|
(withSuccessMessage $"Request snoozed until {until.until}"
|
||||||
>=> hideModal "snooze"
|
>=> hideModal "snooze"
|
||||||
>=> Components.journalItems) next ctx
|
>=> Components.journalItems) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| false -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// PATCH /request/[req-id]/cancel-snooze
|
// PATCH /request/[req-id]/cancel-snooze
|
||||||
let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let reqId = RequestId.ofString requestId
|
let reqId = RequestId.ofString requestId
|
||||||
match! Data.tryRequestById reqId userId db with
|
match! Request.existsById reqId userId with
|
||||||
| Some _ ->
|
| true ->
|
||||||
do! Data.updateSnoozed reqId userId None db
|
do! Request.updateSnoozed reqId userId None
|
||||||
do! db.SaveChanges ()
|
|
||||||
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
|
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
|
||||||
| None -> return! Error.notFound next ctx
|
| false -> return! Error.notFound next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Derive a recurrence from its representation in the form
|
/// Derive a recurrence from its representation in the form
|
||||||
|
@ -457,10 +447,9 @@ module Request =
|
||||||
|
|
||||||
// POST /request
|
// POST /request
|
||||||
let add : HttpHandler = requireUser >=> fun next ctx -> task {
|
let add : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! form = ctx.BindModelAsync<Models.Request> ()
|
let! form = ctx.BindModelAsync<Models.Request>()
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
let userId = ctx.UserId
|
||||||
let now = ctx.Now ()
|
let now = ctx.Now()
|
||||||
let req =
|
let req =
|
||||||
{ Request.empty with
|
{ Request.empty with
|
||||||
Id = Cuid.generate () |> RequestId
|
Id = Cuid.generate () |> RequestId
|
||||||
|
@ -468,41 +457,39 @@ module Request =
|
||||||
EnteredOn = now
|
EnteredOn = now
|
||||||
ShowAfter = None
|
ShowAfter = None
|
||||||
Recurrence = parseRecurrence form
|
Recurrence = parseRecurrence form
|
||||||
History = [|
|
History = [
|
||||||
{ AsOf = now
|
{ AsOf = now
|
||||||
Status = Created
|
Status = Created
|
||||||
Text = Some form.requestText
|
Text = Some form.requestText
|
||||||
}
|
}
|
||||||
|]
|
]
|
||||||
}
|
}
|
||||||
Data.addRequest req db
|
do! Request.add req
|
||||||
do! db.SaveChanges ()
|
|
||||||
Messages.pushSuccess ctx "Added prayer request" "/journal"
|
Messages.pushSuccess ctx "Added prayer request" "/journal"
|
||||||
return! seeOther "/journal" next ctx
|
return! seeOther "/journal" next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
// PATCH /request
|
// PATCH /request
|
||||||
let update : HttpHandler = requireUser >=> fun next ctx -> task {
|
let update : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||||
let! form = ctx.BindModelAsync<Models.Request> ()
|
let! form = ctx.BindModelAsync<Models.Request>()
|
||||||
let db = ctx.Db
|
|
||||||
let userId = ctx.UserId
|
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 ->
|
| Some req ->
|
||||||
// update recurrence if changed
|
// update recurrence if changed
|
||||||
let recur = parseRecurrence form
|
let recur = parseRecurrence form
|
||||||
match recur = req.Recurrence with
|
match recur = req.Recurrence with
|
||||||
| true -> ()
|
| true -> ()
|
||||||
| false ->
|
| false ->
|
||||||
do! Data.updateRecurrence req.RequestId userId recur db
|
do! Request.updateRecurrence req.RequestId userId recur
|
||||||
match recur with
|
match recur with
|
||||||
| Immediate -> do! Data.updateShowAfter req.RequestId userId None db
|
| Immediate -> do! Request.updateShowAfter req.RequestId userId None
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
// append history
|
// append history
|
||||||
let upd8Text = form.requestText.Trim ()
|
let upd8Text = form.requestText.Trim()
|
||||||
let text = if upd8Text = req.Text then None else Some upd8Text
|
let text = if upd8Text = req.Text then None else Some upd8Text
|
||||||
do! Data.addHistory req.RequestId userId
|
do! History.add req.RequestId userId
|
||||||
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
|
{ AsOf = ctx.Now(); Status = (Option.get >> RequestAction.ofString) form.status; Text = text }
|
||||||
do! db.SaveChanges ()
|
|
||||||
let nextUrl =
|
let nextUrl =
|
||||||
match form.returnTo with
|
match form.returnTo with
|
||||||
| "active" -> "/requests/active"
|
| "active" -> "/requests/active"
|
||||||
|
@ -526,7 +513,7 @@ module User =
|
||||||
|
|
||||||
// GET /user/log-off
|
// GET /user/log-off
|
||||||
let logOff : HttpHandler = requireUser >=> fun next ctx -> task {
|
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
|
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
|
||||||
return! next ctx
|
return! next ctx
|
||||||
}
|
}
|
||||||
|
@ -546,6 +533,7 @@ let routes = [
|
||||||
routef "request/%s/snooze" Components.snooze
|
routef "request/%s/snooze" Components.snooze
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
GET_HEAD [ route "/docs" Home.docs ]
|
||||||
GET_HEAD [ route "/journal" Journal.journal ]
|
GET_HEAD [ route "/journal" Journal.journal ]
|
||||||
subRoute "/legal/" [
|
subRoute "/legal/" [
|
||||||
GET_HEAD [
|
GET_HEAD [
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<TargetFramework>net7.0</TargetFramework>
|
<TargetFramework>net8.0</TargetFramework>
|
||||||
<Version>3.2</Version>
|
<Version>3.4</Version>
|
||||||
<DebugType>embedded</DebugType>
|
<DebugType>embedded</DebugType>
|
||||||
<GenerateDocumentationFile>false</GenerateDocumentationFile>
|
<GenerateDocumentationFile>false</GenerateDocumentationFile>
|
||||||
<NoWarn>3391</NoWarn>
|
<PublishSingleFile>false</PublishSingleFile>
|
||||||
|
<SelfContained>false</SelfContained>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Compile Include="Domain.fs" />
|
<Compile Include="Domain.fs" />
|
||||||
|
@ -15,19 +16,21 @@
|
||||||
<Compile Include="Views/Layout.fs" />
|
<Compile Include="Views/Layout.fs" />
|
||||||
<Compile Include="Views/Legal.fs" />
|
<Compile Include="Views/Legal.fs" />
|
||||||
<Compile Include="Views/Request.fs" />
|
<Compile Include="Views/Request.fs" />
|
||||||
|
<Compile Include="Views\Docs.fs" />
|
||||||
<Compile Include="Handlers.fs" />
|
<Compile Include="Handlers.fs" />
|
||||||
<Compile Include="Program.fs" />
|
<Compile Include="Program.fs" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
|
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
|
||||||
|
<PackageReference Include="FSharp.SystemTextJson" Version="1.3.13" />
|
||||||
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
|
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
|
||||||
<PackageReference Include="Giraffe" Version="6.0.0" />
|
<PackageReference Include="Giraffe" Version="6.4.0" />
|
||||||
<PackageReference Include="Giraffe.Htmx" Version="1.9.2" />
|
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
|
||||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.2" />
|
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
|
||||||
<PackageReference Include="LiteDB" Version="5.0.16" />
|
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.5" />
|
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.2.0" />
|
||||||
<PackageReference Include="NodaTime" Version="3.1.2" />
|
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
|
||||||
<PackageReference Update="FSharp.Core" Version="7.0.300" />
|
<PackageReference Update="FSharp.Core" Version="8.0.300" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Folder Include="wwwroot\" />
|
<Folder Include="wwwroot\" />
|
||||||
|
|
|
@ -1,102 +1,65 @@
|
||||||
module MyPrayerJournal.Api
|
module MyPrayerJournal.Api
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Builder
|
open Microsoft.AspNetCore.Http
|
||||||
open Microsoft.AspNetCore.Hosting
|
|
||||||
open System.IO
|
|
||||||
|
|
||||||
/// Configuration functions for the application
|
let sameSite (opts : CookieOptions) =
|
||||||
module Configure =
|
|
||||||
|
|
||||||
/// Configure the content root
|
|
||||||
let contentRoot root =
|
|
||||||
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
|
|
||||||
|
|
||||||
|
|
||||||
open Microsoft.Extensions.Configuration
|
|
||||||
|
|
||||||
/// Configure the application configuration
|
|
||||||
let appConfiguration (bldr : WebApplicationBuilder) =
|
|
||||||
bldr.Configuration
|
|
||||||
.SetBasePath(bldr.Environment.ContentRootPath)
|
|
||||||
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
|
|
||||||
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
|
|
||||||
.AddEnvironmentVariables ()
|
|
||||||
|> ignore
|
|
||||||
bldr
|
|
||||||
|
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
|
||||||
|
|
||||||
/// Configure Kestrel from appsettings.json
|
|
||||||
let kestrel (bldr : WebApplicationBuilder) =
|
|
||||||
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
|
||||||
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
|
||||||
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
|
|
||||||
bldr
|
|
||||||
|
|
||||||
|
|
||||||
/// Configure the web root directory
|
|
||||||
let webRoot pathSegments (bldr : WebApplicationBuilder) =
|
|
||||||
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|
|
||||||
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
|
|
||||||
bldr
|
|
||||||
|
|
||||||
|
|
||||||
open Microsoft.Extensions.Logging
|
|
||||||
open Microsoft.Extensions.Hosting
|
|
||||||
|
|
||||||
/// Configure logging
|
|
||||||
let logging (bldr : WebApplicationBuilder) =
|
|
||||||
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
|
match opts.SameSite, opts.Secure with
|
||||||
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
|
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
|
||||||
| _, _ -> ()
|
| _, _ -> ()
|
||||||
|
|
||||||
let _ = bldr.Services.AddRouting ()
|
open Giraffe
|
||||||
let _ = bldr.Services.AddGiraffe ()
|
open Giraffe.EndpointRouting
|
||||||
let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
|
open Microsoft.AspNetCore.Authentication.Cookies
|
||||||
let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
|
open Microsoft.AspNetCore.Authentication.OpenIdConnect
|
||||||
|
open Microsoft.AspNetCore.Builder
|
||||||
|
open Microsoft.AspNetCore.HttpOverrides
|
||||||
|
open Microsoft.Extensions.Configuration
|
||||||
|
open Microsoft.Extensions.DependencyInjection
|
||||||
|
open Microsoft.Extensions.Hosting
|
||||||
|
open Microsoft.Extensions.Logging
|
||||||
|
open Microsoft.IdentityModel.Protocols.OpenIdConnect
|
||||||
|
open MyPrayerJournal.Data
|
||||||
|
open NodaTime
|
||||||
|
open System
|
||||||
|
open System.Text.Json
|
||||||
|
open System.Threading.Tasks
|
||||||
|
|
||||||
|
[<EntryPoint>]
|
||||||
|
let main args =
|
||||||
|
//use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
|
||||||
|
//host.Run ()
|
||||||
|
let builder = WebApplication.CreateBuilder args
|
||||||
|
let _ = builder.Configuration.AddEnvironmentVariables "MPJ_"
|
||||||
|
let svc = builder.Services
|
||||||
|
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
|
||||||
|
|
||||||
|
let _ = svc.AddRouting()
|
||||||
|
let _ = svc.AddGiraffe()
|
||||||
|
let _ = svc.AddSingleton<IClock> SystemClock.Instance
|
||||||
|
let _ = svc.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
|
||||||
|
let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
|
||||||
|
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
|
svc.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
|
||||||
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
|
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
|
||||||
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
|
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
|
||||||
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
|
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
|
||||||
let _ =
|
let _ =
|
||||||
bldr.Services.AddAuthentication(fun opts ->
|
svc.AddAuthentication(fun opts ->
|
||||||
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
||||||
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
||||||
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
|
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
|
||||||
.AddCookie()
|
.AddCookie()
|
||||||
.AddOpenIdConnect("Auth0", fun opts ->
|
.AddOpenIdConnect("Auth0", fun opts ->
|
||||||
// Configure OIDC with Auth0 options from configuration
|
// Configure OIDC with Auth0 options from configuration
|
||||||
let cfg = bldr.Configuration.GetSection "Auth0"
|
let auth0 = cfg.GetSection "Auth0"
|
||||||
opts.Authority <- $"""https://{cfg["Domain"]}/"""
|
opts.Authority <- $"""https://{auth0["Domain"]}/"""
|
||||||
opts.ClientId <- cfg["Id"]
|
opts.ClientId <- auth0["Id"]
|
||||||
opts.ClientSecret <- cfg["Secret"]
|
opts.ClientSecret <- auth0["Secret"]
|
||||||
opts.ResponseType <- OpenIdConnectResponseType.Code
|
opts.ResponseType <- OpenIdConnectResponseType.Code
|
||||||
|
|
||||||
opts.Scope.Clear ()
|
opts.Scope.Clear()
|
||||||
opts.Scope.Add "openid"
|
opts.Scope.Add "openid"
|
||||||
opts.Scope.Add "profile"
|
opts.Scope.Add "profile"
|
||||||
|
|
||||||
|
@ -104,7 +67,7 @@ module Configure =
|
||||||
opts.ClaimsIssuer <- "Auth0"
|
opts.ClaimsIssuer <- "Auth0"
|
||||||
opts.SaveTokens <- true
|
opts.SaveTokens <- true
|
||||||
|
|
||||||
opts.Events <- OpenIdConnectEvents ()
|
opts.Events <- OpenIdConnectEvents()
|
||||||
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
|
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
|
||||||
let returnTo =
|
let returnTo =
|
||||||
match ctx.Properties.RedirectUri with
|
match ctx.Properties.RedirectUri with
|
||||||
|
@ -118,52 +81,31 @@ module Configure =
|
||||||
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
|
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
|
||||||
| false -> redirUri
|
| false -> redirUri
|
||||||
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
|
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
|
||||||
ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
|
ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}"""
|
||||||
ctx.HandleResponse ()
|
ctx.HandleResponse()
|
||||||
Task.CompletedTask
|
Task.CompletedTask
|
||||||
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
|
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
|
||||||
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
|
let uri = UriBuilder ctx.ProtocolMessage.RedirectUri
|
||||||
bldr.Scheme <- cfg["Scheme"]
|
uri.Scheme <- auth0["Scheme"]
|
||||||
bldr.Port <- int cfg["Port"]
|
uri.Port <- int auth0["Port"]
|
||||||
ctx.ProtocolMessage.RedirectUri <- string bldr
|
ctx.ProtocolMessage.RedirectUri <- string uri
|
||||||
Task.CompletedTask)
|
Task.CompletedTask)
|
||||||
|
|
||||||
let jsonOptions = JsonSerializerOptions ()
|
let _ = svc.AddSingleton<JsonSerializerOptions> Json.options
|
||||||
jsonOptions.Converters.Add (JsonFSharpConverter ())
|
let _ = svc.AddSingleton<Json.ISerializer>(SystemTextJson.Serializer Json.options)
|
||||||
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
|
let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
|
||||||
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 ()
|
if builder.Environment.IsDevelopment() then builder.Logging.AddFilter(fun l -> l > LogLevel.Information) |> ignore
|
||||||
|
let _ = builder.Logging.AddConsole().AddDebug() |> ignore
|
||||||
|
|
||||||
|
use app = builder.Build()
|
||||||
open Giraffe.EndpointRouting
|
let _ = app.UseStaticFiles()
|
||||||
|
let _ = app.UseCookiePolicy()
|
||||||
/// Configure the web application
|
let _ = app.UseRouting()
|
||||||
let application (app : WebApplication) =
|
let _ = app.UseAuthentication()
|
||||||
let _ = app.UseStaticFiles ()
|
|
||||||
let _ = app.UseCookiePolicy ()
|
|
||||||
let _ = app.UseRouting ()
|
|
||||||
let _ = app.UseAuthentication ()
|
|
||||||
let _ = app.UseGiraffeErrorHandler Handlers.Error.error
|
let _ = app.UseGiraffeErrorHandler Handlers.Error.error
|
||||||
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints Handlers.routes)
|
||||||
app
|
|
||||||
|
|
||||||
/// Compose all the configurations into one
|
app.Run()
|
||||||
let webHost pathSegments =
|
|
||||||
contentRoot
|
|
||||||
>> appConfiguration
|
|
||||||
>> kestrel
|
|
||||||
>> webRoot pathSegments
|
|
||||||
>> logging
|
|
||||||
>> services
|
|
||||||
>> application
|
|
||||||
|
|
||||||
|
|
||||||
[<EntryPoint>]
|
|
||||||
let main _ =
|
|
||||||
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
|
|
||||||
host.Run ()
|
|
||||||
0
|
0
|
||||||
|
|
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,7 +29,7 @@ let noResults heading link buttonText text =
|
||||||
|
|
||||||
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
|
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
|
||||||
let relativeDate (date : Instant) now (tz : DateTimeZone) =
|
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
|
/// The version of myPrayerJournal
|
||||||
let version =
|
let version =
|
||||||
|
|
|
@ -7,46 +7,42 @@ open Giraffe.ViewEngine.Accessibility
|
||||||
/// The data needed to render a page-level view
|
/// The data needed to render a page-level view
|
||||||
type PageRenderContext =
|
type PageRenderContext =
|
||||||
{ /// Whether the user is authenticated
|
{ /// Whether the user is authenticated
|
||||||
IsAuthenticated : bool
|
IsAuthenticated: bool
|
||||||
|
|
||||||
/// Whether the user has snoozed requests
|
/// Whether the user has snoozed requests
|
||||||
HasSnoozed : bool
|
HasSnoozed: bool
|
||||||
|
|
||||||
/// The current URL
|
/// The current URL
|
||||||
CurrentUrl : string
|
CurrentUrl: string
|
||||||
|
|
||||||
/// The title for the page to be rendered
|
/// The title for the page to be rendered
|
||||||
PageTitle : string
|
PageTitle: string
|
||||||
|
|
||||||
/// The content of the page
|
/// The content of the page
|
||||||
Content : XmlNode
|
Content: XmlNode }
|
||||||
}
|
|
||||||
|
|
||||||
/// The home page
|
/// The home page
|
||||||
let home =
|
let home =
|
||||||
article [ _class "container mt-3" ] [
|
article [ _class "container mt-3" ]
|
||||||
p [] [ rawText " " ]
|
[ p [] [ rawText " " ]
|
||||||
p [] [
|
p []
|
||||||
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
|
[ 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 "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."
|
str "that request. It also allows individuals to review their answered prayers." ]
|
||||||
]
|
p []
|
||||||
p [] [
|
[ str "This site is open and available to the general public. To get started, simply click the "
|
||||||
str "This site is open and available to the general public. To get started, simply click the "
|
|
||||||
rawText "“Log On” link above, and log on with either a Microsoft or Google account. You can "
|
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."
|
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
|
/// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs
|
||||||
let private navBar ctx =
|
let private navBar ctx =
|
||||||
nav [ _class "navbar navbar-dark"; _roleNavigation ] [
|
nav [ _class "navbar navbar-dark"; _roleNavigation ]
|
||||||
div [ _class "container-fluid" ] [
|
[ div [ _class "container-fluid" ]
|
||||||
pageLink "/" [ _class "navbar-brand" ] [
|
[ pageLink
|
||||||
span [ _class "m" ] [ str "my" ]
|
"/" [ _class "navbar-brand" ]
|
||||||
|
[ span [ _class "m" ] [ str "my" ]
|
||||||
span [ _class "p" ] [ str "Prayer" ]
|
span [ _class "p" ] [ str "Prayer" ]
|
||||||
span [ _class "j" ] [ str "Journal" ]
|
span [ _class "j" ] [ str "Journal" ] ]
|
||||||
]
|
|
||||||
seq {
|
seq {
|
||||||
let navLink (matchUrl : string) =
|
let navLink (matchUrl : string) =
|
||||||
match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
|
match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
|
||||||
|
@ -58,91 +54,72 @@ let private navBar ctx =
|
||||||
li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
|
li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
|
||||||
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
|
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
|
||||||
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
|
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
|
||||||
li [ _class "nav-item" ] [
|
li [ _class "nav-item" ] [ navLink "/docs" [ str "Docs" ] ]
|
||||||
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
|
|
||||||
]
|
|
||||||
}
|
}
|
||||||
|> List.ofSeq
|
|> List.ofSeq
|
||||||
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ]
|
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ] ]
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
/// The title tag with the application name appended
|
/// The title tag with the application name appended
|
||||||
let titleTag ctx =
|
let titleTag ctx =
|
||||||
title [] [ str ctx.PageTitle; rawText " « myPrayerJournal" ]
|
title [] [ rawText ctx.PageTitle; rawText " « myPrayerJournal" ]
|
||||||
|
|
||||||
/// The HTML `head` element
|
/// The HTML `head` element
|
||||||
let htmlHead ctx =
|
let htmlHead ctx =
|
||||||
head [ _lang "en" ] [
|
head [ _lang "en" ]
|
||||||
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
|
[ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
|
||||||
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
|
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
|
||||||
titleTag ctx
|
titleTag ctx
|
||||||
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
|
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/css/bootstrap.min.css"
|
||||||
_rel "stylesheet"
|
_rel "stylesheet"
|
||||||
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
|
_integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN"
|
||||||
_crossorigin "anonymous" ]
|
_crossorigin "anonymous" ]
|
||||||
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
|
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
|
||||||
link [ _href "/style/style.css"; _rel "stylesheet" ]
|
link [ _href "/style/style.css"; _rel "stylesheet" ] ]
|
||||||
]
|
|
||||||
|
|
||||||
/// Element used to display toasts
|
/// Element used to display toasts
|
||||||
let toaster =
|
let toaster =
|
||||||
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [
|
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ]
|
||||||
div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] []
|
[ div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] ]
|
||||||
]
|
|
||||||
|
|
||||||
/// The page's `footer` element
|
/// The page's `footer` element
|
||||||
let htmlFoot =
|
let htmlFoot =
|
||||||
footer [ _class "container-fluid" ] [
|
footer [ _class "container-fluid" ]
|
||||||
p [ _class "text-muted text-end" ] [
|
[ p [ _class "text-muted text-end" ]
|
||||||
str $"myPrayerJournal {version}"
|
[ str $"myPrayerJournal {version}"
|
||||||
br []
|
br []
|
||||||
em [] [
|
em []
|
||||||
small [] [
|
[ small []
|
||||||
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
|
[ pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
|
||||||
rawText " • "
|
rawText " • "
|
||||||
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
|
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
|
||||||
rawText " • "
|
rawText " • "
|
||||||
a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [
|
a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal"
|
||||||
str "Developed"
|
_target "_blank"
|
||||||
]
|
_rel "noopener" ] [ str "Developed" ]
|
||||||
str " and hosted by "
|
str " and hosted by "
|
||||||
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [
|
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ]
|
||||||
str "Bit Badger Solutions"
|
[ str "Bit Badger Solutions" ] ] ] ]
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
Htmx.Script.minified
|
Htmx.Script.minified
|
||||||
script [] [
|
script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')" ]
|
||||||
rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
|
|
||||||
]
|
|
||||||
script [ _async
|
script [ _async
|
||||||
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
|
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js"
|
||||||
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
|
_integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL"
|
||||||
_crossorigin "anonymous" ] []
|
_crossorigin "anonymous" ] []
|
||||||
script [] [
|
script []
|
||||||
rawText "setTimeout(function () { "
|
[ rawText "setTimeout(function () { "
|
||||||
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
|
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
|
||||||
rawText "}, 2000)"
|
rawText "}, 2000)" ]
|
||||||
]
|
script [ _src "/script/mpj.js" ] [] ]
|
||||||
script [ _src "/script/mpj.js" ] []
|
|
||||||
]
|
|
||||||
|
|
||||||
/// Create the full view of the page
|
/// Create the full view of the page
|
||||||
let view ctx =
|
let view ctx =
|
||||||
html [ _lang "en" ] [
|
html [ _lang "en" ]
|
||||||
htmlHead ctx
|
[ htmlHead ctx
|
||||||
body [] [
|
body []
|
||||||
section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
|
[ section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
|
||||||
toaster
|
toaster
|
||||||
htmlFoot
|
htmlFoot ] ]
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
/// Create a partial view
|
/// Create a partial view
|
||||||
let partial ctx =
|
let partial ctx =
|
||||||
html [ _lang "en" ] [
|
html [ _lang "en" ] [ head [] [ titleTag ctx ]; body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] ]
|
||||||
head [] [ titleTag ctx ]
|
|
||||||
body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
|
|
||||||
]
|
|
||||||
|
|
|
@ -74,31 +74,34 @@ let snoozed now tz reqs =
|
||||||
|
|
||||||
/// View for Full Request page
|
/// View for Full Request page
|
||||||
let full (clock : IClock) tz (req : Request) =
|
let full (clock : IClock) tz (req : Request) =
|
||||||
let now = clock.GetCurrentInstant ()
|
let now = clock.GetCurrentInstant()
|
||||||
let answered =
|
let answered =
|
||||||
req.History
|
req.History
|
||||||
|> Array.filter History.isAnswered
|
|> Seq.ofList
|
||||||
|> Array.tryHead
|
|> Seq.filter History.isAnswered
|
||||||
|> Option.map (fun x -> x.AsOf)
|
|> Seq.tryHead
|
||||||
let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0"
|
|> Option.map (_.AsOf)
|
||||||
|
let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0"
|
||||||
let daysOpen =
|
let daysOpen =
|
||||||
let asOf = defaultArg answered now
|
let asOf = defaultArg answered now
|
||||||
((asOf - (req.History |> 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 =
|
let lastText =
|
||||||
req.History
|
req.History
|
||||||
|> Array.filter (fun h -> Option.isSome h.Text)
|
|> Seq.ofList
|
||||||
|> Array.sortByDescending (fun h -> h.AsOf)
|
|> Seq.filter (fun h -> Option.isSome h.Text)
|
||||||
|> Array.map (fun h -> Option.get h.Text)
|
|> Seq.sortByDescending (_.AsOf)
|
||||||
|> Array.head
|
|> Seq.map (fun h -> Option.get h.Text)
|
||||||
|
|> Seq.head
|
||||||
// The history log including notes (and excluding the final entry for answered requests)
|
// The history log including notes (and excluding the final entry for answered requests)
|
||||||
let log =
|
let log =
|
||||||
let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
|
let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
|
||||||
let all =
|
let all =
|
||||||
req.Notes
|
req.Notes
|
||||||
|> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|
|> Seq.ofList
|
||||||
|> Array.append (req.History |> Array.map toDisp)
|
|> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|
||||||
|> Array.sortByDescending (fun it -> it.asOf)
|
|> Seq.append (req.History |> List.map toDisp)
|
||||||
|> List.ofArray
|
|> Seq.sortByDescending (_.asOf)
|
||||||
|
|> List.ofSeq
|
||||||
// Skip the first entry for answered requests; that info is already displayed
|
// Skip the first entry for answered requests; that info is already displayed
|
||||||
match answered with Some _ -> all.Tail | None -> all
|
match answered with Some _ -> all.Tail | None -> all
|
||||||
article [ _class "container mt-3" ] [
|
article [ _class "container mt-3" ] [
|
||||||
|
@ -109,7 +112,7 @@ let full (clock : IClock) tz (req : Request) =
|
||||||
match answered with
|
match answered with
|
||||||
| Some date ->
|
| Some date ->
|
||||||
str "Answered "
|
str "Answered "
|
||||||
date.ToDateTimeOffset().ToString ("D", null) |> str
|
date.ToDateTimeOffset().ToString("D", null) |> str
|
||||||
str " ("
|
str " ("
|
||||||
relativeDate date now tz
|
relativeDate date now tz
|
||||||
rawText ") • "
|
rawText ") • "
|
||||||
|
@ -124,7 +127,7 @@ let full (clock : IClock) tz (req : Request) =
|
||||||
p [ _class "m-0" ] [
|
p [ _class "m-0" ] [
|
||||||
str it.status
|
str it.status
|
||||||
rawText " "
|
rawText " "
|
||||||
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
|
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString("D", null) |> str ] ]
|
||||||
]
|
]
|
||||||
match it.text with
|
match it.text with
|
||||||
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
|
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
|
||||||
|
|
|
@ -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
Loading…
Reference in New Issue
Block a user