Convert Data Storage to PostgreSQL Documents (#74)

This commit is contained in:
Daniel J. Summers 2023-10-09 22:15:38 -04:00 committed by GitHub
parent 3df5c71d81
commit b9d81fb7aa
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 561 additions and 584 deletions

2
.gitignore vendored
View File

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

17
src/Dockerfile Normal file
View File

@ -0,0 +1,17 @@
FROM mcr.microsoft.com/dotnet/sdk:7.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/net7.0/linux-x64/publish/appsettings.*.json
FROM mcr.microsoft.com/dotnet/aspnet:7.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/net7.0/linux-x64/publish/ ./
EXPOSE 80
CMD [ "dotnet", "/app/MyPrayerJournal.dll" ]

View File

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

View File

@ -0,0 +1,106 @@
module MyPrayerJournal.LiteData
open LiteDB
open MyPrayerJournal
open NodaTime
/// 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 : Instant
/// 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 : Instant option
/// The time at which this request should reappear in the user's journal by recurrence
ShowAfter : Instant option
/// The recurrence for this request
Recurrence : Recurrence
/// The history entries for this request
History : History[]
/// The notes for this request
Notes : Note[]
}
/// LiteDB extensions
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.Requests = this.GetCollection<OldRequest> "request"
/// Map domain to LiteDB
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
[<RequireQualifiedAccess>]
module Mapping =
open NodaTime.Text
/// A NodaTime instant pattern to use for parsing instants from the database
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
/// Mapping for NodaTime's Instant type
module Instant =
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
/// Mapping for option types
module Option =
let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
/// Mapping for Recurrence
module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction
module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
/// Mapping for RequestId
module RequestId =
let fromBson (value : BsonValue) = RequestId.ofString value.AsString
let toBson (value : RequestId) : BsonValue = RequestId.toString value
/// Mapping for UserId
module UserId =
let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value
/// Set up the mapping
let register () =
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
/// 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 ()

View File

@ -2,10 +2,12 @@
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework> <TargetFramework>net7.0</TargetFramework>
<NoWarn>3391</NoWarn>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="LiteData.fs" />
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
@ -13,4 +15,9 @@
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" /> <ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Include="LiteDB" Version="5.0.17" />
<PackageReference Update="FSharp.Core" Version="7.0.400" />
</ItemGroup>
</Project> </Project>

View File

@ -0,0 +1,33 @@
open LiteDB
open MyPrayerJournal.Data
open MyPrayerJournal.Domain
open MyPrayerJournal.LiteData
open Microsoft.Extensions.Configuration
let lite = new LiteDatabase "Filename=./mpj.db"
Startup.ensureDb lite
let cfg = (ConfigurationBuilder().AddJsonFile "appsettings.json").Build ()
Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
let reqs = lite.Requests.FindAll ()
reqs
|> Seq.map (fun old ->
{ Request.empty with
Id = old.Id
EnteredOn = old.EnteredOn
UserId = old.UserId
SnoozedUntil = old.SnoozedUntil
ShowAfter = old.ShowAfter
Recurrence = old.Recurrence
History = old.History |> Array.sortByDescending (fun it -> it.AsOf) |> List.ofArray
Notes = old.Notes |> Array.sortByDescending (fun it -> it.AsOf) |> List.ofArray
})
|> Seq.map Request.add
|> List.ofSeq
|> List.iter (Async.AwaitTask >> Async.RunSynchronously)
System.Console.WriteLine $"Migration complete - {Seq.length reqs} requests migrated"

View File

@ -1,11 +1,11 @@

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}" Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}"
EndProject EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
@ -24,5 +24,9 @@ Global
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.Build.0 = Debug|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.ActiveCfg = Release|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection EndGlobalSection
EndGlobal EndGlobal

View File

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

View File

