bit-badger/myPrayerJournal
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 36 Activity

Convert data to LiteDB-backed store

Browse Source
This commit is contained in:
Daniel J. Summers 2021-09-21 19:12:13 -04:00
parent 33effdd17e
commit bbe7294ba6
6 changed files with 553 additions and 604 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/MyPrayerJournal.sln
View File

@ -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

339
src/MyPrayerJournal/Api/Data.fs
View File

@ -1,186 +1,227 @@
namespace MyPrayerJournal module MyPrayerJournal.Data
open LiteDB
open System open System
open System.Collections.Generic open System.Threading.Tasks
/// JSON converters for various DUs // fsharplint:disable MemberNames
module Converters =
open Microsoft.FSharpLu.Json /// LiteDB extensions
open Newtonsoft.Json [<AutoOpen>]
module Extensions =
/// JSON converter for request IDs /// Extensions on the LiteDatabase class
type RequestIdJsonConverter () = type LiteDatabase with
inherit JsonConverter<RequestId> () /// The Request collection
override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) = member this.requests
(RequestId.toString >> writer.WriteValue) value with get () = this.GetCollection<Request>("request")
override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) = /// Async version of the checkpoint command (flushes log)
(string >> RequestId.fromIdString) reader.Value member this.saveChanges () =
this.Checkpoint()
Task.CompletedTask
/// 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
/// JSON converter for Ticks /// Map domain to LiteDB
type TicksJsonConverter () = // It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
inherit JsonConverter<Ticks> () [<RequireQualifiedAccess>]
override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) = module Mapping =
(Ticks.toLong >> writer.WriteValue) value
override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
(string >> int64 >> Ticks) reader.Value
/// A sequence of all custom converters needed for myPrayerJournal /// Map a history entry to BSON
let all : JsonConverter seq = let historyToBson (hist : History) : BsonValue =
seq { let doc = BsonDocument ()
yield RequestIdJsonConverter () doc.["asOf"] <- BsonValue (Ticks.toLong hist.asOf)
yield UserIdJsonConverter () doc.["status"] <- BsonValue (RequestAction.toString hist.status)
yield TicksJsonConverter () doc.["text"] <- BsonValue (Option.toObj hist.text)
yield CompactUnionJsonConverter true upcast doc
/// 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
}
/// 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 /// Retrieve a request, including its history and notes, by its ID and user ID
module Indexes = let tryFullRequestById reqId userId (db : LiteDatabase) = task {
let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId))
open Raven.Client.Documents.Indexes return match box req with null -> None | _ -> Some req
}
/// 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>
/// 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 /// Add a history entry
let addHistory reqId (hist : History) (sess : IAsyncDocumentSession) = let addHistory reqId userId hist db = task {
sess.Advanced.Patch<Request, History> ( match! tryFullRequestById reqId userId db with
RequestId.toString reqId, | Some req -> do! doUpdate db { req with history = hist :: req.history }
(fun r -> r.history :> IEnumerable<History>), | None -> invalidOp $"{RequestId.toString reqId} not found"
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 the user's current journal /// Add a note
let journalByUserId userId (sess : IAsyncDocumentSession) = let addNote reqId userId note db = task {
task { match! tryFullRequestById reqId userId db with
let! jrnl = | Some req -> do! doUpdate db { req with notes = note :: req.notes }
sess.Query<JournalRequest, Requests_AsJournal>() | None -> invalidOp $"{RequestId.toString reqId} not found"
.Where(fun r -> r.userId = userId && r.lastStatus <> "Answered") }
.OrderBy(fun r -> r.asOf)
.ProjectInto<JournalRequest>() /// Add a request
.ToListAsync() 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 return
jrnl reqs
|> Seq.map (fun r -> r.history <- []; r.notes <- []; r) |> Seq.map toJournalFull
|> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf)
|> List.ofSeq |> List.ofSeq
} }
/// Save changes in the current document session /// Retrieve the user's current journal
let saveChanges (sess : IAsyncDocumentSession) = let journalByUserId userId (db : LiteDatabase) = task {
sess.SaveChangesAsync () let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
return
/// Retrieve a request, including its history and notes, by its ID and user ID jrnl
let tryFullRequestById reqId userId (sess : IAsyncDocumentSession) = |> Seq.map toJournalLite
task { |> Seq.filter (fun it -> it.lastStatus <> Answered)
let! req = RequestId.toString reqId |> sess.LoadAsync |> Seq.sortBy (fun it -> Ticks.toLong it.asOf)
return match Option.fromObject req with Some r when r.userId = userId -> Some r | _ -> None |> List.ofSeq
} }
/// Retrieve a request by its ID and user ID (without notes and history) /// Retrieve a request by its ID and user ID (without notes and history)
let tryRequestById reqId userId (sess : IAsyncDocumentSession) = let tryRequestById reqId userId db = task {
task { match! tryFullRequestById reqId userId db with
match! tryFullRequestById reqId userId sess with
| Some r -> return Some { r with history = []; notes = [] } | Some r -> return Some { r with history = []; notes = [] }
| _ -> return None | _ -> return None
} }
/// Retrieve notes for a request by its ID and user ID /// Retrieve notes for a request by its ID and user ID
let notesById reqId userId (sess : IAsyncDocumentSession) = let notesById reqId userId (db : LiteDatabase) = task {
task { match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return []
match! tryFullRequestById reqId userId sess with
| Some req -> return req.notes
| None -> return []
} }
/// Retrieve a journal request by its ID and user ID /// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (sess : IAsyncDocumentSession) = let tryJournalById reqId userId (db : LiteDatabase) = task {
task { match! tryFullRequestById reqId userId db with
let! req = | Some req -> return req |> (toJournalLite >> Some)
sess.Query<Request, Requests_AsJournal>() | None -> return None
.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 /// Update the recurrence for a request
let updateRecurrence reqId recurType recurCount (sess : IAsyncDocumentSession) = let updateRecurrence reqId userId recurType recurCount db = task {
sess.Advanced.Patch<Request, Recurrence> (RequestId.toString reqId, (fun r -> r.recurType), recurType) match! tryFullRequestById reqId userId db with
sess.Advanced.Patch<Request, int16> (RequestId.toString reqId, (fun r -> r.recurCount), recurCount) | Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update a snoozed request /// Update a snoozed request
let updateSnoozed reqId until (sess : IAsyncDocumentSession) = let updateSnoozed reqId userId until db = task {
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.snoozedUntil), until) match! tryFullRequestById reqId userId db with
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.showAfter), until) | 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 /// Update the "show after" timestamp for a request
let updateShowAfter reqId showAfter (sess : IAsyncDocumentSession) = let updateShowAfter reqId userId showAfter db = task {
sess.Advanced.Patch<Request, Ticks> (RequestId.toString reqId, (fun r -> r.showAfter), showAfter) match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with showAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}

