Convert Data Storage to PostgreSQL Documents (#74)
This commit is contained in:
parent
3df5c71d81
commit
b9d81fb7aa
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -254,3 +254,5 @@ paket-files/
|
|||
|
||||
# Ionide VSCode extension
|
||||
.ionide
|
||||
|
||||
src/environment.txt
|
||||
|
|
17
src/Dockerfile
Normal file
17
src/Dockerfile
Normal file
|
@ -0,0 +1,17 @@
|
|||
FROM mcr.microsoft.com/dotnet/sdk: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" ]
|
|
@ -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"
|
106
src/MyPrayerJournal.ToPostgres/LiteData.fs
Normal file
106
src/MyPrayerJournal.ToPostgres/LiteData.fs
Normal 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 ()
|
|
@ -2,10 +2,12 @@
|
|||
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
<TargetFramework>net7.0</TargetFramework>
|
||||
<NoWarn>3391</NoWarn>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="LiteData.fs" />
|
||||
<Compile Include="Program.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
|
@ -13,4 +15,9 @@
|
|||
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="LiteDB" Version="5.0.17" />
|
||||
<PackageReference Update="FSharp.Core" Version="7.0.400" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
33
src/MyPrayerJournal.ToPostgres/Program.fs
Normal file
33
src/MyPrayerJournal.ToPostgres/Program.fs
Normal 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"
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
|
||||
|
||||
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||
# Visual Studio Version 16
|
||||
VisualStudioVersion = 16.0.30114.105
|
||||
MinimumVisualStudioVersion = 10.0.40219.1
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ConvertRecurrence", "MyPrayerJournal.ConvertRecurrence\MyPrayerJournal.ConvertRecurrence.fsproj", "{72B57736-8721-4636-A309-49FA4222416E}"
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}"
|
||||
EndProject
|
||||
Global
|
||||
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}.Release|Any CPU.ActiveCfg = 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
|
||||
EndGlobal
|
||||
|
|
3
src/MyPrayerJournal/.gitignore
vendored
3
src/MyPrayerJournal/.gitignore
vendored
|
@ -1,5 +1,2 @@
|
|||
## LiteDB database file
|
||||
*.db
|
||||
|
||||
## Development settings
|
||||
appsettings.Development.json
|
||||
|
|
|
@ -1,199 +1,205 @@
|
|||
module MyPrayerJournal.Data
|
||||
module MyPrayerJournal.Data
|
||||
|
||||
open LiteDB
|
||||
open MyPrayerJournal
|
||||
open System.Threading.Tasks
|
||||
/// Table(!) used by myPrayerJournal
|
||||
module Table =
|
||||
|
||||
/// LiteDB extensions
|
||||
[<AutoOpen>]
|
||||
module Extensions =
|
||||
|
||||
/// Extensions on the LiteDatabase class
|
||||
type LiteDatabase with
|
||||
|
||||
/// The Request collection
|
||||
member this.Requests = this.GetCollection<Request> "request"
|
||||
|
||||
/// Async version of the checkpoint command (flushes log)
|
||||
member this.SaveChanges () =
|
||||
this.Checkpoint ()
|
||||
Task.CompletedTask
|
||||
/// Requests
|
||||
[<Literal>]
|
||||
let Request = "mpj.request"
|
||||
|
||||
|
||||
/// Map domain to LiteDB
|
||||
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
|
||||
/// JSON serialization customizations
|
||||
[<RequireQualifiedAccess>]
|
||||
module Mapping =
|
||||
module Json =
|
||||
|
||||
open System.Text.Json.Serialization
|
||||
|
||||
/// Convert a wrapped DU to/from its string representation
|
||||
type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
|
||||
inherit JsonConverter<'T> ()
|
||||
override _.Read(reader, _, _) =
|
||||
wrap (reader.GetString ())
|
||||
override _.Write(writer, value, _) =
|
||||
writer.WriteStringValue (unwrap value)
|
||||
|
||||
open System.Text.Json
|
||||
open NodaTime.Serialization.SystemTextJson
|
||||
|
||||
/// JSON serializer options to support the target domain
|
||||
let options =
|
||||
let opts = JsonSerializerOptions ()
|
||||
[ WrappedJsonConverter (Recurrence.ofString, Recurrence.toString) :> JsonConverter
|
||||
WrappedJsonConverter (RequestAction.ofString, RequestAction.toString)
|
||||
WrappedJsonConverter (RequestId.ofString, RequestId.toString)
|
||||
WrappedJsonConverter (UserId, UserId.toString)
|
||||
JsonFSharpConverter ()
|
||||
]
|
||||
|> List.iter opts.Converters.Add
|
||||
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
|
||||
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
|
||||
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
|
||||
opts
|
||||
|
||||
|
||||
open BitBadger.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.Text
|
||||
|
||||
/// A NodaTime instant pattern to use for parsing instants from the database
|
||||
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
|
||||
/// Add a request
|
||||
let add req = backgroundTask {
|
||||
do! insert Table.Request (RequestId.toString req.Id) req
|
||||
}
|
||||
|
||||
/// 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)
|
||||
/// Does a request exist for the given request ID and user ID?
|
||||
let existsById (reqId : RequestId) (userId : UserId) =
|
||||
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
|
||||
|
||||
/// 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
|
||||
/// 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
|
||||
}
|
||||
|
||||
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 -> ""
|
||||
/// 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"
|
||||
}
|
||||
|
||||
/// Mapping for Recurrence
|
||||
module Recurrence =
|
||||
let fromBson (value : BsonValue) = Recurrence.ofString value
|
||||
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
|
||||
/// 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"
|
||||
}
|
||||
|
||||
/// 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 ()
|
||||
/// 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"
|
||||
}
|
||||
|
||||
|
||||
/// Async wrappers for LiteDB, and request -> journal mappings
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
/// Specific manipulation of history entries
|
||||
[<RequireQualifiedAccess>]
|
||||
module History =
|
||||
|
||||
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
|
||||
/// 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"
|
||||
}
|
||||
|
||||
|
||||
/// Retrieve a request, including its history and notes, by its ID and user ID
|
||||
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
|
||||
let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
|
||||
return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None
|
||||
}
|
||||
/// Data access functions for journal-style requests
|
||||
[<RequireQualifiedAccess>]
|
||||
module Journal =
|
||||
|
||||
/// Add a history entry
|
||||
let addHistory reqId userId hist db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// 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
|
||||
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
|
||||
/// 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
|
||||
reqs
|
||||
|> Seq.map JournalRequest.ofRequestFull
|
||||
|> Seq.ofList
|
||||
|> Seq.map JournalRequest.ofRequestLite
|
||||
|> Seq.filter (fun it -> it.LastStatus = Answered)
|
||||
|> Seq.sortByDescending (fun it -> it.AsOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
}
|
||||
|
||||
/// Retrieve the user's current journal
|
||||
let journalByUserId userId db = backgroundTask {
|
||||
let! reqs = getRequestsForUser userId db
|
||||
/// Retrieve a user's current prayer journal (includes snoozed and non-immediate recurrence)
|
||||
let forUser (userId : UserId) = backgroundTask {
|
||||
let! reqs =
|
||||
Custom.list
|
||||
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
|
||||
[ "@criteria", Query.jsonbDocParam {| UserId = userId |}
|
||||
"@stat", Sql.string """$.history[0].status ? (@ <> "Answered")"""
|
||||
] fromData<Request>
|
||||
return
|
||||
reqs
|
||||
|> Seq.ofList
|
||||
|> Seq.map JournalRequest.ofRequestLite
|
||||
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|
||||
|> Seq.sortBy (fun it -> it.AsOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
}
|
||||
|
||||
/// Does the user have any snoozed requests?
|
||||
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
|
||||
let! jrnl = journalByUserId userId db
|
||||
/// Does the user's journal have any snoozed requests?
|
||||
let hasSnoozed userId now = backgroundTask {
|
||||
let! jrnl = forUser userId
|
||||
return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
||||
}
|
||||
}
|
||||
|
||||
/// Retrieve a request by its ID and user ID (without notes and history)
|
||||
let tryRequestById reqId userId db = backgroundTask {
|
||||
let! req = tryFullRequestById reqId userId db
|
||||
return req |> Option.map (fun r -> { r with History = [||]; Notes = [||] })
|
||||
}
|
||||
|
||||
/// Retrieve notes for a request by its ID and user ID
|
||||
let notesById reqId userId (db : LiteDatabase) = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||]
|
||||
}
|
||||
|
||||
/// Retrieve a journal request by its ID and user ID
|
||||
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
|
||||
let! req = tryFullRequestById reqId userId db
|
||||
let tryById reqId userId = backgroundTask {
|
||||
let! req = Request.tryById reqId userId
|
||||
return req |> Option.map JournalRequest.ofRequestLite
|
||||
}
|
||||
}
|
||||
|
||||
/// Update the recurrence for a request
|
||||
let updateRecurrence reqId userId recurType db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with Recurrence = recurType }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Update a snoozed request
|
||||
let updateSnoozed reqId userId until db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
/// Specific manipulation of note entries
|
||||
[<RequireQualifiedAccess>]
|
||||
module Note =
|
||||
|
||||
/// 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"
|
||||
}
|
||||
/// 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"
|
||||
}
|
||||
|
||||
/// Retrieve notes for a request by the request ID
|
||||
let byRequestId reqId userId = backgroundTask {
|
||||
match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return []
|
||||
}
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/// The data model for myPrayerJournal
|
||||
/// The data model for myPrayerJournal
|
||||
[<AutoOpen>]
|
||||
module MyPrayerJournal.Domain
|
||||
|
||||
|
@ -169,10 +169,10 @@ type Request =
|
|||
Recurrence : Recurrence
|
||||
|
||||
/// The history entries for this request
|
||||
History : History[]
|
||||
History : History list
|
||||
|
||||
/// The notes for this request
|
||||
Notes : Note[]
|
||||
Notes : Note list
|
||||
}
|
||||
|
||||
/// Functions to support requests
|
||||
|
@ -186,8 +186,8 @@ module Request =
|
|||
SnoozedUntil = None
|
||||
ShowAfter = None
|
||||
Recurrence = Immediate
|
||||
History = [||]
|
||||
Notes = [||]
|
||||
History = []
|
||||
Notes = []
|
||||
}
|
||||
|
||||
|
||||
|
@ -234,7 +234,8 @@ module JournalRequest =
|
|||
|
||||
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
|
||||
let ofRequestLite (req : Request) =
|
||||
let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead
|
||||
let history = Seq.ofList req.History
|
||||
let lastHistory = Seq.tryHead history
|
||||
// Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the
|
||||
// largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled,
|
||||
// we will use the last activity date. This will mean that:
|
||||
|
@ -247,19 +248,17 @@ module JournalRequest =
|
|||
let showAfter = defaultArg req.ShowAfter Instant.MinValue
|
||||
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
|
||||
let lastPrayed =
|
||||
req.History
|
||||
|> Array.sortByDescending (fun it -> it.AsOf)
|
||||
|> Array.filter History.isPrayed
|
||||
|> Array.tryHead
|
||||
history
|
||||
|> Seq.filter History.isPrayed
|
||||
|> Seq.tryHead
|
||||
|> Option.map (fun it -> it.AsOf)
|
||||
|> Option.defaultValue Instant.MinValue
|
||||
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
|
||||
{ RequestId = req.Id
|
||||
UserId = req.UserId
|
||||
Text = req.History
|
||||
|> Array.filter (fun it -> Option.isSome it.Text)
|
||||
|> Array.sortByDescending (fun it -> it.AsOf)
|
||||
|> Array.tryHead
|
||||
Text = history
|
||||
|> Seq.filter (fun it -> Option.isSome it.Text)
|
||||
|> Seq.tryHead
|
||||
|> Option.map (fun h -> Option.get h.Text)
|
||||
|> Option.defaultValue ""
|
||||
AsOf = if asOf > Instant.MinValue then asOf else lastActivity
|
||||
|
@ -275,6 +274,6 @@ module JournalRequest =
|
|||
/// Same as `ofRequestLite`, but with notes and history
|
||||
let ofRequestFull req =
|
||||
{ ofRequestLite req with
|
||||
History = List.ofArray req.History
|
||||
Notes = List.ofArray req.Notes
|
||||
History = req.History
|
||||
Notes = req.Notes
|
||||
}
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/// HTTP handlers for the myPrayerJournal API
|
||||
/// HTTP handlers for the myPrayerJournal API
|
||||
[<RequireQualifiedAccess>]
|
||||
module MyPrayerJournal.Handlers
|
||||
|
||||
|
@ -45,16 +45,12 @@ module Error =
|
|||
|
||||
|
||||
open System.Security.Claims
|
||||
open LiteDB
|
||||
open Microsoft.AspNetCore.Http
|
||||
open NodaTime
|
||||
|
||||
/// Extensions on the HTTP context
|
||||
type HttpContext with
|
||||
|
||||
/// The LiteDB database
|
||||
member this.Db = this.GetService<LiteDatabase> ()
|
||||
|
||||
/// The "sub" for the current user (None if no user is authenticated)
|
||||
member this.CurrentUser =
|
||||
this.User
|
||||
|
@ -83,6 +79,8 @@ type HttpContext with
|
|||
| None -> DateTimeZone.Utc
|
||||
|
||||
|
||||
open MyPrayerJournal.Data
|
||||
|
||||
/// Handler helpers
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
@ -127,7 +125,7 @@ module private Helpers =
|
|||
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
|
||||
let! hasSnoozed =
|
||||
match ctx.CurrentUser with
|
||||
| Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
|
||||
| Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now ())
|
||||
| None -> Task.FromResult false
|
||||
return
|
||||
{ IsAuthenticated = Option.isSome ctx.CurrentUser
|
||||
|
@ -238,7 +236,6 @@ module Models =
|
|||
}
|
||||
|
||||
|
||||
open MyPrayerJournal.Data.Extensions
|
||||
open NodaTime.Text
|
||||
|
||||
/// Handlers for less-than-full-page HTML requests
|
||||
|
@ -254,14 +251,14 @@ module Components =
|
|||
| Some snooze, _ when snooze < now -> true
|
||||
| _, Some hide when hide < now -> true
|
||||
| _, _ -> false
|
||||
let! journal = Data.journalByUserId ctx.UserId ctx.Db
|
||||
let! journal = Journal.forUser ctx.UserId
|
||||
let shown = journal |> List.filter shouldBeShown
|
||||
return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx
|
||||
}
|
||||
|
||||
// GET /components/request-item/[req-id]
|
||||
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
|
||||
match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with
|
||||
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
@ -272,8 +269,8 @@ module Components =
|
|||
|
||||
// GET /components/request/[req-id]/notes
|
||||
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
|
||||
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx
|
||||
let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
|
||||
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone notes) next ctx
|
||||
}
|
||||
|
||||
// GET /components/request/[req-id]/snooze
|
||||
|
@ -333,7 +330,7 @@ module Request =
|
|||
return! partial "Add Prayer Request"
|
||||
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
|
||||
| _ ->
|
||||
match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
|
||||
match! Journal.tryById (RequestId.ofString requestId) ctx.UserId with
|
||||
| Some req ->
|
||||
debug ctx "Found - sending view"
|
||||
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
|
||||
|
@ -344,46 +341,42 @@ module Request =
|
|||
|
||||
// PATCH /request/[req-id]/prayed
|
||||
let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let reqId = RequestId.ofString requestId
|
||||
match! Data.tryRequestById reqId userId db with
|
||||
match! Journal.tryById reqId userId with
|
||||
| Some req ->
|
||||
let now = ctx.Now ()
|
||||
do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db
|
||||
do! History.add reqId userId { AsOf = now; Status = Prayed; Text = None }
|
||||
let nextShow =
|
||||
match Recurrence.duration req.Recurrence with
|
||||
| 0L -> None
|
||||
| duration -> Some <| now.Plus (Duration.FromSeconds duration)
|
||||
do! Data.updateShowAfter reqId userId nextShow db
|
||||
do! db.SaveChanges ()
|
||||
do! Request.updateShowAfter reqId userId nextShow
|
||||
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// POST /request/[req-id]/note
|
||||
// POST /request/[req-id]/note
|
||||
let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let reqId = RequestId.ofString requestId
|
||||
match! Data.tryRequestById reqId userId db with
|
||||
| Some _ ->
|
||||
match! Request.existsById reqId userId with
|
||||
| true ->
|
||||
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
|
||||
do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
|
||||
do! db.SaveChanges ()
|
||||
do! Note.add reqId userId { AsOf = ctx.Now (); Notes = notes.notes }
|
||||
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// GET /requests/active
|
||||
let active : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
|
||||
let! reqs = Journal.forUser ctx.UserId
|
||||
return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx
|
||||
}
|
||||
|
||||
// GET /requests/snoozed
|
||||
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! reqs = Data.journalByUserId ctx.UserId ctx.Db
|
||||
let! reqs = Journal.forUser ctx.UserId
|
||||
let now = ctx.Now ()
|
||||
let snoozed = reqs
|
||||
|> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
||||
|
@ -392,62 +385,56 @@ module Request =
|
|||
|
||||
// GET /requests/answered
|
||||
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
|
||||
}
|
||||
|
||||
// GET /request/[req-id]/full
|
||||
let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with
|
||||
match! Request.tryById (RequestId.ofString requestId) ctx.UserId with
|
||||
| Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// PATCH /request/[req-id]/show
|
||||
let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let reqId = RequestId.ofString requestId
|
||||
match! Data.tryRequestById reqId userId db with
|
||||
| Some _ ->
|
||||
do! Data.updateShowAfter reqId userId None db
|
||||
do! db.SaveChanges ()
|
||||
match! Request.existsById reqId userId with
|
||||
| true ->
|
||||
do! Request.updateShowAfter reqId userId None
|
||||
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// PATCH /request/[req-id]/snooze
|
||||
let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let reqId = RequestId.ofString requestId
|
||||
match! Data.tryRequestById reqId userId db with
|
||||
| Some _ ->
|
||||
match! Request.existsById reqId userId with
|
||||
| true ->
|
||||
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
|
||||
let date =
|
||||
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
|
||||
.AtStartOfDayInZone(DateTimeZone.Utc)
|
||||
.ToInstant ()
|
||||
do! Data.updateSnoozed reqId userId (Some date) db
|
||||
do! db.SaveChanges ()
|
||||
do! Request.updateSnoozed reqId userId (Some date)
|
||||
return!
|
||||
(withSuccessMessage $"Request snoozed until {until.until}"
|
||||
>=> hideModal "snooze"
|
||||
>=> Components.journalItems) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
// PATCH /request/[req-id]/cancel-snooze
|
||||
let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let reqId = RequestId.ofString requestId
|
||||
match! Data.tryRequestById reqId userId db with
|
||||
| Some _ ->
|
||||
do! Data.updateSnoozed reqId userId None db
|
||||
do! db.SaveChanges ()
|
||||
match! Request.existsById reqId userId with
|
||||
| true ->
|
||||
do! Request.updateSnoozed reqId userId None
|
||||
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| false -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// Derive a recurrence from its representation in the form
|
||||
|
@ -458,7 +445,6 @@ module Request =
|
|||
// POST /request
|
||||
let add : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! form = ctx.BindModelAsync<Models.Request> ()
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
let now = ctx.Now ()
|
||||
let req =
|
||||
|
@ -468,15 +454,14 @@ module Request =
|
|||
EnteredOn = now
|
||||
ShowAfter = None
|
||||
Recurrence = parseRecurrence form
|
||||
History = [|
|
||||
History = [
|
||||
{ AsOf = now
|
||||
Status = Created
|
||||
Text = Some form.requestText
|
||||
}
|
||||
|]
|
||||
]
|
||||
}
|
||||
Data.addRequest req db
|
||||
do! db.SaveChanges ()
|
||||
do! Request.add req
|
||||
Messages.pushSuccess ctx "Added prayer request" "/journal"
|
||||
return! seeOther "/journal" next ctx
|
||||
}
|
||||
|
@ -484,25 +469,24 @@ module Request =
|
|||
// PATCH /request
|
||||
let update : HttpHandler = requireUser >=> fun next ctx -> task {
|
||||
let! form = ctx.BindModelAsync<Models.Request> ()
|
||||
let db = ctx.Db
|
||||
let userId = ctx.UserId
|
||||
match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with
|
||||
// TODO: update the instance and save rather than all these little updates
|
||||
match! Journal.tryById (RequestId.ofString form.requestId) userId with
|
||||
| Some req ->
|
||||
// update recurrence if changed
|
||||
let recur = parseRecurrence form
|
||||
match recur = req.Recurrence with
|
||||
| true -> ()
|
||||
| false ->
|
||||
do! Data.updateRecurrence req.RequestId userId recur db
|
||||
do! Request.updateRecurrence req.RequestId userId recur
|
||||
match recur with
|
||||
| Immediate -> do! Data.updateShowAfter req.RequestId userId None db
|
||||
| Immediate -> do! Request.updateShowAfter req.RequestId userId None
|
||||
| _ -> ()
|
||||
// append history
|
||||
let upd8Text = form.requestText.Trim ()
|
||||
let text = if upd8Text = req.Text then None else Some upd8Text
|
||||
do! Data.addHistory req.RequestId userId
|
||||
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
|
||||
do! db.SaveChanges ()
|
||||
do! History.add req.RequestId userId
|
||||
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text }
|
||||
let nextUrl =
|
||||
match form.returnTo with
|
||||
| "active" -> "/requests/active"
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net7.0</TargetFramework>
|
||||
<Version>3.2</Version>
|
||||
<Version>3.3</Version>
|
||||
<DebugType>embedded</DebugType>
|
||||
<GenerateDocumentationFile>false</GenerateDocumentationFile>
|
||||
<NoWarn>3391</NoWarn>
|
||||
<PublishSingleFile>false</PublishSingleFile>
|
||||
<SelfContained>false</SelfContained>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Compile Include="Domain.fs" />
|
||||
|
@ -19,15 +20,16 @@
|
|||
<Compile Include="Program.fs" />
|
||||
</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="Giraffe" Version="6.0.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="1.9.2" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.2" />
|
||||
<PackageReference Include="LiteDB" Version="5.0.16" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.5" />
|
||||
<PackageReference Include="NodaTime" Version="3.1.2" />
|
||||
<PackageReference Update="FSharp.Core" Version="7.0.300" />
|
||||
<PackageReference Include="Giraffe" Version="6.2.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="1.9.6" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.11" />
|
||||
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
|
||||
<PackageReference Include="Npgsql.NodaTime" Version="7.0.6" />
|
||||
<PackageReference Update="FSharp.Core" Version="7.0.400" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Folder Include="wwwroot\" />
|
||||
|
|
|
@ -1,99 +1,62 @@
|
|||
module MyPrayerJournal.Api
|
||||
|
||||
open Microsoft.AspNetCore.Builder
|
||||
open Microsoft.AspNetCore.Hosting
|
||||
open System.IO
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
/// Configuration functions for the application
|
||||
module Configure =
|
||||
|
||||
/// Configure the content root
|
||||
let contentRoot root =
|
||||
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
|
||||
|
||||
|
||||
open Microsoft.Extensions.Configuration
|
||||
|
||||
/// Configure the application configuration
|
||||
let appConfiguration (bldr : WebApplicationBuilder) =
|
||||
bldr.Configuration
|
||||
.SetBasePath(bldr.Environment.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
|
||||
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
|
||||
.AddEnvironmentVariables ()
|
||||
|> ignore
|
||||
bldr
|
||||
|
||||
|
||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
||||
|
||||
/// Configure Kestrel from appsettings.json
|
||||
let kestrel (bldr : WebApplicationBuilder) =
|
||||
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
||||
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
||||
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
|
||||
bldr
|
||||
|
||||
|
||||
/// Configure the web root directory
|
||||
let webRoot pathSegments (bldr : WebApplicationBuilder) =
|
||||
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|
||||
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
|
||||
bldr
|
||||
|
||||
|
||||
open Microsoft.Extensions.Logging
|
||||
open Microsoft.Extensions.Hosting
|
||||
|
||||
/// Configure logging
|
||||
let logging (bldr : WebApplicationBuilder) =
|
||||
if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
|
||||
bldr.Logging.AddConsole().AddDebug() |> ignore
|
||||
bldr
|
||||
|
||||
|
||||
open Giraffe
|
||||
open LiteDB
|
||||
open Microsoft.AspNetCore.Authentication.Cookies
|
||||
open Microsoft.AspNetCore.Authentication.OpenIdConnect
|
||||
open Microsoft.AspNetCore.Http
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open Microsoft.IdentityModel.Protocols.OpenIdConnect
|
||||
open NodaTime
|
||||
open System
|
||||
open System.Text.Json
|
||||
open System.Text.Json.Serialization
|
||||
open System.Threading.Tasks
|
||||
|
||||
/// Configure dependency injection
|
||||
let services (bldr : WebApplicationBuilder) =
|
||||
let sameSite (opts : CookieOptions) =
|
||||
let sameSite (opts : CookieOptions) =
|
||||
match opts.SameSite, opts.Secure with
|
||||
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
|
||||
| _, _ -> ()
|
||||
|
||||
let _ = bldr.Services.AddRouting ()
|
||||
let _ = bldr.Services.AddGiraffe ()
|
||||
let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
|
||||
let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
|
||||
open Giraffe
|
||||
open Giraffe.EndpointRouting
|
||||
open Microsoft.AspNetCore.Authentication.Cookies
|
||||
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 _ =
|
||||
bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
|
||||
svc.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
|
||||
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
|
||||
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
|
||||
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
|
||||
let _ =
|
||||
bldr.Services.AddAuthentication(fun opts ->
|
||||
svc.AddAuthentication(fun opts ->
|
||||
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
||||
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
|
||||
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
|
||||
.AddCookie()
|
||||
.AddOpenIdConnect("Auth0", fun opts ->
|
||||
// Configure OIDC with Auth0 options from configuration
|
||||
let cfg = bldr.Configuration.GetSection "Auth0"
|
||||
opts.Authority <- $"""https://{cfg["Domain"]}/"""
|
||||
opts.ClientId <- cfg["Id"]
|
||||
opts.ClientSecret <- cfg["Secret"]
|
||||
let auth0 = cfg.GetSection "Auth0"
|
||||
opts.Authority <- $"""https://{auth0["Domain"]}/"""
|
||||
opts.ClientId <- auth0["Id"]
|
||||
opts.ClientSecret <- auth0["Secret"]
|
||||
opts.ResponseType <- OpenIdConnectResponseType.Code
|
||||
|
||||
opts.Scope.Clear ()
|
||||
|
@ -118,52 +81,31 @@ module Configure =
|
|||
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
|
||||
| false -> redirUri
|
||||
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
|
||||
ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
|
||||
ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}"""
|
||||
ctx.HandleResponse ()
|
||||
Task.CompletedTask
|
||||
opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
|
||||
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
|
||||
bldr.Scheme <- cfg["Scheme"]
|
||||
bldr.Port <- int cfg["Port"]
|
||||
ctx.ProtocolMessage.RedirectUri <- string bldr
|
||||
let uri = UriBuilder ctx.ProtocolMessage.RedirectUri
|
||||
uri.Scheme <- auth0["Scheme"]
|
||||
uri.Port <- int auth0["Port"]
|
||||
ctx.ProtocolMessage.RedirectUri <- string uri
|
||||
Task.CompletedTask)
|
||||
|
||||
let jsonOptions = JsonSerializerOptions ()
|
||||
jsonOptions.Converters.Add (JsonFSharpConverter ())
|
||||
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
|
||||
Data.Startup.ensureDb db
|
||||
let _ = bldr.Services.AddSingleton jsonOptions
|
||||
let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
|
||||
let _ = bldr.Services.AddSingleton<LiteDatabase> db
|
||||
let _ = svc.AddSingleton<JsonSerializerOptions> Json.options
|
||||
let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
|
||||
let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
|
||||
|
||||
bldr.Build ()
|
||||
if builder.Environment.IsDevelopment () then builder.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
|
||||
let _ = builder.Logging.AddConsole().AddDebug() |> ignore
|
||||
|
||||
|
||||
open Giraffe.EndpointRouting
|
||||
|
||||
/// Configure the web application
|
||||
let application (app : WebApplication) =
|
||||
use app = builder.Build ()
|
||||
let _ = app.UseStaticFiles ()
|
||||
let _ = app.UseCookiePolicy ()
|
||||
let _ = app.UseRouting ()
|
||||
let _ = app.UseAuthentication ()
|
||||
let _ = app.UseGiraffeErrorHandler Handlers.Error.error
|
||||
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|
||||
app
|
||||
|
||||
/// Compose all the configurations into one
|
||||
let webHost pathSegments =
|
||||
contentRoot
|
||||
>> appConfiguration
|
||||
>> kestrel
|
||||
>> webRoot pathSegments
|
||||
>> logging
|
||||
>> services
|
||||
>> application
|
||||
app.Run ()
|
||||
|
||||
|
||||
[<EntryPoint>]
|
||||
let main _ =
|
||||
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
|
||||
host.Run ()
|
||||
0
|
||||
|
|
|
@ -77,9 +77,9 @@ let htmlHead ctx =
|
|||
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
|
||||
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
|
||||
titleTag ctx
|
||||
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
|
||||
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/css/bootstrap.min.css"
|
||||
_rel "stylesheet"
|
||||
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
|
||||
_integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN"
|
||||
_crossorigin "anonymous" ]
|
||||
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
|
||||
link [ _href "/style/style.css"; _rel "stylesheet" ]
|
||||
|
@ -118,8 +118,8 @@ let htmlFoot =
|
|||
rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
|
||||
]
|
||||
script [ _async
|
||||
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
|
||||
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
|
||||
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js"
|
||||
_integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL"
|
||||
_crossorigin "anonymous" ] []
|
||||
script [] [
|
||||
rawText "setTimeout(function () { "
|
||||
|
|
|
@ -77,28 +77,31 @@ let full (clock : IClock) tz (req : Request) =
|
|||
let now = clock.GetCurrentInstant ()
|
||||
let answered =
|
||||
req.History
|
||||
|> Array.filter History.isAnswered
|
||||
|> Array.tryHead
|
||||
|> Seq.ofList
|
||||
|> Seq.filter History.isAnswered
|
||||
|> Seq.tryHead
|
||||
|> 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 asOf = defaultArg answered now
|
||||
((asOf - (req.History |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0"
|
||||
((asOf - (req.History |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0"
|
||||
let lastText =
|
||||
req.History
|
||||
|> Array.filter (fun h -> Option.isSome h.Text)
|
||||
|> Array.sortByDescending (fun h -> h.AsOf)
|
||||
|> Array.map (fun h -> Option.get h.Text)
|
||||
|> Array.head
|
||||
|> Seq.ofList
|
||||
|> Seq.filter (fun h -> Option.isSome h.Text)
|
||||
|> Seq.sortByDescending (fun h -> h.AsOf)
|
||||
|> Seq.map (fun h -> Option.get h.Text)
|
||||
|> Seq.head
|
||||
// The history log including notes (and excluding the final entry for answered requests)
|
||||
let log =
|
||||
let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
|
||||
let all =
|
||||
req.Notes
|
||||
|> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|
||||
|> Array.append (req.History |> Array.map toDisp)
|
||||
|> Array.sortByDescending (fun it -> it.asOf)
|
||||
|> List.ofArray
|
||||
|> Seq.ofList
|
||||
|> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|
||||
|> Seq.append (req.History |> List.map toDisp)
|
||||
|> Seq.sortByDescending (fun it -> it.asOf)
|
||||
|> List.ofSeq
|
||||
// Skip the first entry for answered requests; that info is already displayed
|
||||
match answered with Some _ -> all.Tail | None -> all
|
||||
article [ _class "container mt-3" ] [
|
||||
|
|
|
@ -1,12 +1,2 @@
|
|||
{
|
||||
"ConnectionStrings": {
|
||||
"db": "Filename=./mpj.db"
|
||||
},
|
||||
"Kestrel": {
|
||||
"EndPoints": {
|
||||
"Http": {
|
||||
"Url": "http://localhost:3000"
|
||||
}
|
||||
}
|
||||
}
|
||||
{
|
||||
}
|
||||
|
|
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Reference in New Issue
Block a user