Version 3

This commit is contained in:
Daniel J. Summers 2021-10-26 19:38:45 -04:00
parent ca622aa4b7
commit 77c85f516c
70 changed files with 2341 additions and 12481 deletions

10
.gitignore vendored
View File

@ -254,13 +254,3 @@ paket-files/
# Ionide VSCode extension
.ionide
# Compiled files / application
src/build
src/MyPrayerJournal.Api/wwwroot/favicon.ico
src/MyPrayerJournal.Api/wwwroot/index.html
src/MyPrayerJournal.Api/wwwroot/css
src/MyPrayerJournal.Api/wwwroot/js
src/MyPrayerJournal.Api/appsettings.development.json
/build
src/*.exe

3
publish.ps1 Executable file
View File

@ -0,0 +1,3 @@
#!/snap/bin/pwsh
Set-Location src/MyPrayerJournal
dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false

View File

@ -1,186 +0,0 @@
namespace MyPrayerJournal
open System
open System.Collections.Generic
/// JSON converters for various DUs
module Converters =
open Microsoft.FSharpLu.Json
open Newtonsoft.Json
/// 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
/// 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
/// A sequence of all custom converters needed for myPrayerJournal
let all : JsonConverter seq =
seq {
yield RequestIdJsonConverter ()
yield UserIdJsonConverter ()
yield TicksJsonConverter ()
yield CompactUnionJsonConverter true
}
/// RavenDB index declarations
module Indexes =
open Raven.Client.Documents.Indexes
/// Index requests for a journal view
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 FSharp.Control.Tasks.V2.ContextInsensitive
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 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
}
/// Save changes in the current document session
let saveChanges (sess : IAsyncDocumentSession) =
sess.SaveChangesAsync ()
/// 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)

View File

@ -1,169 +0,0 @@
[<AutoOpen>]
/// The data model for myPrayerJournal
module MyPrayerJournal.Domain
open Cuid
/// Request ID is a CUID
type RequestId =
| RequestId of Cuid
module RequestId =
/// The string representation of the request ID
let toString x = match x with RequestId y -> (Cuid.toString >> sprintf "Requests/%s") y
/// Create a request ID from a string representation
let fromIdString (y : string) = (Cuid >> RequestId) <| y.Replace("Requests/", "")
/// User ID is a string (the "sub" part of the JWT)
type UserId =
| UserId of string
module UserId =
/// The string representation of the user ID
let toString x = match x with UserId y -> y
/// A long integer representing seconds since the epoch
type Ticks =
| Ticks of int64
module Ticks =
/// The int64 (long) representation of ticks
let toLong x = match x with Ticks y -> y
/// How frequently a request should reappear after it is marked "Prayed"
type Recurrence =
| Immediate
| Hours
| Days
| Weeks
module Recurrence =
/// Create a recurrence value from a string
let fromString x =
match x with
| "Immediate" -> Immediate
| "Hours" -> Hours
| "Days" -> Days
| "Weeks" -> Weeks
| _ -> invalidOp (sprintf "%s is not a valid recurrence" x)
/// The duration of the recurrence
let duration x =
match x with
| Immediate -> 0L
| Hours -> 3600000L
| Days -> 86400000L
| Weeks -> 604800000L
/// The action taken on a request as part of a history entry
type RequestAction =
| Created
| Prayed
| Updated
| Answered
module RequestAction =
/// Create a RequestAction from a string
let fromString x =
match x with
| "Created" -> Created
| "Prayed" -> Prayed
| "Updated" -> Updated
| "Answered" -> Answered
| _ -> (sprintf "Bad request action %s" >> invalidOp) x
/// 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
}
/// 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 = ""
}
/// 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
}
with
/// An empty request
static member empty =
{ Id = ""
enteredOn = Ticks 0L
userId = UserId ""
snoozedUntil = Ticks 0L
showAfter = Ticks 0L
recurType = Immediate
recurCount = 0s
history = []
notes = []
}
/// 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

View File

@ -1,378 +0,0 @@
/// HTTP handlers for the myPrayerJournal API
[<RequireQualifiedAccess>]
module MyPrayerJournal.Handlers
open Giraffe
/// Handler to return Vue files
module Vue =
/// The application index page
let app : HttpHandler = htmlFile "wwwroot/index.html"
open System
/// Handlers for error conditions
module Error =
open Microsoft.Extensions.Logging
/// Handle errors
let error (ex : Exception) (log : ILogger) =
log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> json ex.Message
/// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
let notFound : HttpHandler =
fun next ctx ->
[ "/journal"; "/legal"; "/request"; "/user" ]
|> List.filter ctx.Request.Path.Value.StartsWith
|> List.length
|> function
| 0 -> (setStatusCode 404 >=> json ([ "error", "not found" ] |> dict)) next ctx
| _ -> Vue.app next ctx
open Cuid
/// 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 user's "sub" claim
let user (ctx : HttpContext) =
ctx.User.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)
/// Get the current user's ID
// NOTE: this may raise if you don't run the request through the authorize handler first
let userId ctx =
((user >> Option.get) ctx).Value |> UserId
/// Create a request ID from a string
let toReqId x =
let reqId =
match Cuid.ofString x with
| Ok cuid -> cuid
| Error msg -> invalidOp msg
RequestId reqId
/// Return a 201 CREATED response
let created next ctx =
setStatusCode 201 next ctx
/// The "now" time in JavaScript as Ticks
let jsNow () =
(int64 >> (*) 1000L >> Ticks) <| DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds
/// Handler to return a 403 Not Authorized reponse
let notAuthorized : HttpHandler =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handler to require authorization
let authorize : HttpHandler =
fun next ctx -> match user ctx with Some _ -> next ctx | None -> notAuthorized next ctx
/// 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
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
}
/// An additional note
[<CLIMutable>]
type NoteEntry =
{ /// The notes being added
notes : string
}
/// Recurrence update
[<CLIMutable>]
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
}
/// 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
}
open FSharp.Control.Tasks.V2.ContextInsensitive
/// /api/journal URLs
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
}
/// /api/request URLs
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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
/// 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
}
open Giraffe.TokenRouter
/// The routes for myPrayerJournal
let webApp : HttpHandler =
router Error.notFound [
route "/" Vue.app
subRoute "/api/" [
GET [
route "journal" Journal.journal
subRoute "request" [
route "s/answered" Request.answered
routef "/%s/full" Request.getFull
routef "/%s/notes" Request.getNotes
routef "/%s" Request.get
]
]
PATCH [
subRoute "request" [
routef "/%s/recurrence" Request.updateRecurrence
routef "/%s/show" Request.show
routef "/%s/snooze" Request.snooze
]
]
POST [
subRoute "request" [
route "" Request.add
routef "/%s/history" Request.addHistory
routef "/%s/note" Request.addNote
]
]
]
]

View File

@ -1,30 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net5.0</TargetFramework>
<Version>2.2.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="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="4.1.0" />
<PackageReference Include="Giraffe.TokenRouter" Version="1.0.0" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="3.1.3" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.6" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.6" />
<PackageReference Include="RavenDb.Client" Version="4.2.102" />
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
</ItemGroup>
<ItemGroup>
<Folder Include="wwwroot\" />
</ItemGroup>
</Project>

View File

@ -1,145 +0,0 @@
module MyPrayerJournal.Api
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Hosting
open System.IO
/// Configuration functions for the application
module Configure =
/// Configure the content root
let contentRoot root (bldr : IWebHostBuilder) =
bldr.UseContentRoot root
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
open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json
let kestrel (bldr : IWebHostBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.UseKestrel().ConfigureKestrel kestrelOpts
/// Configure the web root directory
let webRoot pathSegments (bldr : IWebHostBuilder) =
(Path.Combine >> bldr.UseWebRoot) pathSegments
open Giraffe
open Giraffe.Serialization
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 = NewtonsoftJsonSerializer.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.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<IJsonSerializer> (NewtonsoftJsonSerializer 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
open System
/// 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()
.UseGiraffe Handlers.webApp
|> ignore)
bldr.Configure appConfig
/// Compose all the configurations into one
let webHost appRoot pathSegments =
contentRoot appRoot
>> appConfiguration
>> kestrel
>> webRoot (Array.concat [ [| appRoot |]; pathSegments ])
>> services
>> logging
>> 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)
host.Run ()
exitCode

View File

@ -0,0 +1,22 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Data" Version="4.2.3" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup>
</Project>

View File

@ -0,0 +1,57 @@
open FSharp.Data
open FSharp.Data.CsvExtensions
open LiteDB
open MyPrayerJournal.Domain
open NodaTime
module Subdocs =
open FSharp.Data.JsonExtensions
let history json =
match JsonValue.Parse json with
| JsonValue.Array hist ->
hist
|> Array.map (fun h ->
{ asOf = (h?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
status = h?status.AsString () |> RequestAction.ofString
text = match h?text.AsString () with "" -> None | txt -> Some txt
})
|> List.ofArray
| _ -> []
let notes json =
match JsonValue.Parse json with
| JsonValue.Array notes ->
notes
|> Array.map (fun n ->
{ asOf = (n?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
notes = n?notes.AsString ()
})
|> List.ofArray
| _ -> []
let oldData = CsvFile.Load("data.csv")
let db = new LiteDatabase("Filename=./mpj.db")
MyPrayerJournal.Data.Startup.ensureDb db
let migrated =
oldData.Rows
|> Seq.map (fun r ->
{ id = r["@id"].Replace ("Requests/", "") |> RequestId.ofString
enteredOn = (r?enteredOn.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
userId = UserId r?userId
snoozedUntil = (r?snoozedUntil.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
showAfter = (r?showAfter.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
recurType = r?recurType |> Recurrence.ofString
recurCount = (r?recurCount.AsInteger >> int16) ()
history = Subdocs.history r?history
notes = Subdocs.notes r?notes
})
|> db.GetCollection<Request>("request").Insert
db.Checkpoint ()
printfn $"Migrated {migrated} requests"

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

5
src/MyPrayerJournal/.gitignore vendored Normal file
View File

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

209
src/MyPrayerJournal/Data.fs Normal file
View File

@ -0,0 +1,209 @@
module MyPrayerJournal.Data
open LiteDB
open NodaTime
open System
open System.Threading.Tasks
// fsharplint:disable MemberNames
/// LiteDB extensions
[<AutoOpen>]
module Extensions =
/// 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
/// 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"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
/// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
/// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds ()
doc["notes"] <- note.notes
upcast doc
/// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
notes = doc["notes"].AsString
}
/// Map a request to its BSON representation
let requestToBson req : BsonValue =
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc["notes"] <- BsonArray (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 = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString 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 =
open System.Linq
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let toListAsync<'T> (q : 'T seq) =
(q.ToList >> Task.FromResult) ()
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let firstAsync<'T> (q : 'T seq) =
q.FirstOrDefault () |> Task.FromResult
/// Async wrapper around a request update
let doUpdate (db : LiteDatabase) (req : Request) =
db.requests.Update req |> ignore
Task.CompletedTask
/// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
}
/// Add a history entry
let addHistory reqId userId hist db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with history = hist :: req.history }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Add a note
let addNote reqId userId note db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with notes = note :: req.notes }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Add a request
let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore
// FIXME: make a common function here
/// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
return
reqs
|> Seq.map JournalRequest.ofRequestFull
|> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.asOf)
|> List.ofSeq
}
/// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = backgroundTask {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
return
jrnl
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.lastStatus <> Answered)
|> Seq.sortBy (fun it -> it.asOf)
|> List.ofSeq
}
/// Does the user have any snoozed requests?
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
let! jrnl = journalByUserId userId db
return jrnl |> List.exists (fun r -> r.snoozedUntil > now)
}
/// Retrieve a request by its ID and user ID (without notes and history)
let tryRequestById reqId userId db = backgroundTask {
let! req = tryFullRequestById reqId userId db
return req |> Option.map (fun r -> { r with history = []; notes = [] })
}
/// Retrieve notes for a request by its ID and user ID
let notesById reqId userId (db : LiteDatabase) = backgroundTask {
match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return []
}
/// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite
}
/// Update the recurrence for a request
let updateRecurrence reqId userId recurType recurCount db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update a snoozed request
let updateSnoozed reqId userId until db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}
/// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with showAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}

View File

@ -0,0 +1,78 @@
/// Date formatting helpers
// Many thanks to date-fns (https://date-fns.org) for this logic