Compare commits
10 Commits
Author | SHA1 | Date | |
---|---|---|---|
24c503385e | |||
b393a86bb5 | |||
8ee3c6b483 | |||
b07532ab50 | |||
b3f62c2586 | |||
20dcaf6e1b | |||
b9d81fb7aa | |||
3df5c71d81 | |||
c697001736 | |||
|
6c28cfc1ec |
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -254,3 +254,5 @@ paket-files/
|
||||||
|
|
||||||
# Ionide VSCode extension
|
# Ionide 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,8 +1,11 @@
|
||||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<TargetFramework>net6.0</TargetFramework>
|
<TargetFramework>net8.0</TargetFramework>
|
||||||
<Version>3.1.1</Version>
|
<Version>3.4</Version>
|
||||||
<NoWarn>3391</NoWarn>
|
<DebugType>embedded</DebugType>
|
||||||
|
<GenerateDocumentationFile>false</GenerateDocumentationFile>
|
||||||
|
<PublishSingleFile>false</PublishSingleFile>
|
||||||
|
<SelfContained>false</SelfContained>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Compile Include="Domain.fs" />
|
<Compile Include="Domain.fs" />
|
||||||
|
@ -13,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="0.19.13" />
|
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
|
||||||
|
<PackageReference Include="FSharp.SystemTextJson" Version="1.3.13" />
|
||||||
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
|
<PackageReference Include="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.8.0" />
|
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
|
||||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
|
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
|
||||||
<PackageReference Include="LiteDB" Version="5.0.12" />
|
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="6.0.8" />
|
<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="6.0.5" />
|
<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,4 +29,14 @@ let noResults heading link buttonText text =
|
||||||
|
|
||||||
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
|
/// 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
|
||||||
|
let version =
|
||||||
|
let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
|
||||||
|
seq {
|
||||||
|
string v.Major
|
||||||
|
if v.Minor > 0 then
|
||||||
|
$".{v.Minor}"
|
||||||
|
if v.Revision > 0 then $".{v.Revision}"
|
||||||
|
} |> Seq.reduce (+)
|
||||||
|
|
|
@ -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 v3.1.1"
|
[ 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
66
src/MyPrayerJournal/wwwroot/script/htmx.min.js
vendored
66
src/MyPrayerJournal/wwwroot/script/htmx.min.js
vendored
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Reference in New Issue
Block a user