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
|
||||
|
||||
/// Add a request
|
||||
let add req = backgroundTask {
|
||||
do! insert Table.Request (RequestId.toString req.Id) req
|
||||
}
|
||||
|
||||
/// Does a request exist for the given request ID and user ID?
|
||||
let existsById (reqId : RequestId) (userId : UserId) =
|
||||
Exists.byContains Table.Request {| Id = reqId; UserId = userId |}
|
||||
|
||||
/// A NodaTime instant pattern to use for parsing instants from the database
|
||||
let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
|
||||
/// Retrieve a request by its ID and user ID
|
||||
let tryById reqId userId = backgroundTask {
|
||||
match! Find.byId<Request> Table.Request (RequestId.toString reqId) with
|
||||
| Some req when req.UserId = userId -> return Some req
|
||||
| _ -> return None
|
||||
}
|
||||
|
||||
/// Mapping for NodaTime's Instant type
|
||||
module Instant =
|
||||
let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
|
||||
let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
|
||||
|
||||
/// Mapping for option types
|
||||
module Option =
|
||||
let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
|
||||
let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
|
||||
|
||||
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
|
||||
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
|
||||
|
||||
/// Mapping for Recurrence
|
||||
module Recurrence =
|
||||
let fromBson (value : BsonValue) = Recurrence.ofString value
|
||||
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
|
||||
|
||||
/// Mapping for RequestAction
|
||||
module RequestAction =
|
||||
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
|
||||
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
|
||||
|
||||
/// Mapping for RequestId
|
||||
module RequestId =
|
||||
let fromBson (value : BsonValue) = RequestId.ofString value.AsString
|
||||
let toBson (value : RequestId) : BsonValue = RequestId.toString value
|
||||
|
||||
/// Mapping for UserId
|
||||
module UserId =
|
||||
let fromBson (value : BsonValue) = UserId value.AsString
|
||||
let toBson (value : UserId) : BsonValue = UserId.toString value
|
||||
|
||||
/// Set up the mapping
|
||||
let register () =
|
||||
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
|
||||
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
|
||||
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
|
||||
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
|
||||
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
|
||||
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
|
||||
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
|
||||
/// Update recurrence for a request
|
||||
let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask {
|
||||
let dbId = RequestId.toString reqId
|
||||
match! existsById reqId userId with
|
||||
| true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |}
|
||||
| false -> invalidOp "Request ID {dbId} not found"
|
||||
}
|
||||
|
||||
/// Code to be run at startup
|
||||
module Startup =
|
||||
|
||||
/// Ensure the database is set up
|
||||
let ensureDb (db : LiteDatabase) =
|
||||
db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
|
||||
Mapping.register ()
|
||||
/// Update the show-after time for a request
|
||||
let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
|
||||
let dbId = RequestId.toString reqId
|
||||
match! existsById reqId userId with
|
||||
| true -> do! 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"
|
||||
}
|
||||
|
||||
|
||||
/// Async wrappers for LiteDB, and request -> journal mappings
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
||||
open System.Linq
|
||||
/// Specific manipulation of history entries
|
||||
[<RequireQualifiedAccess>]
|
||||
module History =
|
||||
|
||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
||||
let toListAsync<'T> (q : 'T seq) =
|
||||
(q.ToList >> Task.FromResult) ()
|
||||
|
||||
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
|
||||
let firstAsync<'T> (q : 'T seq) =
|
||||
q.FirstOrDefault () |> Task.FromResult
|
||||
|
||||
/// Async wrapper around a request update
|
||||
let doUpdate (db : LiteDatabase) (req : Request) =
|
||||
db.Requests.Update req |> ignore
|
||||
Task.CompletedTask
|
||||
/// Add a history entry
|
||||
let add reqId userId hist = backgroundTask {
|
||||
let dbId = RequestId.toString reqId
|
||||
match! Request.tryById reqId userId with
|
||||
| Some req ->
|
||||
do! 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"
|
||||
}
|
||||
/// 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.ofList
|
||||
|> Seq.map JournalRequest.ofRequestLite
|
||||
|> Seq.filter (fun it -> it.LastStatus = Answered)
|
||||
|> Seq.sortByDescending (fun it -> it.AsOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
|
||||
/// Add a note
|
||||
let addNote reqId userId note db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
/// Retrieve a user's current prayer journal (includes snoozed and non-immediate recurrence)
|
||||
let forUser (userId : UserId) = backgroundTask {
|
||||
let! reqs =
|
||||
Custom.list
|
||||
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
|
||||
[ "@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
|
||||
}
|
||||
|
||||
/// Add a request
|
||||
let addRequest (req : Request) (db : LiteDatabase) =
|
||||
db.Requests.Insert req |> ignore
|
||||
/// Does the user's journal have any snoozed requests?
|
||||
let hasSnoozed userId now = backgroundTask {
|
||||
let! jrnl = forUser userId
|
||||
return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
||||
}
|
||||
|
||||
/// Find all requests for the given user
|
||||
let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask {
|
||||
return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync
|
||||
}
|
||||
let tryById reqId userId = backgroundTask {
|
||||
let! req = Request.tryById reqId userId
|
||||
return req |> Option.map JournalRequest.ofRequestLite
|
||||
}
|
||||
|
||||
/// Retrieve all answered requests for the given user
|
||||
let answeredRequests userId db = backgroundTask {
|
||||
let! reqs = getRequestsForUser userId db
|
||||
return
|
||||
reqs
|
||||
|> Seq.map JournalRequest.ofRequestFull
|
||||
|> Seq.filter (fun it -> it.LastStatus = Answered)
|
||||
|> Seq.sortByDescending (fun it -> it.AsOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
|
||||
/// Retrieve the user's current journal
|
||||
let journalByUserId userId db = backgroundTask {
|
||||
let! reqs = getRequestsForUser userId db
|
||||
return
|
||||
reqs
|
||||
|> Seq.map JournalRequest.ofRequestLite
|
||||
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|
||||
|> Seq.sortBy (fun it -> it.AsOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
/// Specific manipulation of note entries
|
||||
[<RequireQualifiedAccess>]
|
||||
module Note =
|
||||
|
||||
/// Does the user have any snoozed requests?
|
||||
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
|
||||
let! jrnl = journalByUserId userId db
|
||||
return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
|
||||
}
|
||||
/// Add a note
|
||||
let add reqId userId note = backgroundTask {
|
||||
let dbId = RequestId.toString reqId
|
||||
match! Request.tryById reqId userId with
|
||||
| Some req ->
|
||||
do! Update.partialById Table.Request dbId
|
||||
{| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |}
|
||||
| None -> invalidOp $"Request ID {dbId} not found"
|
||||
}
|
||||
|
||||
/// Retrieve a request by its ID and user ID (without notes and history)
|
||||
let tryRequestById reqId userId db = backgroundTask {
|
||||
let! req = tryFullRequestById reqId userId db
|
||||
return req |> Option.map (fun r -> { r with History = [||]; Notes = [||] })
|
||||
}
|
||||
|
||||
/// Retrieve notes for a request by its ID and user ID
|
||||
let notesById reqId userId (db : LiteDatabase) = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||]
|
||||
}
|
||||
|
||||
/// Retrieve a journal request by its ID and user ID
|
||||
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
|
||||
let! req = tryFullRequestById reqId userId db
|
||||
return req |> Option.map JournalRequest.ofRequestLite
|
||||
}
|
||||
|
||||
/// Update the recurrence for a request
|
||||
let updateRecurrence reqId userId recurType db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with Recurrence = recurType }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Update a snoozed request
|
||||
let updateSnoozed reqId userId until db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Update the "show after" timestamp for a request
|
||||
let updateShowAfter reqId userId showAfter db = backgroundTask {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with ShowAfter = showAfter }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
/// Retrieve notes for a request by the request ID
|
||||
let byRequestId reqId userId = backgroundTask {
|
||||
match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return []
|
||||
}
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/// The data model for myPrayerJournal
|
||||
/// The data model for myPrayerJournal
|
||||
[<AutoOpen>]
|
||||
module MyPrayerJournal.Domain
|
||||
|
||||
|
@ -169,10 +169,10 @@ type Request =
|
|||
Recurrence : Recurrence
|
||||
|
||||
/// The history entries for this request
|
||||
History : History[]
|
||||
History : History list
|
||||
|
||||
/// The notes for this request
|
||||
Notes : Note[]
|
||||
Notes : Note list
|
||||
}
|
||||
|
||||
/// Functions to support requests
|
||||
|
@ -186,8 +186,8 @@ module Request =
|
|||
SnoozedUntil = None
|
||||
ShowAfter = None
|
||||
Recurrence = Immediate
|
||||
History = [||]
|
||||
Notes = [||]
|
||||
History = []
|
||||
Notes = []
|
||||
}
|
||||
|
||||
|
||||
|
@ -234,7 +234,8 @@ module JournalRequest =
|
|||
|
||||
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
|
||||
let ofRequestLite (req : Request) =
|
||||
let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead
|
||||
let history = Seq.ofList req.History
|
||||
let lastHistory = Seq.tryHead history
|
||||
// Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the
|
||||
// largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled,
|
||||
// we will use the last activity date. This will mean that:
|
||||
|
@ -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
|
||||
|
@ -155,17 +153,17 @@ module private Helpers =
|
|||
|
||||
/// Push a new message into the list
|
||||
let push (ctx : HttpContext) message url = lock upd8 (fun () ->
|
||||
messages <- messages.Add (ctx.UserId, (message, url)))
|
||||
messages <- messages.Add (ctx.UserId, (message, url)))
|
||||
|
||||
/// Add a success message header to the response
|
||||
let pushSuccess ctx message url =
|
||||
push ctx $"success|||%s{message}" url
|
||||
push ctx $"success|||%s{message}" url
|
||||
|
||||
/// Pop the messages for the given user
|
||||
let pop userId = lock upd8 (fun () ->
|
||||
let msg = messages.TryFind userId
|
||||
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
|
||||
msg)
|
||||
let msg = messages.TryFind userId
|
||||
msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
|
||||
msg)
|
||||
|
||||
/// Send a partial result if this is not a full page load (does not append no-cache headers)
|
||||
let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task {
|
||||
|
@ -238,7 +236,6 @@ module Models =
|
|||
}
|
||||
|
||||
|
||||
open MyPrayerJournal.Data.Extensions
|
||||
open NodaTime.Text
|
||||
|
||||
/// Handlers for less-than-full-page HTML requests
|
||||
|
@ -254,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,169 +1,111 @@
|
|||
module MyPrayerJournal.Api
|
||||
|
||||
open Microsoft.AspNetCore.Http
|
||||
|
||||
let sameSite (opts : CookieOptions) =
|
||||
match opts.SameSite, opts.Secure with
|
||||
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
|
||||
| _, _ -> ()
|
||||
|
||||
open Giraffe
|
||||
open Giraffe.EndpointRouting
|
||||
open Microsoft.AspNetCore.Authentication.Cookies
|
||||
open Microsoft.AspNetCore.Authentication.OpenIdConnect
|
||||
open Microsoft.AspNetCore.Builder
|
||||
open Microsoft.AspNetCore.Hosting
|
||||
open System.IO
|
||||
|
||||
/// Configuration functions for the application
|
||||
module Configure =
|
||||
|
||||
/// Configure the content root
|
||||
let contentRoot root =
|
||||
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
|
||||
|
||||
|
||||
open Microsoft.Extensions.Configuration
|
||||
|
||||
/// Configure the application configuration
|
||||
let appConfiguration (bldr : WebApplicationBuilder) =
|
||||
bldr.Configuration
|
||||
.SetBasePath(bldr.Environment.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
|
||||
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
|
||||
.AddEnvironmentVariables ()
|
||||
|> ignore
|
||||
bldr
|
||||
|
||||
|
||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
||||
|
||||
/// Configure Kestrel from appsettings.json
|
||||
let kestrel (bldr : WebApplicationBuilder) =
|
||||
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
||||
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
||||
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
|
||||
bldr
|
||||
|
||||
|
||||
/// Configure the web root directory
|
||||
let webRoot pathSegments (bldr : WebApplicationBuilder) =
|
||||
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|
||||
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
|
||||
bldr
|
||||
|
||||
|
||||
open Microsoft.Extensions.Logging
|
||||
open Microsoft.Extensions.Hosting
|
||||
|
||||