Convert data to LiteDB-backed store
This commit is contained in:
parent
33effdd17e
commit
bbe7294ba6
@ -1,37 +0,0 @@
|
||||
|
||||
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||
# Visual Studio Version 16
|
||||
VisualStudioVersion = 16.0.28721.148
|
||||
MinimumVisualStudioVersion = 10.0.40219.1
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyPrayerJournal.Api", "MyPrayerJournal.Api\MyPrayerJournal.Api.fsproj", "{1887D1E1-544A-4F54-B266-38E7867DC842}"
|
||||
EndProject
|
||||
Global
|
||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||
Debug|Any CPU = Debug|Any CPU
|
||||
Debug|iPhone = Debug|iPhone
|
||||
Debug|iPhoneSimulator = Debug|iPhoneSimulator
|
||||
Release|Any CPU = Release|Any CPU
|
||||
Release|iPhone = Release|iPhone
|
||||
Release|iPhoneSimulator = Release|iPhoneSimulator
|
||||
EndGlobalSection
|
||||
GlobalSection(ProjectConfigurationPlatforms) = postSolution
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhone.ActiveCfg = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhone.Build.0 = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhone.ActiveCfg = Release|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhone.Build.0 = Release|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
|
||||
{1887D1E1-544A-4F54-B266-38E7867DC842}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
EndGlobalSection
|
||||
GlobalSection(SolutionProperties) = preSolution
|
||||
HideSolutionNode = FALSE
|
||||
EndGlobalSection
|
||||
GlobalSection(ExtensibilityGlobals) = postSolution
|
||||
SolutionGuid = {8E2447D9-52F0-4A0D-BB61-A83C19353D7C}
|
||||
EndGlobalSection
|
||||
EndGlobal
|
||||
@ -1,186 +1,227 @@
|
||||
namespace MyPrayerJournal
|
||||
module MyPrayerJournal.Data
|
||||
|
||||
open LiteDB
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open System.Threading.Tasks
|
||||
|
||||
/// JSON converters for various DUs
|
||||
module Converters =
|
||||
// fsharplint:disable MemberNames
|
||||
|
||||
/// LiteDB extensions
|
||||
[<AutoOpen>]
|
||||
module Extensions =
|
||||
|
||||
open Microsoft.FSharpLu.Json
|
||||
open Newtonsoft.Json
|
||||
/// Extensions on the LiteDatabase class
|
||||
type LiteDatabase with
|
||||
/// The Request collection
|
||||
member this.requests
|
||||
with get () = this.GetCollection<Request>("request")
|
||||
/// Async version of the checkpoint command (flushes log)
|
||||
member this.saveChanges () =
|
||||
this.Checkpoint()
|
||||
Task.CompletedTask
|
||||
|
||||
/// JSON converter for request IDs
|
||||
type RequestIdJsonConverter () =
|
||||
inherit JsonConverter<RequestId> ()
|
||||
override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) =
|
||||
(RequestId.toString >> writer.WriteValue) value
|
||||
override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> RequestId.fromIdString) reader.Value
|
||||
|
||||
/// JSON converter for user IDs
|
||||
type UserIdJsonConverter () =
|
||||
inherit JsonConverter<UserId> ()
|
||||
override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) =
|
||||
(UserId.toString >> writer.WriteValue) value
|
||||
override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> UserId) reader.Value
|
||||
/// 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 =
|
||||
|
||||
/// Map a history entry to BSON
|
||||
let historyToBson (hist : History) : BsonValue =
|
||||
let doc = BsonDocument ()
|
||||
doc.["asOf"] <- BsonValue (Ticks.toLong hist.asOf)
|
||||
doc.["status"] <- BsonValue (RequestAction.toString hist.status)
|
||||
doc.["text"] <- BsonValue (Option.toObj hist.text)
|
||||
upcast doc
|
||||
|
||||
/// JSON converter for Ticks
|
||||
type TicksJsonConverter () =
|
||||
inherit JsonConverter<Ticks> ()
|
||||
override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) =
|
||||
(Ticks.toLong >> writer.WriteValue) value
|
||||
override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
|
||||
(string >> int64 >> Ticks) reader.Value
|
||||
/// Map a BSON document to a history entry
|
||||
let historyFromBson (doc : BsonValue) =
|
||||
{ asOf = Ticks doc.["asOf"].AsInt64
|
||||
status = RequestAction.fromString doc.["status"].AsString
|
||||
text = match doc.["text"].IsNull with true -> None | false -> Some doc.["text"].AsString
|
||||
}
|
||||
|
||||
/// A sequence of all custom converters needed for myPrayerJournal
|
||||
let all : JsonConverter seq =
|
||||
seq {
|
||||
yield RequestIdJsonConverter ()
|
||||
yield UserIdJsonConverter ()
|
||||
yield TicksJsonConverter ()
|
||||
yield CompactUnionJsonConverter true
|
||||
/// Map a note entry to BSON
|
||||
let noteToBson (note : Note) : BsonValue =
|
||||
let doc = BsonDocument ()
|
||||
doc.["asOf"] <- BsonValue (Ticks.toLong note.asOf)
|
||||
doc.["notes"] <- BsonValue note.notes
|
||||
upcast doc
|
||||
|
||||
/// Map a BSON document to a note entry
|
||||
let noteFromBson (doc : BsonValue) =
|
||||
{ asOf = Ticks doc.["asOf"].AsInt64
|
||||
notes = doc.["notes"].AsString
|
||||
}
|
||||
|
||||
/// Map a request to its BSON representation
|
||||
let requestToBson req : BsonValue =
|
||||
let doc = BsonDocument ()
|
||||
doc.["_id"] <- BsonValue (RequestId.toString req.id)
|
||||
doc.["enteredOn"] <- BsonValue (Ticks.toLong req.enteredOn)
|
||||
doc.["userId"] <- BsonValue (UserId.toString req.userId)
|
||||
doc.["snoozedUntil"] <- BsonValue (Ticks.toLong req.snoozedUntil)
|
||||
doc.["showAfter"] <- BsonValue (Ticks.toLong req.showAfter)
|
||||
doc.["recurType"] <- BsonValue (Recurrence.toString req.recurType)
|
||||
doc.["recurCount"] <- BsonValue req.recurCount
|
||||
doc.["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
|
||||
doc.["notes"] <- BsonValue (req.notes |> List.map noteToBson |> Seq.ofList)
|
||||
upcast doc
|
||||
|
||||
/// Map a BSON document to a request
|
||||
let requestFromBson (doc : BsonValue) =
|
||||
{ id = RequestId.ofString doc.["_id"].AsString
|
||||
enteredOn = Ticks doc.["enteredOn"].AsInt64
|
||||
userId = UserId doc.["userId"].AsString
|
||||
snoozedUntil = Ticks doc.["snoozedUntil"].AsInt64
|
||||
showAfter = Ticks doc.["showAfter"].AsInt64
|
||||
recurType = Recurrence.fromString doc.["recurType"].AsString
|
||||
recurCount = int16 doc.["recurCount"].AsInt32
|
||||
history = doc.["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
|
||||
notes = doc.["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq
|
||||
}
|
||||
|
||||
/// Set up the mapping
|
||||
let register () =
|
||||
BsonMapper.Global.RegisterType<Request>(
|
||||
Func<Request, BsonValue> requestToBson, Func<BsonValue, Request> requestFromBson)
|
||||
|
||||
/// Code to be run at startup
|
||||
module Startup =
|
||||
|
||||
/// Ensure the database is set up
|
||||
let ensureDb (db : LiteDatabase) =
|
||||
db.requests.EnsureIndex (fun it -> it.userId) |> ignore
|
||||
Mapping.register ()
|
||||
|
||||
|
||||
/// Async wrappers for LiteDB, and request -> journal mappings
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
||||
/// Async wrapper around a LiteDB query that returns multiple results
|
||||
let doListQuery<'T> (q : ILiteQueryable<'T>) =
|
||||
q.ToList () |> Task.FromResult
|
||||
|
||||
/// Async wrapper around a LiteDB query that returns 0 or 1 results
|
||||
let doSingleQuery<'T> (q : ILiteQueryable<'T>) =
|
||||
q.FirstOrDefault () |> Task.FromResult
|
||||
|
||||
/// Async wrapper around a request update
|
||||
let doUpdate (db : LiteDatabase) (req : Request) =
|
||||
db.requests.Update req |> ignore
|
||||
Task.CompletedTask
|
||||
|
||||
/// Convert a request to the form used for the journal (precomputed values, no notes or history)
|
||||
let toJournalLite (req : Request) =
|
||||
let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.head
|
||||
{ requestId = req.id
|
||||
userId = req.userId
|
||||
text = (req.history
|
||||
|> List.filter (fun it -> Option.isSome it.text)
|
||||
|> List.sortByDescending (fun it -> Ticks.toLong it.asOf)
|
||||
|> List.head).text
|
||||
|> Option.get
|
||||
asOf = hist.asOf
|
||||
lastStatus = hist.status
|
||||
snoozedUntil = req.snoozedUntil
|
||||
showAfter = req.showAfter
|
||||
recurType = req.recurType
|
||||
recurCount = req.recurCount
|
||||
history = []
|
||||
notes = []
|
||||
}
|
||||
|
||||
/// Same as above, but with notes and history
|
||||
let toJournalFull req =
|
||||
{ toJournalLite req with
|
||||
history = req.history
|
||||
notes = req.notes
|
||||
}
|
||||
|
||||
|
||||
/// RavenDB index declarations
|
||||
module Indexes =
|
||||
/// Retrieve a request, including its history and notes, by its ID and user ID
|
||||
let tryFullRequestById reqId userId (db : LiteDatabase) = task {
|
||||
let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId))
|
||||
return match box req with null -> None | _ -> Some req
|
||||
}
|
||||
|
||||
/// Add a history entry
|
||||
let addHistory reqId userId hist db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with history = hist :: req.history }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Add a note
|
||||
let addNote reqId userId note db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with notes = note :: req.notes }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Add a request
|
||||
let addRequest (req : Request) (db : LiteDatabase) =
|
||||
db.requests.Insert req |> ignore
|
||||
|
||||
/// Retrieve all answered requests for the given user
|
||||
let answeredRequests userId (db : LiteDatabase) = task {
|
||||
let! reqs = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
|
||||
return
|
||||
reqs
|
||||
|> Seq.map toJournalFull
|
||||
|> Seq.filter (fun it -> it.lastStatus = Answered)
|
||||
|> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
|
||||
open Raven.Client.Documents.Indexes
|
||||
/// Retrieve the user's current journal
|
||||
let journalByUserId userId (db : LiteDatabase) = task {
|
||||
let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
|
||||
return
|
||||
jrnl
|
||||
|> Seq.map toJournalLite
|
||||
|> Seq.filter (fun it -> it.lastStatus <> Answered)
|
||||
|> Seq.sortBy (fun it -> Ticks.toLong it.asOf)
|
||||
|> List.ofSeq
|
||||
}
|
||||
|
||||
/// Index requests for a journal view
|
||||
// fsharplint:disable-next-line TypeNames
|
||||
type Requests_AsJournal () as this =
|
||||
inherit AbstractJavaScriptIndexCreationTask ()
|
||||
do
|
||||
this.Maps <- HashSet<string> [
|
||||
"""docs.Requests.Select(req => new {
|
||||
requestId = req.Id.Replace("Requests/", ""),
|
||||
userId = req.userId,
|
||||
text = req.history.Where(hist => hist.text != null).OrderByDescending(hist => hist.asOf).First().text,
|
||||
asOf = req.history.OrderByDescending(hist => hist.asOf).First().asOf,
|
||||
lastStatus = req.history.OrderByDescending(hist => hist.asOf).First().status,
|
||||
snoozedUntil = req.snoozedUntil,
|
||||
showAfter = req.showAfter,
|
||||
recurType = req.recurType,
|
||||
recurCount = req.recurCount
|
||||
})"""
|
||||
]
|
||||
this.Fields <-
|
||||
[ "requestId", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
|
||||
"text", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
|
||||
"asOf", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
|
||||
"lastStatus", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
|
||||
]
|
||||
|> dict
|
||||
|> Dictionary<string, IndexFieldOptions>
|
||||
/// Retrieve a request by its ID and user ID (without notes and history)
|
||||
let tryRequestById reqId userId db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some r -> return Some { r with history = []; notes = [] }
|
||||
| _ -> return None
|
||||
}
|
||||
|
||||
|
||||
/// All data manipulations within myPrayerJournal
|
||||
module Data =
|
||||
|
||||
open Indexes
|
||||
open Microsoft.FSharpLu
|
||||
open Raven.Client.Documents
|
||||
open Raven.Client.Documents.Linq
|
||||
open Raven.Client.Documents.Session
|
||||
|
||||
/// Add a history entry
|
||||
let addHistory reqId (hist : History) (sess : IAsyncDocumentSession) =
|
||||
sess.Advanced.Patch<Request, History> (
|
||||
RequestId.toString reqId,
|
||||
(fun r -> r.history :> IEnumerable<History>),
|
||||
fun (h : JavaScriptArray<History>) -> h.Add (hist) :> obj)
|
||||
|
||||
/// Add a note
|
||||
let addNote reqId (note : Note) (sess : IAsyncDocumentSession) =
|
||||
sess.Advanced.Patch<Request, Note> (
|
||||
RequestId.toString reqId,
|
||||
(fun r -> r.notes :> IEnumerable<Note>),
|
||||
fun (h : JavaScriptArray<Note>) -> h.Add (note) :> obj)
|
||||
|
||||
/// Add a request
|
||||
let addRequest req (sess : IAsyncDocumentSession) =
|
||||
sess.StoreAsync (req, req.Id)
|
||||
|
||||
/// Retrieve all answered requests for the given user
|
||||
let answeredRequests userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
let! reqs =
|
||||
sess.Query<JournalRequest, Requests_AsJournal>()
|
||||
.Where(fun r -> r.userId = userId && r.lastStatus = "Answered")
|
||||
.OrderByDescending(fun r -> r.asOf)
|
||||
.ProjectInto<JournalRequest>()
|
||||
.ToListAsync ()
|
||||
return List.ofSeq reqs
|
||||
}
|
||||
/// Retrieve notes for a request by its ID and user ID
|
||||
let notesById reqId userId (db : LiteDatabase) = task {
|
||||
match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return []
|
||||
}
|
||||
|
||||
/// Retrieve the user's current journal
|
||||
let journalByUserId userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
let! jrnl =
|
||||
sess.Query<JournalRequest, Requests_AsJournal>()
|
||||
.Where(fun r -> r.userId = userId && r.lastStatus <> "Answered")
|
||||
.OrderBy(fun r -> r.asOf)
|
||||
.ProjectInto<JournalRequest>()
|
||||
.ToListAsync()
|
||||
return
|
||||
jrnl
|
||||
|> Seq.map (fun r -> r.history <- []; r.notes <- []; r)
|
||||
|> List.ofSeq
|
||||
}
|
||||
/// Retrieve a journal request by its ID and user ID
|
||||
let tryJournalById reqId userId (db : LiteDatabase) = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> return req |> (toJournalLite >> Some)
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Update the recurrence for a request
|
||||
let updateRecurrence reqId userId recurType recurCount db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Save changes in the current document session
|
||||
let saveChanges (sess : IAsyncDocumentSession) =
|
||||
sess.SaveChangesAsync ()
|
||||
/// Update a snoozed request
|
||||
let updateSnoozed reqId userId until db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
/// Retrieve a request, including its history and notes, by its ID and user ID
|
||||
let tryFullRequestById reqId userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
let! req = RequestId.toString reqId |> sess.LoadAsync
|
||||
return match Option.fromObject req with Some r when r.userId = userId -> Some r | _ -> None
|
||||
}
|
||||
|
||||
|
||||
/// Retrieve a request by its ID and user ID (without notes and history)
|
||||
let tryRequestById reqId userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
match! tryFullRequestById reqId userId sess with
|
||||
| Some r -> return Some { r with history = []; notes = [] }
|
||||
| _ -> return None
|
||||
}
|
||||
|
||||
/// Retrieve notes for a request by its ID and user ID
|
||||
let notesById reqId userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
match! tryFullRequestById reqId userId sess with
|
||||
| Some req -> return req.notes
|
||||
| None -> return []
|
||||
}
|
||||
|
||||
/// Retrieve a journal request by its ID and user ID
|
||||
let tryJournalById reqId userId (sess : IAsyncDocumentSession) =
|
||||
task {
|
||||
let! req =
|
||||
sess.Query<Request, Requests_AsJournal>()
|
||||
.Where(fun x -> x.Id = (RequestId.toString reqId) && x.userId = userId)
|
||||
.ProjectInto<JournalRequest>()
|
||||
.FirstOrDefaultAsync ()
|
||||
return
|
||||
Option.fromObject req
|
||||
|> Option.map (fun r -> r.history <- []; r.notes <- []; r)
|
||||
}
|
||||
|
||||
/// Update the recurrence for a request
|
||||
let updateRecurrence reqId recurType recurCount (sess : IAsyncDocumentSession) =
|
||||
sess.Advanced.Patch<Request, Recurrence> (RequestId.toString reqId, (fun r -> r.recurType), recurType)
|
||||
sess.Advanced.Patch<Request, int16> (RequestId.toString reqId, (fun r -> r.recurCount), recurCount)
|
||||
|
||||
/// Update a snoozed request
|
||||
let updateSnoozed reqId until (sess : IAsyncDocumentSession) =
|
||||
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.snoozedUntil), until)
|
||||
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.showAfter), until)
|
||||
|
||||
/// Update the "show after" timestamp for a request
|
||||
let updateShowAfter reqId showAfter (sess : IAsyncDocumentSession) =
|
||||
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.showAfter), showAfter)
|
||||
/// Update the "show after" timestamp for a request
|
||||
let updateShowAfter reqId userId showAfter db = task {
|
||||
match! tryFullRequestById reqId userId db with
|
||||
| Some req -> do! doUpdate db { req with showAfter = showAfter }
|
||||
| None -> invalidOp $"{RequestId.toString reqId} not found"
|
||||
}
|
||||
|
||||
@ -6,19 +6,23 @@ module MyPrayerJournal.Domain
|
||||
|
||||
open Cuid
|
||||
|
||||
/// Request ID is a CUID
|
||||
/// An identifier for a request
|
||||
type RequestId =
|
||||
| RequestId of Cuid
|
||||
|
||||
/// Functions to manipulate request IDs
|
||||
module RequestId =
|
||||
/// The string representation of the request ID
|
||||
let toString = function RequestId x -> $"Requests/{Cuid.toString x}"
|
||||
let toString = function RequestId x -> Cuid.toString x
|
||||
/// Create a request ID from a string representation
|
||||
let fromIdString (x : string) = x.Replace ("Requests/", "") |> (Cuid >> RequestId)
|
||||
let ofString = Cuid >> RequestId
|
||||
|
||||
|
||||
/// User ID is a string (the "sub" part of the JWT)
|
||||
/// The identifier of a user (the "sub" part of the JWT)
|
||||
type UserId =
|
||||
| UserId of string
|
||||
|
||||
/// Functions to manipulate user IDs
|
||||
module UserId =
|
||||
/// The string representation of the user ID
|
||||
let toString = function UserId x -> x
|
||||
@ -27,6 +31,8 @@ module UserId =
|
||||
/// A long integer representing seconds since the epoch
|
||||
type Ticks =
|
||||
| Ticks of int64
|
||||
|
||||
/// Functions to manipulate Ticks
|
||||
module Ticks =
|
||||
/// The int64 (long) representation of ticks
|
||||
let toLong = function Ticks x -> x
|
||||
@ -38,22 +44,34 @@ type Recurrence =
|
||||
| Hours
|
||||
| Days
|
||||
| Weeks
|
||||
|
||||
/// Functions to manipulate recurrences
|
||||
module Recurrence =
|
||||
/// Create a string representation of a recurrence
|
||||
let toString =
|
||||
function
|
||||
| Immediate -> "Immediate"
|
||||
| Hours -> "Hours"
|
||||
| Days -> "Days"
|
||||
| Weeks -> "Weeks"
|
||||
/// Create a recurrence value from a string
|
||||
let fromString =
|
||||
function
|
||||
| "Immediate" -> Immediate
|
||||
| "Hours" -> Hours
|
||||
| "Days" -> Days
|
||||
| "Weeks" -> Weeks
|
||||
| it -> invalidOp $"{it} is not a valid recurrence"
|
||||
/// The duration of the recurrence
|
||||
let duration =
|
||||
function
|
||||
| Immediate -> 0L
|
||||
| Hours -> 3600000L
|
||||
| Days -> 86400000L
|
||||
| Weeks -> 604800000L
|
||||
| "Hours" -> Hours
|
||||
| "Days" -> Days
|
||||
| "Weeks" -> Weeks
|
||||
| it -> invalidOp $"{it} is not a valid recurrence"
|
||||
/// An hour's worth of seconds
|
||||
let private oneHour = 3_600L
|
||||
/// The duration of the recurrence (in milliseconds)
|
||||
let duration x =
|
||||
(match x with
|
||||
| Immediate -> 0L
|
||||
| Hours -> oneHour
|
||||
| Days -> oneHour * 24L
|
||||
| Weeks -> oneHour * 24L * 7L)
|
||||
|> ( * ) 1000L
|
||||
|
||||
|
||||
/// The action taken on a request as part of a history entry
|
||||
@ -62,76 +80,72 @@ type RequestAction =
|
||||
| Prayed
|
||||
| Updated
|
||||
| Answered
|
||||
|
||||
/// Functions to manipulate request actions
|
||||
module RequestAction =
|
||||
/// Create a string representation of an action
|
||||
let toString =
|
||||
function
|
||||
| Created -> "Created"
|
||||
| Prayed -> "Prayed"
|
||||
| Updated -> "Updated"
|
||||
| Answered -> "Answered"
|
||||
/// Create a RequestAction from a string
|
||||
let fromString =
|
||||
function
|
||||
| "Created" -> Created
|
||||
| "Prayed" -> Prayed
|
||||
| "Updated" -> Updated
|
||||
| "Created" -> Created
|
||||
| "Prayed" -> Prayed
|
||||
| "Updated" -> Updated
|
||||
| "Answered" -> Answered
|
||||
| it -> invalidOp $"Bad request action {it}"
|
||||
| it -> invalidOp $"Bad request action {it}"
|
||||
|
||||
|
||||
/// History is a record of action taken on a prayer request, including updates to its text
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type History =
|
||||
{ /// The time when this history entry was made
|
||||
asOf : Ticks
|
||||
/// The status for this history entry
|
||||
status : RequestAction
|
||||
/// The text of the update, if applicable
|
||||
text : string option
|
||||
}
|
||||
with
|
||||
/// An empty history entry
|
||||
static member empty =
|
||||
{ asOf = Ticks 0L
|
||||
status = Created
|
||||
text = None
|
||||
}
|
||||
type History = {
|
||||
/// The time when this history entry was made
|
||||
asOf : Ticks
|
||||
/// The status for this history entry
|
||||
status : RequestAction
|
||||
/// The text of the update, if applicable
|
||||
text : string option
|
||||
}
|
||||
|
||||
/// Note is a note regarding a prayer request that does not result in an update to its text
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type Note =
|
||||
{ /// The time when this note was made
|
||||
asOf : Ticks
|
||||
/// The text of the notes
|
||||
notes : string
|
||||
}
|
||||
with
|
||||
/// An empty note
|
||||
static member empty =
|
||||
{ asOf = Ticks 0L
|
||||
notes = ""
|
||||
}
|
||||
type Note = {
|
||||
/// The time when this note was made
|
||||
asOf : Ticks
|
||||
/// The text of the notes
|
||||
notes : string
|
||||
}
|
||||
|
||||
/// Request is the identifying record for a prayer request
|
||||
[<CLIMutable; NoComparison; NoEquality>]
|
||||
type Request =
|
||||
{ /// The ID of the request
|
||||
Id : string
|
||||
/// The time this request was initially entered
|
||||
enteredOn : Ticks
|
||||
/// 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 : Ticks
|
||||
/// The time at which this request should reappear in the user's journal by recurrence
|
||||
showAfter : Ticks
|
||||
/// The type of recurrence for this request
|
||||
recurType : Recurrence
|
||||
/// How many of the recurrence intervals should occur between appearances in the journal
|
||||
recurCount : int16
|
||||
/// The history entries for this request
|
||||
history : History list
|
||||
/// The notes for this request
|
||||
notes : Note list
|
||||
}
|
||||
type Request = {
|
||||
/// The ID of the request
|
||||
id : RequestId
|
||||
/// The time this request was initially entered
|
||||
enteredOn : Ticks
|
||||
/// 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 : Ticks
|
||||
/// The time at which this request should reappear in the user's journal by recurrence
|
||||
showAfter : Ticks
|
||||
/// The type of recurrence for this request
|
||||
recurType : Recurrence
|
||||
/// How many of the recurrence intervals should occur between appearances in the journal
|
||||
recurCount : int16
|
||||
/// The history entries for this request
|
||||
history : History list
|
||||
/// The notes for this request
|
||||
notes : Note list
|
||||
}
|
||||
with
|
||||
/// An empty request
|
||||
static member empty =
|
||||
{ Id = ""
|
||||
{ id = Cuid.generate () |> RequestId
|
||||
enteredOn = Ticks 0L
|
||||
userId = UserId ""
|
||||
snoozedUntil = Ticks 0L
|
||||
@ -144,28 +158,28 @@ with
|
||||
|
||||
/// JournalRequest is the form of a prayer request returned for the request journal display. It also contains
|
||||
/// properties that may be filled for history and notes.
|
||||
// RavenDB doesn't like the "@"-suffixed properties from record types in a ProjectInto clause
|
||||
[<NoComparison; NoEquality>]
|
||||
type JournalRequest () =
|
||||
/// The ID of the request (just the CUID part)
|
||||
[<DefaultValue>] val mutable requestId : string
|
||||
/// The ID of the user to whom the request belongs
|
||||
[<DefaultValue>] val mutable userId : UserId
|
||||
/// The current text of the request
|
||||
[<DefaultValue>] val mutable text : string
|
||||
/// The last time action was taken on the request
|
||||
[<DefaultValue>] val mutable asOf : Ticks
|
||||
/// The last status for the request
|
||||
[<DefaultValue>] val mutable lastStatus : string
|
||||
/// The time that this request should reappear in the user's journal
|
||||
[<DefaultValue>] val mutable snoozedUntil : Ticks
|
||||
/// The time after which this request should reappear in the user's journal by configured recurrence
|
||||
[<DefaultValue>] val mutable showAfter : Ticks
|
||||
/// The type of recurrence for this request
|
||||
[<DefaultValue>] val mutable recurType : Recurrence
|
||||
/// How many of the recurrence intervals should occur between appearances in the journal
|
||||
[<DefaultValue>] val mutable recurCount : int16
|
||||
/// History entries for the request
|
||||
[<DefaultValue>] val mutable history : History list
|
||||
/// Note entries for the request
|
||||
[<DefaultValue>] val mutable notes : Note list
|
||||
type JournalRequest =
|
||||
{ /// The ID of the request (just the CUID part)
|
||||
requestId : RequestId
|
||||
/// The ID of the user to whom the request belongs
|
||||
userId : UserId
|
||||
/// The current text of the request
|
||||
text : string
|
||||
/// The last time action was taken on the request
|
||||
asOf : Ticks
|
||||
/// The last status for the request
|
||||
lastStatus : RequestAction
|
||||
/// The time that this request should reappear in the user's journal
|
||||
snoozedUntil : Ticks
|
||||
/// The time after which this request should reappear in the user's journal by configured recurrence
|
||||
showAfter : Ticks
|
||||
/// The type of recurrence for this request
|
||||
recurType : Recurrence
|
||||
/// How many of the recurrence intervals should occur between appearances in the journal
|
||||
recurCount : int16
|
||||
/// History entries for the request
|
||||
history : History list
|
||||
/// Note entries for the request
|
||||
notes : Note list
|
||||
}
|
||||
|
||||
@ -5,6 +5,7 @@ module MyPrayerJournal.Handlers
|
||||
// fsharplint:disable RecordFieldNames
|
||||
|
||||
open Giraffe
|
||||
open MyPrayerJournal.Data.Extensions
|
||||
|
||||
/// Handler to return Vue files
|
||||
module Vue =
|
||||
@ -35,21 +36,18 @@ module Error =
|
||||
| _ -> Vue.app next ctx
|
||||
|
||||
open Cuid
|
||||
open LiteDB
|
||||
|
||||
/// Handler helpers
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
||||
open Microsoft.AspNetCore.Http
|
||||
open Raven.Client.Documents
|
||||
open System.Threading.Tasks
|
||||
open System.Security.Claims
|
||||
|
||||
/// Create a RavenDB session
|
||||
let session (ctx : HttpContext) =
|
||||
let sess = ctx.GetService<IDocumentStore>().OpenAsyncSession ()
|
||||
sess.Advanced.WaitForIndexesAfterSaveChanges ()
|
||||
sess
|
||||
/// Get the LiteDB database
|
||||
let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>()
|
||||
|
||||
/// Get the user's "sub" claim
|
||||
let user (ctx : HttpContext) =
|
||||
@ -73,7 +71,7 @@ module private Helpers =
|
||||
|
||||
/// The "now" time in JavaScript as Ticks
|
||||
let jsNow () =
|
||||
(int64 >> (*) 1000L >> Ticks) <| DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds
|
||||
DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds |> (int64 >> ( * ) 1_000L >> Ticks)
|
||||
|
||||
/// Handler to return a 403 Not Authorized reponse
|
||||
let notAuthorized : HttpHandler =
|
||||
@ -86,15 +84,6 @@ module private Helpers =
|
||||
/// Flip JSON result so we can pipe into it
|
||||
let asJson<'T> next ctx (o : 'T) =
|
||||
json o next ctx
|
||||
|
||||
/// Work-around to let the Json.NET serializer synchronously deserialize from the request stream
|
||||
// TODO: Remove this once there is an async serializer
|
||||
// let allowSyncIO : HttpHandler =
|
||||
// fun next ctx ->
|
||||
// match ctx.Features.Get<Features.IHttpBodyControlFeature>() with
|
||||
// | null -> ()
|
||||
// | f -> f.AllowSynchronousIO <- true
|
||||
// next ctx
|
||||
|
||||
|
||||
/// Strongly-typed models for post requests
|
||||
@ -102,46 +91,46 @@ module Models =
|
||||
|
||||
/// A history entry addition (AKA request update)
|
||||
[<CLIMutable>]
|
||||
type HistoryEntry =
|
||||
{ /// The status of the history update
|
||||
status : string
|
||||
/// The text of the update
|
||||
updateText : string
|
||||
}
|
||||
type HistoryEntry = {
|
||||
/// The status of the history update
|
||||
status : string
|
||||
/// The text of the update
|
||||
updateText : string
|
||||
}
|
||||
|
||||
/// An additional note
|
||||
[<CLIMutable>]
|
||||
type NoteEntry =
|
||||
{ /// The notes being added
|
||||
notes : string
|
||||
}
|
||||
type NoteEntry = {
|
||||
/// The notes being added
|
||||
notes : string
|
||||
}
|
||||
|
||||
/// Recurrence update
|
||||
[<CLIMutable>]
|
||||
type Recurrence =
|
||||
{ /// The recurrence type
|
||||
recurType : string
|
||||
/// The recurrence cound
|
||||
recurCount : int16
|
||||
}
|
||||
type Recurrence = {
|
||||
/// The recurrence type
|
||||
recurType : string
|
||||
/// The recurrence cound
|
||||
recurCount : int16
|
||||
}
|
||||
|
||||
/// A prayer request
|
||||
[<CLIMutable>]
|
||||
type Request =
|
||||
{ /// The text of the request
|
||||
requestText : string
|
||||
/// The recurrence type
|
||||
recurType : string
|
||||
/// The recurrence count
|
||||
recurCount : int16
|
||||
}
|
||||
type Request = {
|
||||
/// The text of the request
|
||||
requestText : string
|
||||
/// The recurrence type
|
||||
recurType : string
|
||||
/// The recurrence count
|
||||
recurCount : int16
|
||||
}
|
||||
|
||||
/// The time until which a request should not appear in the journal
|
||||
[<CLIMutable>]
|
||||
type SnoozeUntil =
|
||||
{ /// The time at which the request should reappear
|
||||
until : int64
|
||||
}
|
||||
type SnoozeUntil = {
|
||||
/// The time at which the request should reappear
|
||||
until : int64
|
||||
}
|
||||
|
||||
/// /api/journal URLs
|
||||
module Journal =
|
||||
@ -149,13 +138,10 @@ module Journal =
|
||||
/// GET /api/journal
|
||||
let journal : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let! jrnl = Data.journalByUserId usrId sess
|
||||
return! json jrnl next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
|
||||
return! json jrnl next ctx
|
||||
}
|
||||
|
||||
|
||||
/// /api/request URLs
|
||||
@ -164,184 +150,162 @@ module Request =
|
||||
/// POST /api/request
|
||||
let add : HttpHandler =
|
||||
authorize
|
||||
// >=> allowSyncIO
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
let! r = ctx.BindJsonAsync<Models.Request> ()
|
||||
use sess = session ctx
|
||||
let reqId = (Cuid.generate >> RequestId) ()
|
||||
let usrId = userId ctx
|
||||
let now = jsNow ()
|
||||
do! Data.addRequest
|
||||
{ Request.empty with
|
||||
Id = RequestId.toString reqId
|
||||
userId = usrId
|
||||
enteredOn = now
|
||||
showAfter = Ticks 0L
|
||||
recurType = Recurrence.fromString r.recurType
|
||||
recurCount = r.recurCount
|
||||
history = [
|
||||
{ asOf = now
|
||||
status = Created
|
||||
text = Some r.requestText
|
||||
}
|
||||
]
|
||||
} sess
|
||||
do! Data.saveChanges sess
|
||||
match! Data.tryJournalById reqId usrId sess with
|
||||
| Some req -> return! (setStatusCode 201 >=> json req) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let! r = ctx.BindJsonAsync<Models.Request> ()
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let now = jsNow ()
|
||||
let req = { Request.empty with
|
||||
userId = usrId
|
||||
enteredOn = now
|
||||
showAfter = Ticks 0L
|
||||
recurType = Recurrence.fromString r.recurType
|
||||
recurCount = r.recurCount
|
||||
history = [
|
||||
{ asOf = now
|
||||
status = Created
|
||||
text = Some r.requestText
|
||||
}
|
||||
]
|
||||
}
|
||||
Data.addRequest req db
|
||||
do! db.saveChanges ()
|
||||
match! Data.tryJournalById req.id usrId db with
|
||||
| Some req -> return! (setStatusCode 201 >=> json req) next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// POST /api/request/[req-id]/history
|
||||
let addHistory requestId : HttpHandler =
|
||||
authorize
|
||||
// >=> allowSyncIO
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId sess with
|
||||
| Some req ->
|
||||
let! hist = ctx.BindJsonAsync<Models.HistoryEntry> ()
|
||||
let now = jsNow ()
|
||||
let act = RequestAction.fromString hist.status
|
||||
Data.addHistory reqId
|
||||
{ asOf = now
|
||||
status = act
|
||||
text = match hist.updateText with null | "" -> None | x -> Some x
|
||||
} sess
|
||||
match act with
|
||||
| Prayed ->
|
||||
let nextShow =
|
||||
match Recurrence.duration req.recurType with
|
||||
| 0L -> 0L
|
||||
| duration -> (Ticks.toLong now) + (duration * int64 req.recurCount)
|
||||
Data.updateShowAfter reqId (Ticks nextShow) sess
|
||||
| _ -> ()
|
||||
do! Data.saveChanges sess
|
||||
return! created next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> FSharp.Control.Tasks.Affine.task {
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId db with
|
||||
| Some req ->
|
||||
let! hist = ctx.BindJsonAsync<Models.HistoryEntry> ()
|
||||
let now = jsNow ()
|
||||
let act = RequestAction.fromString hist.status
|
||||
do! Data.addHistory reqId usrId
|
||||
{ asOf = now
|
||||
status = act
|
||||
text = match hist.updateText with null | "" -> None | x -> Some x
|
||||
} db
|
||||
match act with
|
||||
| Prayed ->
|
||||
let nextShow =
|
||||
match Recurrence.duration req.recurType with
|
||||
| 0L -> 0L
|
||||
| duration -> (Ticks.toLong now) + (duration * int64 req.recurCount)
|
||||
do! Data.updateShowAfter reqId usrId (Ticks nextShow) db
|
||||
| _ -> ()
|
||||
do! db.saveChanges ()
|
||||
return! created next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// POST /api/request/[req-id]/note
|
||||
let addNote requestId : HttpHandler =
|
||||
authorize
|
||||
// >=> allowSyncIO
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId sess with
|
||||
| Some _ ->
|
||||
let! notes = ctx.BindJsonAsync<Models.NoteEntry> ()
|
||||
Data.addNote reqId { asOf = jsNow (); notes = notes.notes } sess
|
||||
do! Data.saveChanges sess
|
||||
return! created next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId db with
|
||||
| Some _ ->
|
||||
let! notes = ctx.BindJsonAsync<Models.NoteEntry> ()
|
||||
do! Data.addNote reqId usrId { asOf = jsNow (); notes = notes.notes } db
|
||||
do! db.saveChanges ()
|
||||
return! created next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// GET /api/requests/answered
|
||||
let answered : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let! reqs = Data.answeredRequests usrId sess
|
||||
return! json reqs next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let! reqs = Data.answeredRequests (userId ctx) (db ctx)
|
||||
return! json reqs next ctx
|
||||
}
|
||||
|
||||
/// GET /api/request/[req-id]
|
||||
let get requestId : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
match! Data.tryJournalById (toReqId requestId) usrId sess with
|
||||
| Some req -> return! json req next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
match! Data.tryJournalById (toReqId requestId) (userId ctx) (db ctx) with
|
||||
| Some req -> return! json req next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// GET /api/request/[req-id]/full
|
||||
let getFull requestId : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
match! Data.tryFullRequestById (toReqId requestId) usrId sess with
|
||||
| Some req -> return! json req next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
match! Data.tryFullRequestById (toReqId requestId) (userId ctx) (db ctx) with
|
||||
| Some req -> return! json req next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// GET /api/request/[req-id]/notes
|
||||
let getNotes requestId : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let! notes = Data.notesById (toReqId requestId) usrId sess
|
||||
return! json notes next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let! notes = Data.notesById (toReqId requestId) (userId ctx) (db ctx)
|
||||
return! json notes next ctx
|
||||
}
|
||||
|
||||
/// PATCH /api/request/[req-id]/show
|
||||
let show requestId : HttpHandler =
|
||||
authorize
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId sess with
|
||||
| Some _ ->
|
||||
Data.updateShowAfter reqId (Ticks 0L) sess
|
||||
do! Data.saveChanges sess
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId db with
|
||||
| Some _ ->
|
||||
do! Data.updateShowAfter reqId usrId (Ticks 0L) db
|
||||
do! db.saveChanges ()
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// PATCH /api/request/[req-id]/snooze
|
||||
let snooze requestId : HttpHandler =
|
||||
authorize
|
||||
// >=> allowSyncIO
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId sess with
|
||||
| Some _ ->
|
||||
let! until = ctx.BindJsonAsync<Models.SnoozeUntil> ()
|
||||
Data.updateSnoozed reqId (Ticks until.until) sess
|
||||
do! Data.saveChanges sess
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> task {
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId db with
|
||||
| Some _ ->
|
||||
let! until = ctx.BindJsonAsync<Models.SnoozeUntil> ()
|
||||
do! Data.updateSnoozed reqId usrId (Ticks until.until) db
|
||||
do! db.saveChanges ()
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// PATCH /api/request/[req-id]/recurrence
|
||||
let updateRecurrence requestId : HttpHandler =
|
||||
authorize
|
||||
// >=> allowSyncIO
|
||||
>=> fun next ctx ->
|
||||
task {
|
||||
use sess = session ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId sess with
|
||||
| Some _ ->
|
||||
let! recur = ctx.BindJsonAsync<Models.Recurrence> ()
|
||||
let recurrence = Recurrence.fromString recur.recurType
|
||||
Data.updateRecurrence reqId recurrence recur.recurCount sess
|
||||
match recurrence with Immediate -> Data.updateShowAfter reqId (Ticks 0L) sess | _ -> ()
|
||||
do! Data.saveChanges sess
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
>=> fun next ctx -> FSharp.Control.Tasks.Affine.task {
|
||||
let db = db ctx
|
||||
let usrId = userId ctx
|
||||
let reqId = toReqId requestId
|
||||
match! Data.tryRequestById reqId usrId db with
|
||||
| Some _ ->
|
||||
let! recur = ctx.BindJsonAsync<Models.Recurrence> ()
|
||||
let recurrence = Recurrence.fromString recur.recurType
|
||||
do! Data.updateRecurrence reqId usrId recurrence recur.recurCount db
|
||||
match recurrence with
|
||||
| Immediate -> do! Data.updateShowAfter reqId usrId (Ticks 0L) db
|
||||
| _ -> ()
|
||||
do! db.saveChanges ()
|
||||
return! setStatusCode 204 next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
open Giraffe.EndpointRouting
|
||||
|
||||
|
||||
@ -1,29 +1,22 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
<Version>3.0.0.0</Version>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Domain.fs" />
|
||||
<Compile Include="Data.fs" />
|
||||
<Compile Include="Handlers.fs" />
|
||||
<Compile Include="Program.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
|
||||
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
|
||||
<PackageReference Include="Giraffe" Version="5.0.0" />
|
||||
<PackageReference Include="LiteDB" Version="5.0.11" />
|
||||
<PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="5.0.10" />
|
||||
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
|
||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
<PackageReference Include="RavenDb.Client" Version="4.2.102" />
|
||||
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Folder Include="wwwroot\" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
</Project>
|
||||
@ -8,140 +8,114 @@ open System.IO
|
||||
module Configure =
|
||||
|
||||
/// Configure the content root
|
||||
let contentRoot root (bldr : IWebHostBuilder) =
|
||||
bldr.UseContentRoot root
|
||||
let contentRoot root =
|
||||
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
|
||||
|
||||
|
||||
open Microsoft.Extensions.Configuration
|
||||
|
||||
/// Configure the application configuration
|
||||
let appConfiguration (bldr : IWebHostBuilder) =
|
||||
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
|
||||
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
|
||||
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName)
|
||||
.AddEnvironmentVariables ()
|
||||
|> ignore
|
||||
bldr.ConfigureAppConfiguration configuration
|
||||
|
||||
let appConfiguration (bldr : WebApplicationBuilder) =
|
||||
bldr.Configuration
|
||||
.SetBasePath(bldr.Environment.ContentRootPath)
|
||||
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
|
||||
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json")
|
||||
.AddEnvironmentVariables ()
|
||||
|> ignore
|
||||
bldr
|
||||
|
||||
|
||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
||||
|
||||
/// Configure Kestrel from appsettings.json
|
||||
let kestrel (bldr : IWebHostBuilder) =
|
||||
let kestrel (bldr : WebApplicationBuilder) =
|
||||
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
||||
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
||||
bldr.UseKestrel().ConfigureKestrel kestrelOpts
|
||||
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
|
||||
bldr
|
||||
|
||||
|
||||
/// Configure the web root directory
|
||||
let webRoot pathSegments (bldr : IWebHostBuilder) =
|
||||
(Path.Combine >> bldr.UseWebRoot) pathSegments
|
||||
let webRoot pathSegments (bldr : WebApplicationBuilder) =
|
||||
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|
||||
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
|
||||
bldr
|
||||
|
||||
open Giraffe
|
||||
open Microsoft.AspNetCore.Authentication.JwtBearer
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open MyPrayerJournal.Indexes
|
||||
open Newtonsoft.Json
|
||||
open Newtonsoft.Json.Serialization
|
||||
open Raven.Client.Documents
|
||||
open Raven.Client.Documents.Indexes
|
||||
open System.Security.Cryptography.X509Certificates
|
||||
|
||||
/// Configure dependency injection
|
||||
let services (bldr : IWebHostBuilder) =
|
||||
let svcs (sc : IServiceCollection) =
|
||||
/// Custom settings for the JSON serializer (uses compact representation for options and DUs)
|
||||
let jsonSettings =
|
||||
let x = NewtonsoftJson.Serializer.DefaultSettings
|
||||
Converters.all |> List.ofSeq |> List.iter x.Converters.Add
|
||||
x.NullValueHandling <- NullValueHandling.Ignore
|
||||
x.MissingMemberHandling <- MissingMemberHandling.Error
|
||||
x.Formatting <- Formatting.Indented
|
||||
x.ContractResolver <- DefaultContractResolver ()
|
||||
x
|
||||
|
||||
use sp = sc.BuildServiceProvider ()
|
||||
let cfg = sp.GetRequiredService<IConfiguration> ()
|
||||
sc.AddRouting()
|
||||
.AddGiraffe()
|
||||
.AddAuthentication(
|
||||
/// Use HTTP "Bearer" authentication with JWTs
|
||||
fun opts ->
|
||||
opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
|
||||
opts.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme)
|
||||
.AddJwtBearer(
|
||||
/// Configure JWT options with Auth0 options from configuration
|
||||
fun opts ->
|
||||
let jwtCfg = cfg.GetSection "Auth0"
|
||||
opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
|
||||
opts.Audience <- jwtCfg.["Id"]
|
||||
)
|
||||
|> ignore
|
||||
sc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonSettings)
|
||||
|> ignore
|
||||
let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB"
|
||||
let store = new DocumentStore ()
|
||||
store.Urls <- [| config.["URL"] |]
|
||||
store.Database <- config.["Database"]
|
||||
match isNull config.["Certificate"] with
|
||||
| true -> ()
|
||||
| false -> store.Certificate <- new X509Certificate2 (config.["Certificate"], config.["Password"])
|
||||
store.Conventions.CustomizeJsonSerializer <- fun x -> Converters.all |> List.ofSeq |> List.iter x.Converters.Add
|
||||
store.Initialize () |> (sc.AddSingleton >> ignore)
|
||||
IndexCreation.CreateIndexes (typeof<Requests_AsJournal>.Assembly, store)
|
||||
bldr.ConfigureServices svcs
|
||||
|
||||
open Microsoft.Extensions.Logging
|
||||
open Microsoft.Extensions.Hosting
|
||||
|
||||
/// Configure logging
|
||||
let logging (bldr : IWebHostBuilder) =
|
||||
let logz (log : ILoggingBuilder) =
|
||||
let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> ()
|
||||
match env.IsDevelopment () with
|
||||
| true -> log
|
||||
| false -> log.AddFilter(fun l -> l > LogLevel.Information)
|
||||
|> function l -> l.AddConsole().AddDebug()
|
||||
|> ignore
|
||||
bldr.ConfigureLogging logz
|
||||
let logging (bldr : WebApplicationBuilder) =
|
||||
match bldr.Environment.IsDevelopment () with
|
||||
| true -> ()
|
||||
| false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
|
||||
bldr.Logging.AddConsole().AddDebug() |> ignore
|
||||
bldr
|
||||
|
||||
|
||||
open Giraffe
|
||||
open LiteDB
|
||||
open Microsoft.AspNetCore.Authentication.JwtBearer
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open System.Text.Json
|
||||
open System.Text.Json.Serialization
|
||||
|
||||
/// Configure dependency injection
|
||||
let services (bldr : WebApplicationBuilder) =
|
||||
bldr.Services
|
||||
.AddRouting()
|
||||
.AddGiraffe()
|
||||
.AddAuthentication(
|
||||
/// Use HTTP "Bearer" authentication with JWTs
|
||||
fun opts ->
|
||||
opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
|
||||
opts.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme)
|
||||
.AddJwtBearer(
|
||||
/// Configure JWT options with Auth0 options from configuration
|
||||
fun opts ->
|
||||
let jwtCfg = bldr.Configuration.GetSection "Auth0"
|
||||
opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
|
||||
opts.Audience <- jwtCfg.["Id"]
|
||||
)
|
||||
|> ignore
|
||||
let jsonOptions = JsonSerializerOptions ()
|
||||
jsonOptions.Converters.Add (JsonFSharpConverter ())
|
||||
bldr.Services.AddSingleton(jsonOptions)
|
||||
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>()
|
||||
.AddSingleton<LiteDatabase>(fun _ -> new LiteDatabase (bldr.Configuration.GetConnectionString "db"))
|
||||
|> ignore
|
||||
bldr.Build ()
|
||||
|
||||
|
||||
open System
|
||||
open Giraffe.EndpointRouting
|
||||
|
||||
/// Configure the web application
|
||||
let application (bldr : IWebHostBuilder) =
|
||||
let appConfig =
|
||||
Action<IApplicationBuilder> (
|
||||
fun (app : IApplicationBuilder) ->
|
||||
let env = app.ApplicationServices.GetService<IWebHostEnvironment> ()
|
||||
match env.IsDevelopment () with
|
||||
| true -> app.UseDeveloperExceptionPage ()
|
||||
| false -> app.UseGiraffeErrorHandler Handlers.Error.error
|
||||
|> function
|
||||
| a ->
|
||||
a.UseAuthentication()
|
||||
.UseStaticFiles()
|
||||
.UseRouting()
|
||||
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|
||||
|> ignore)
|
||||
bldr.Configure appConfig
|
||||
let application (app : WebApplication) =
|
||||
match app.Environment.IsDevelopment () with
|
||||
| true -> app.UseDeveloperExceptionPage ()
|
||||
| false -> app.UseGiraffeErrorHandler Handlers.Error.error
|
||||
|> ignore
|
||||
app.UseAuthentication()
|
||||
.UseStaticFiles()
|
||||
.UseRouting()
|
||||
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|
||||
|> ignore
|
||||
app
|
||||
|
||||
/// Compose all the configurations into one
|
||||
let webHost appRoot pathSegments =
|
||||
contentRoot appRoot
|
||||
let webHost pathSegments =
|
||||
contentRoot
|
||||
>> appConfiguration
|
||||
>> kestrel
|
||||
>> webRoot (Array.concat [ [| appRoot |]; pathSegments ])
|
||||
>> services
|
||||
>> webRoot pathSegments
|
||||
>> logging
|
||||
>> services
|
||||
>> application
|
||||
|
||||
/// Build the web host from the given configuration
|
||||
let buildHost (bldr : IWebHostBuilder) = bldr.Build ()
|
||||
|
||||
let exitCode = 0
|
||||
|
||||
[<EntryPoint>]
|
||||
let main _ =
|
||||
let appRoot = Directory.GetCurrentDirectory ()
|
||||
use host = WebHostBuilder() |> (Configure.webHost appRoot [| "wwwroot" |] >> Configure.buildHost)
|
||||
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
|
||||
host.Run ()
|
||||
exitCode
|
||||
0
|
||||
|
||||
Loading…
Reference in New Issue
Block a user