104
src/MyPrayerJournal/Api/Domain.fs
View File

@ -6,19 +6,23 @@ module MyPrayerJournal.Domain
open Cuid open Cuid
/// Request ID is a CUID /// An identifier for a request
type RequestId = type RequestId =
| RequestId of Cuid | RequestId of Cuid
/// Functions to manipulate request IDs
module RequestId = module RequestId =
/// The string representation of the request ID /// 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 /// 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 = type UserId =
| UserId of string | UserId of string
/// Functions to manipulate user IDs
module UserId = module UserId =
/// The string representation of the user ID /// The string representation of the user ID
let toString = function UserId x -> x let toString = function UserId x -> x
@ -27,6 +31,8 @@ module UserId =
/// A long integer representing seconds since the epoch /// A long integer representing seconds since the epoch
type Ticks = type Ticks =
| Ticks of int64 | Ticks of int64
/// Functions to manipulate Ticks
module Ticks = module Ticks =
/// The int64 (long) representation of ticks /// The int64 (long) representation of ticks
let toLong = function Ticks x -> x let toLong = function Ticks x -> x
@ -38,7 +44,16 @@ type Recurrence =
| Hours | Hours
| Days | Days
| Weeks | Weeks
/// Functions to manipulate recurrences
module Recurrence = 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 /// Create a recurrence value from a string
let fromString = let fromString =
function function
@ -47,13 +62,16 @@ module Recurrence =
| "Days" -> Days | "Days" -> Days
| "Weeks" -> Weeks | "Weeks" -> Weeks
| it -> invalidOp $"{it} is not a valid recurrence" | it -> invalidOp $"{it} is not a valid recurrence"
/// The duration of the recurrence /// An hour's worth of seconds
let duration = let private oneHour = 3_600L
function /// The duration of the recurrence (in milliseconds)
let duration x =
(match x with
| Immediate -> 0L | Immediate -> 0L
| Hours -> 3600000L | Hours -> oneHour
| Days -> 86400000L | Days -> oneHour * 24L
| Weeks -> 604800000L | Weeks -> oneHour * 24L * 7L)
|> ( * ) 1000L
/// The action taken on a request as part of a history entry /// The action taken on a request as part of a history entry
@ -62,7 +80,16 @@ type RequestAction =
| Prayed | Prayed
| Updated | Updated
| Answered | Answered
/// Functions to manipulate request actions
module RequestAction = 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 /// Create a RequestAction from a string
let fromString = let fromString =
function function
@ -75,42 +102,29 @@ module RequestAction =
/// History is a record of action taken on a prayer request, including updates to its text /// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type History = type History = {
{ /// The time when this history entry was made /// The time when this history entry was made
asOf : Ticks asOf : Ticks
/// The status for this history entry /// The status for this history entry
status : RequestAction status : RequestAction
/// The text of the update, if applicable /// The text of the update, if applicable
text : string option text : string option
} }
with
/// An empty history entry
static member empty =
{ asOf = Ticks 0L
status = Created
text = None
}
/// Note is a note regarding a prayer request that does not result in an update to its text /// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Note = type Note = {
{ /// The time when this note was made /// The time when this note was made
asOf : Ticks asOf : Ticks
/// The text of the notes /// The text of the notes
notes : string notes : string
} }
with
/// An empty note
static member empty =
{ asOf = Ticks 0L
notes = ""
}
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = type Request = {
{ /// The ID of the request /// The ID of the request
Id : string id : RequestId
/// The time this request was initially entered /// The time this request was initially entered
enteredOn : Ticks enteredOn : Ticks
/// The ID of the user to whom this request belongs ("sub" from the JWT) /// The ID of the user to whom this request belongs ("sub" from the JWT)
@ -131,7 +145,7 @@ type Request =
with with
/// An empty request /// An empty request
static member empty = static member empty =
{ Id = "" { id = Cuid.generate () |> RequestId
enteredOn = Ticks 0L enteredOn = Ticks 0L
userId = UserId "" userId = UserId ""
snoozedUntil = Ticks 0L 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 /// 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. /// 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>] [<NoComparison; NoEquality>]
type JournalRequest () = type JournalRequest =
/// The ID of the request (just the CUID part) { /// The ID of the request (just the CUID part)
[<DefaultValue>] val mutable requestId : string requestId : RequestId
/// The ID of the user to whom the request belongs /// The ID of the user to whom the request belongs
[<DefaultValue>] val mutable userId : UserId userId : UserId
/// The current text of the request /// The current text of the request
[<DefaultValue>] val mutable text : string text : string
/// The last time action was taken on the request /// The last time action was taken on the request
[<DefaultValue>] val mutable asOf : Ticks asOf : Ticks
/// The last status for the request /// The last status for the request
[<DefaultValue>] val mutable lastStatus : string lastStatus : RequestAction
/// The time that this request should reappear in the user's journal /// The time that this request should reappear in the user's journal
[<DefaultValue>] val mutable snoozedUntil : Ticks snoozedUntil : Ticks
/// The time after which this request should reappear in the user's journal by configured recurrence /// The time after which this request should reappear in the user's journal by configured recurrence
[<DefaultValue>] val mutable showAfter : Ticks showAfter : Ticks
/// The type of recurrence for this request /// The type of recurrence for this request
[<DefaultValue>] val mutable recurType : Recurrence recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal /// How many of the recurrence intervals should occur between appearances in the journal
[<DefaultValue>] val mutable recurCount : int16 recurCount : int16
/// History entries for the request /// History entries for the request
[<DefaultValue>] val mutable history : History list history : History list
/// Note entries for the request /// Note entries for the request
[<DefaultValue>] val mutable notes : Note list notes : Note list
}

160
src/MyPrayerJournal/Api/Handlers.fs
View File

@ -5,6 +5,7 @@ module MyPrayerJournal.Handlers
// fsharplint:disable RecordFieldNames // fsharplint:disable RecordFieldNames
open Giraffe open Giraffe
open MyPrayerJournal.Data.Extensions
/// Handler to return Vue files /// Handler to return Vue files
module Vue = module Vue =
@ -35,21 +36,18 @@ module Error =
| _ -> Vue.app next ctx | _ -> Vue.app next ctx
open Cuid open Cuid
open LiteDB
/// Handler helpers /// Handler helpers
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Raven.Client.Documents
open System.Threading.Tasks open System.Threading.Tasks
open System.Security.Claims open System.Security.Claims
/// Create a RavenDB session /// Get the LiteDB database
let session (ctx : HttpContext) = let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>()
let sess = ctx.GetService<IDocumentStore>().OpenAsyncSession ()
sess.Advanced.WaitForIndexesAfterSaveChanges ()
sess
/// Get the user's "sub" claim /// Get the user's "sub" claim
let user (ctx : HttpContext) = let user (ctx : HttpContext) =
@ -73,7 +71,7 @@ module private Helpers =
/// The "now" time in JavaScript as Ticks /// The "now" time in JavaScript as Ticks
let jsNow () = 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 /// Handler to return a 403 Not Authorized reponse
let notAuthorized : HttpHandler = let notAuthorized : HttpHandler =
@ -87,23 +85,14 @@ module private Helpers =
let asJson<'T> next ctx (o : 'T) = let asJson<'T> next ctx (o : 'T) =
json o next ctx 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 /// Strongly-typed models for post requests
module Models = module Models =
/// A history entry addition (AKA request update) /// A history entry addition (AKA request update)
[<CLIMutable>] [<CLIMutable>]
type HistoryEntry = type HistoryEntry = {
{ /// The status of the history update /// The status of the history update
status : string status : string
/// The text of the update /// The text of the update
updateText : string updateText : string
@ -111,15 +100,15 @@ module Models =
/// An additional note /// An additional note
[<CLIMutable>] [<CLIMutable>]
type NoteEntry = type NoteEntry = {
{ /// The notes being added /// The notes being added
notes : string notes : string
} }
/// Recurrence update /// Recurrence update
[<CLIMutable>] [<CLIMutable>]
type Recurrence = type Recurrence = {
{ /// The recurrence type /// The recurrence type
recurType : string recurType : string
/// The recurrence cound /// The recurrence cound
recurCount : int16 recurCount : int16
@ -127,8 +116,8 @@ module Models =
/// A prayer request /// A prayer request
[<CLIMutable>] [<CLIMutable>]
type Request = type Request = {
{ /// The text of the request /// The text of the request
requestText : string requestText : string
/// The recurrence type /// The recurrence type
recurType : string recurType : string
@ -138,8 +127,8 @@ module Models =
/// The time until which a request should not appear in the journal /// The time until which a request should not appear in the journal
[<CLIMutable>] [<CLIMutable>]
type SnoozeUntil = type SnoozeUntil = {
{ /// The time at which the request should reappear /// The time at which the request should reappear
until : int64 until : int64
} }
@ -149,11 +138,8 @@ module Journal =
/// GET /api/journal /// GET /api/journal
let journal : HttpHandler = let journal : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
use sess = session ctx
let usrId = userId ctx
let! jrnl = Data.journalByUserId usrId sess
return! json jrnl next ctx return! json jrnl next ctx
} }
@ -164,17 +150,12 @@ module Request =
/// POST /api/request /// POST /api/request
let add : HttpHandler = let add : HttpHandler =
authorize authorize
// >=> allowSyncIO >=> fun next ctx -> task {
>=> fun next ctx ->
task {
let! r = ctx.BindJsonAsync<Models.Request> () let! r = ctx.BindJsonAsync<Models.Request> ()
use sess = session ctx let db = db ctx
let reqId = (Cuid.generate >> RequestId) ()
let usrId = userId ctx let usrId = userId ctx
let now = jsNow () let now = jsNow ()
do! Data.addRequest let req = { Request.empty with
{ Request.empty with
Id = RequestId.toString reqId
userId = usrId userId = usrId
enteredOn = now enteredOn = now
showAfter = Ticks 0L showAfter = Ticks 0L
@ -186,9 +167,10 @@ module Request =
text = Some r.requestText text = Some r.requestText
} }
] ]
} sess }
do! Data.saveChanges sess Data.addRequest req db
match! Data.tryJournalById reqId usrId sess with do! db.saveChanges ()
match! Data.tryJournalById req.id usrId db with
| Some req -> return! (setStatusCode 201 >=> json req) next ctx | Some req -> return! (setStatusCode 201 >=> json req) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -196,31 +178,29 @@ module Request =
/// POST /api/request/[req-id]/history /// POST /api/request/[req-id]/history
let addHistory requestId : HttpHandler = let addHistory requestId : HttpHandler =
authorize authorize
// >=> allowSyncIO >=> fun next ctx -> FSharp.Control.Tasks.Affine.task {
>=> fun next ctx -> let db = db ctx
task {
use sess = session ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = toReqId requestId let reqId = toReqId requestId
match! Data.tryRequestById reqId usrId sess with match! Data.tryRequestById reqId usrId db with
| Some req -> | Some req ->
let! hist = ctx.BindJsonAsync<Models.HistoryEntry> () let! hist = ctx.BindJsonAsync<Models.HistoryEntry> ()
let now = jsNow () let now = jsNow ()
let act = RequestAction.fromString hist.status let act = RequestAction.fromString hist.status
Data.addHistory reqId do! Data.addHistory reqId usrId
{ asOf = now { asOf = now
status = act status = act
text = match hist.updateText with null | "" -> None | x -> Some x text = match hist.updateText with null | "" -> None | x -> Some x
} sess } db
match act with match act with
| Prayed -> | Prayed ->
let nextShow = let nextShow =
match Recurrence.duration req.recurType with match Recurrence.duration req.recurType with
| 0L -> 0L | 0L -> 0L
| duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount)
Data.updateShowAfter reqId (Ticks nextShow) sess do! Data.updateShowAfter reqId usrId (Ticks nextShow) db
| _ -> () | _ -> ()
do! Data.saveChanges sess do! db.saveChanges ()
return! created next ctx return! created next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -229,16 +209,15 @@ module Request =
let addNote requestId : HttpHandler = let addNote requestId : HttpHandler =
authorize authorize
// >=> allowSyncIO // >=> allowSyncIO
>=> fun next ctx -> >=> fun next ctx -> task {
task { let db = db ctx
use sess = session ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = toReqId requestId let reqId = toReqId requestId
match! Data.tryRequestById reqId usrId sess with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
let! notes = ctx.BindJsonAsync<Models.NoteEntry> () let! notes = ctx.BindJsonAsync<Models.NoteEntry> ()
Data.addNote reqId { asOf = jsNow (); notes = notes.notes } sess do! Data.addNote reqId usrId { asOf = jsNow (); notes = notes.notes } db
do! Data.saveChanges sess do! db.saveChanges ()
return! created next ctx return! created next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -246,22 +225,16 @@ module Request =
/// GET /api/requests/answered /// GET /api/requests/answered
let answered : HttpHandler = let answered : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { let! reqs = Data.answeredRequests (userId ctx) (db ctx)
use sess = session ctx
let usrId = userId ctx
let! reqs = Data.answeredRequests usrId sess
return! json reqs next ctx return! json reqs next ctx
} }
/// GET /api/request/[req-id] /// GET /api/request/[req-id]
let get requestId : HttpHandler = let get requestId : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { match! Data.tryJournalById (toReqId requestId) (userId ctx) (db ctx) with
use sess = session ctx
let usrId = userId ctx
match! Data.tryJournalById (toReqId requestId) usrId sess with
| Some req -> return! json req next ctx | Some req -> return! json req next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -269,11 +242,8 @@ module Request =
/// GET /api/request/[req-id]/full /// GET /api/request/[req-id]/full
let getFull requestId : HttpHandler = let getFull requestId : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { match! Data.tryFullRequestById (toReqId requestId) (userId ctx) (db ctx) with
use sess = session ctx
let usrId = userId ctx
match! Data.tryFullRequestById (toReqId requestId) usrId sess with
| Some req -> return! json req next ctx | Some req -> return! json req next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -281,26 +251,22 @@ module Request =
/// GET /api/request/[req-id]/notes /// GET /api/request/[req-id]/notes
let getNotes requestId : HttpHandler = let getNotes requestId : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { let! notes = Data.notesById (toReqId requestId) (userId ctx) (db ctx)
use sess = session ctx
let usrId = userId ctx
let! notes = Data.notesById (toReqId requestId) usrId sess
return! json notes next ctx return! json notes next ctx
} }
/// PATCH /api/request/[req-id]/show /// PATCH /api/request/[req-id]/show
let show requestId : HttpHandler = let show requestId : HttpHandler =
authorize authorize
>=> fun next ctx -> >=> fun next ctx -> task {
task { let db = db ctx
use sess = session ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = toReqId requestId let reqId = toReqId requestId
match! Data.tryRequestById reqId usrId sess with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
Data.updateShowAfter reqId (Ticks 0L) sess do! Data.updateShowAfter reqId usrId (Ticks 0L) db
do! Data.saveChanges sess do! db.saveChanges ()
return! setStatusCode 204 next ctx return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -308,17 +274,15 @@ module Request =
/// PATCH /api/request/[req-id]/snooze /// PATCH /api/request/[req-id]/snooze
let snooze requestId : HttpHandler = let snooze requestId : HttpHandler =
authorize authorize
// >=> allowSyncIO >=> fun next ctx -> task {
>=> fun next ctx -> let db = db ctx
task {
use sess = session ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = toReqId requestId let reqId = toReqId requestId
match! Data.tryRequestById reqId usrId sess with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
let! until = ctx.BindJsonAsync<Models.SnoozeUntil> () let! until = ctx.BindJsonAsync<Models.SnoozeUntil> ()
Data.updateSnoozed reqId (Ticks until.until) sess do! Data.updateSnoozed reqId usrId (Ticks until.until) db
do! Data.saveChanges sess do! db.saveChanges ()
return! setStatusCode 204 next ctx return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -326,19 +290,19 @@ module Request =
/// PATCH /api/request/[req-id]/recurrence /// PATCH /api/request/[req-id]/recurrence
let updateRecurrence requestId : HttpHandler = let updateRecurrence requestId : HttpHandler =
authorize authorize
// >=> allowSyncIO >=> fun next ctx -> FSharp.Control.Tasks.Affine.task {
>=> fun next ctx -> let db = db ctx
task {
use sess = session ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = toReqId requestId let reqId = toReqId requestId
match! Data.tryRequestById reqId usrId sess with match! Data.tryRequestById reqId usrId db with
| Some _ -> | Some _ ->
let! recur = ctx.BindJsonAsync<Models.Recurrence> () let! recur = ctx.BindJsonAsync<Models.Recurrence> ()
let recurrence = Recurrence.fromString recur.recurType let recurrence = Recurrence.fromString recur.recurType
Data.updateRecurrence reqId recurrence recur.recurCount sess do! Data.updateRecurrence reqId usrId recurrence recur.recurCount db
match recurrence with Immediate -> Data.updateShowAfter reqId (Ticks 0L) sess | _ -> () match recurrence with
do! Data.saveChanges sess | Immediate -> do! Data.updateShowAfter reqId usrId (Ticks 0L) db
| _ -> ()
do! db.saveChanges ()
return! setStatusCode 204 next ctx return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

11
src/MyPrayerJournal/Api/MyPrayerJournal.Api.fsproj
View File

@ -1,29 +1,22 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net6.0</TargetFramework> <TargetFramework>net6.0</TargetFramework>
<Version>3.0.0.0</Version> <Version>3.0.0.0</Version>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Domain.fs" /> <Compile Include="Domain.fs" />
<Compile Include="Data.fs" /> <Compile Include="Data.fs" />
<Compile Include="Handlers.fs" /> <Compile Include="Handlers.fs" />
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" /> <PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="5.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.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>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />
</ItemGroup> </ItemGroup>
</Project> </Project>

136
src/MyPrayerJournal/Api/Program.fs
View File

@ -8,59 +8,63 @@ open System.IO
module Configure = module Configure =
/// Configure the content root /// Configure the content root
let contentRoot root (bldr : IWebHostBuilder) = let contentRoot root =
bldr.UseContentRoot root WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
/// Configure the application configuration /// Configure the application configuration
let appConfiguration (bldr : IWebHostBuilder) = let appConfiguration (bldr : WebApplicationBuilder) =
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = bldr.Configuration
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) .SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName) .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json")
.AddEnvironmentVariables () .AddEnvironmentVariables ()
|> ignore |> ignore
bldr.ConfigureAppConfiguration configuration bldr
open Microsoft.AspNetCore.Server.Kestrel.Core open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json /// Configure Kestrel from appsettings.json
let kestrel (bldr : IWebHostBuilder) = let kestrel (bldr : WebApplicationBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.UseKestrel().ConfigureKestrel kestrelOpts bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
bldr
/// Configure the web root directory /// Configure the web root directory
let webRoot pathSegments (bldr : IWebHostBuilder) = let webRoot pathSegments (bldr : WebApplicationBuilder) =
(Path.Combine >> bldr.UseWebRoot) pathSegments Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
bldr
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Hosting
/// Configure logging
let logging (bldr : WebApplicationBuilder) =
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 Giraffe
open LiteDB
open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open MyPrayerJournal.Indexes open System.Text.Json
open Newtonsoft.Json open System.Text.Json.Serialization
open Newtonsoft.Json.Serialization
open Raven.Client.Documents
open Raven.Client.Documents.Indexes
open System.Security.Cryptography.X509Certificates
/// Configure dependency injection /// Configure dependency injection
let services (bldr : IWebHostBuilder) = let services (bldr : WebApplicationBuilder) =
let svcs (sc : IServiceCollection) = bldr.Services
/// Custom settings for the JSON serializer (uses compact representation for options and DUs) .AddRouting()
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() .AddGiraffe()
.AddAuthentication( .AddAuthentication(
/// Use HTTP "Bearer" authentication with JWTs /// Use HTTP "Bearer" authentication with JWTs
@ -70,78 +74,48 @@ module Configure =
.AddJwtBearer( .AddJwtBearer(
/// Configure JWT options with Auth0 options from configuration /// Configure JWT options with Auth0 options from configuration
fun opts -> fun opts ->
let jwtCfg = cfg.GetSection "Auth0" let jwtCfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"] opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
opts.Audience <- jwtCfg.["Id"] opts.Audience <- jwtCfg.["Id"]
) )
|> ignore |> ignore
sc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonSettings) 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 |> ignore
let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB" bldr.Build ()
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
open System
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// Configure the web application /// Configure the web application
let application (bldr : IWebHostBuilder) = let application (app : WebApplication) =
let appConfig = match app.Environment.IsDevelopment () with
Action<IApplicationBuilder> (
fun (app : IApplicationBuilder) ->
let env = app.ApplicationServices.GetService<IWebHostEnvironment> ()
match env.IsDevelopment () with
| true -> app.UseDeveloperExceptionPage () | true -> app.UseDeveloperExceptionPage ()
| false -> app.UseGiraffeErrorHandler Handlers.Error.error | false -> app.UseGiraffeErrorHandler Handlers.Error.error
|> function |> ignore
| a -> app.UseAuthentication()
a.UseAuthentication()
.UseStaticFiles() .UseStaticFiles()
.UseRouting() .UseRouting()
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|> ignore) |> ignore
bldr.Configure appConfig app
/// Compose all the configurations into one /// Compose all the configurations into one
let webHost appRoot pathSegments = let webHost pathSegments =
contentRoot appRoot contentRoot
>> appConfiguration >> appConfiguration
>> kestrel >> kestrel
>> webRoot (Array.concat [ [| appRoot |]; pathSegments ]) >> webRoot pathSegments
>> services
>> logging >> logging
>> services
>> application >> application
/// Build the web host from the given configuration
let buildHost (bldr : IWebHostBuilder) = bldr.Build ()
let exitCode = 0
[<EntryPoint>] [<EntryPoint>]
let main _ = let main _ =
let appRoot = Directory.GetCurrentDirectory () use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
use host = WebHostBuilder() |> (Configure.webHost appRoot [| "wwwroot" |] >> Configure.buildHost)
host.Run () host.Run ()
exitCode 0