@ -1,199 +1,205 @@
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.Npgsql.FSharp.Documents
/// Connection
[<RequireQualifiedAccess>]
module Connection =
open BitBadger.Npgsql.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.ensureIndex 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.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
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
/// Mapping for NodaTime's Instant type
module Instant =
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
/// Mapping for option types
module Option =
let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
/// Mapping for Recurrence
module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction
module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
/// Mapping for RequestId
module RequestId =
let fromBson (value : BsonValue) = RequestId.ofString value.AsString
let toBson (value : RequestId) : BsonValue = RequestId.toString value
/// Mapping for UserId
module UserId =
let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value
/// Set up the mapping
let register () =
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
/// Code to be run at startup
module Startup =
/// Ensure the database is set up
let ensureDb (db : LiteDatabase) =
db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
Mapping.register ()
/// Async wrappers for LiteDB, and request -> journal mappings
[<AutoOpen>]
module private Helpers =
open System.Linq
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let toListAsync<'T> (q : 'T seq) =
(q.ToList >> Task.FromResult) ()
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let firstAsync<'T> (q : 'T seq) =
q.FirstOrDefault () |> Task.FromResult
/// Async wrapper around a request update
let doUpdate (db : LiteDatabase) (req : Request) =
db.Requests.Update req |> ignore
Task.CompletedTask
/// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None
}
/// Add a history entry
let addHistory reqId userId hist db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Add a note
let addNote reqId userId note db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Add a request /// Add a request
let addRequest (req : Request) (db : LiteDatabase) = let add req = backgroundTask {
db.Requests.Insert req |> ignore do! insert Table.Request (RequestId.toString req.Id) req
/// 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 /// Does a request exist for the given request ID and user ID?
let answeredRequests userId db = backgroundTask { let existsById (reqId : RequestId) (userId : UserId) =
let! reqs = getRequestsForUser userId db Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
/// Retrieve a request by its ID and user ID
let tryById reqId userId = backgroundTask {
match! Find.byId<Request> Table.Request (RequestId.toString reqId) with
| Some req when req.UserId = userId -> return Some req
| _ -> return None
}
/// Update recurrence for a request
let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |}
| false -> invalidOp "Request ID {dbId} not found"
}
/// Update the show-after time for a request
let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |}
| false -> invalidOp "Request ID {dbId} not found"
}
/// Update the snoozed and show-after values for a request
let updateSnoozed reqId userId (until : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
| false -> invalidOp "Request ID {dbId} not found"
}
/// Specific manipulation of history entries
[<RequireQualifiedAccess>]
module History =
/// Add a history entry
let add reqId userId hist = backgroundTask {
let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Update.partialById Table.Request dbId
{| History = (hist :: req.History) |> List.sortByDescending (fun it -> it.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found"
}
/// Data access functions for journal-style requests
[<RequireQualifiedAccess>]
module Journal =
/// Retrieve a user's answered requests
let answered (userId : UserId) = backgroundTask {
let! reqs =
Custom.list
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
[ "@criteria", Query.jsonbDocParam {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ == "Answered")"""
] fromData<Request>
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 (fun it -> it.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"}"""
[ "@criteria", Query.jsonbDocParam {| 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 (fun it -> it.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 { /// Specific manipulation of note entries
match! tryFullRequestById reqId userId db with [<RequireQualifiedAccess>]
| Some req -> do! doUpdate db { req with Recurrence = recurType } module Note =
| None -> invalidOp $"{RequestId.toString reqId} not found"
/// Add a note
let add reqId userId note = backgroundTask {
let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Update.partialById Table.Request dbId
{| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found"
} }
/// Update a snoozed request /// Retrieve notes for a request by the request ID
let updateSnoozed reqId userId until db = backgroundTask { let byRequestId reqId userId = backgroundTask {
match! tryFullRequestById reqId userId db with match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return []
| Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with ShowAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
} }

View File

@ -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:
@ -247,19 +248,17 @@ module JournalRequest =
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 (fun it -> it.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
} }

View File

@ -1,4 +1,4 @@
/// HTTP handlers for the myPrayerJournal API /// HTTP handlers for the myPrayerJournal API
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module MyPrayerJournal.Handlers module MyPrayerJournal.Handlers
@ -45,16 +45,12 @@ 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
@ -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 =
@ -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
@ -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,14 +251,14 @@ 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
@ -333,7 +330,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,46 +341,42 @@ 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)
@ -392,62 +385,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
@ -458,7 +445,6 @@ 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 =
@ -468,15 +454,14 @@ 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
} }
@ -484,25 +469,24 @@ module Request =
// 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"

View File

@ -1,10 +1,11 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net7.0</TargetFramework> <TargetFramework>net7.0</TargetFramework>
<Version>3.2</Version> <Version>3.3</Version>
<DebugType>embedded</DebugType> <DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile> <GenerateDocumentationFile>false</GenerateDocumentationFile>
<NoWarn>3391</NoWarn> <PublishSingleFile>false</PublishSingleFile>
<SelfContained>false</SelfContained>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Domain.fs" /> <Compile Include="Domain.fs" />
@ -19,15 +20,16 @@
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" /> <PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta3" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.2.42" />
<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.2.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.2" /> <PackageReference Include="Giraffe.Htmx" Version="1.9.6" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.2" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" />
<PackageReference Include="LiteDB" Version="5.0.16" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.11" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.5" /> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
<PackageReference Include="NodaTime" Version="3.1.2" /> <PackageReference Include="Npgsql.NodaTime" Version="7.0.6" />
<PackageReference Update="FSharp.Core" Version="7.0.300" /> <PackageReference Update="FSharp.Core" Version="7.0.400" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />

View File

@ -1,99 +1,62 @@
module MyPrayerJournal.Api module MyPrayerJournal.Api
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Hosting
open System.IO
/// Configuration functions for the application
module Configure =
/// Configure the content root
let contentRoot root =
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open Microsoft.Extensions.Configuration
/// Configure the application configuration
let appConfiguration (bldr : WebApplicationBuilder) =
bldr.Configuration
.SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
.AddEnvironmentVariables ()
|> ignore
bldr
open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json
let kestrel (bldr : WebApplicationBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
bldr
/// Configure the web root directory
let webRoot pathSegments (bldr : WebApplicationBuilder) =
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
bldr
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Hosting
/// Configure logging
let logging (bldr : WebApplicationBuilder) =
if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
bldr.Logging.AddConsole().AddDebug() |> ignore
bldr
open Giraffe
open LiteDB
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Authentication.OpenIdConnect
open Microsoft.AspNetCore.Http open Microsoft.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) = 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 ()
@ -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
/// Configure the web application
let application (app : WebApplication) =
let _ = app.UseStaticFiles () let _ = app.UseStaticFiles ()
let _ = app.UseCookiePolicy () let _ = app.UseCookiePolicy ()
let _ = app.UseRouting () let _ = app.UseRouting ()
let _ = app.UseAuthentication () 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

View File

@ -77,9 +77,9 @@ let htmlHead ctx =
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" ]
@ -118,8 +118,8 @@ let htmlFoot =
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 () { "

View File

@ -77,28 +77,31 @@ 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
|> Seq.tryHead
|> Option.map (fun x -> x.AsOf) |> Option.map (fun x -> x.AsOf)
let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0" let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0"
let daysOpen = let daysOpen =
let asOf = defaultArg answered now let asOf = defaultArg answered now
((asOf - (req.History |> 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 (fun h -> h.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 (fun it -> it.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" ] [

View File

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

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long