Syntactically valid

No compile errors - but does it work...?
This commit is contained in:
Daniel J. Summers 2019-07-14 20:47:31 -05:00
parent cc5dd3bd7f
commit 7fb6bc463e
5 changed files with 181 additions and 118 deletions

View File

@ -1,13 +1,14 @@
namespace MyPrayerJournal
open FSharp.Control.Tasks.V2.ContextInsensitive
open Microsoft.EntityFrameworkCore
open Microsoft.FSharpLu
open Newtonsoft.Json
open Raven.Client.Documents.Indexes
open System
open System.Collections.Generic
open Raven.Client.Documents.Linq
open Raven.Client.Documents
/// JSON converter for request IDs
type RequestIdJsonConverter() =
@ -35,12 +36,34 @@ type TicksJsonConverter() =
override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
(string >> int64 >> Ticks) reader.Value
/// Index episodes by their series Id
/// Index requests by user ID
type Requests_ByUserId () as this =
inherit AbstractJavaScriptIndexCreationTask ()
do
this.Maps <- HashSet<string> [ "map('Requests', function (req) { return { userId : req.userId } })" ]
/// Index requests for a journal view
type Requests_AsJournal () as this =
inherit AbstractJavaScriptIndexCreationTask ()
do
this.Maps <- HashSet<string> [
"map('Requests', function (req) {
var hist = req.history
.filter(function (hist) { return hist.text !== null })
.sort(function (a, b) { return b - a })
return {
requestId : req.Id,
userId : req.userId,
text : hist[0].text,
asOf : req.history[req.history.length - 1].asOf,
snoozedUntil : req.snoozedUntil,
showAfter : req.showAfter,
recurType : req.recurType,
recurCount : req.recurCount
}
})"
]
/// Extensions on the IAsyncDocumentSession interface to support our data manipulation needs
[<AutoOpen>]
@ -55,19 +78,32 @@ module Extensions =
let fromIndex (typ : Type) =
typ.Name.Replace ("_", "/") |> sprintf "from index '%s'"
/// Utility method to create patch requests
let createPatch<'T> collName itemId (item : 'T) =
/// Utility method to create a patch request to push an item on the end of a list
let listPush<'T> listName docId (item : 'T) =
let r = PatchRequest()
r.Script <- sprintf "this.%s.push(args.Item)" collName
r.Script <- sprintf "this.%s.push(args.Item)" listName
r.Values.["Item"] <- item
PatchCommandData (itemId, null, r, null)
PatchCommandData (docId, null, r, null)
/// Utility method to create a patch to update a single field
// TODO: think we need to include quotes if it's a string
let fieldUpdate<'T> fieldName docId (item : 'T) =
let r = PatchRequest()
r.Script <- sprintf "this.%s = args.Item" fieldName
r.Values.["Item"] <- item
PatchCommandData (docId, null, r, null)
// Extensions for the RavenDB session type
type IAsyncDocumentSession with
/// Add a history entry
member this.AddHistory (reqId : RequestId) (hist : History) =
createPatch "history" (string reqId) hist
listPush "history" (string reqId) hist
|> this.Advanced.Defer
/// Add a note
member this.AddNote (reqId : RequestId) (note : Note) =
listPush "notes" (string reqId) note
|> this.Advanced.Defer
/// Add a request
@ -78,18 +114,18 @@ module Extensions =
// TODO: not right
member this.AnsweredRequests (userId : UserId) =
sprintf "%s where userId = '%s' and lastStatus = 'Answered' order by asOf as long desc"
(fromIndex typeof<Requests_ByUserId>) (string userId)
(fromIndex typeof<Requests_AsJournal>) (string userId)
|> this.Advanced.AsyncRawQuery<JournalRequest>
/// Retrieve the user's current journal
// TODO: probably not right either
member this.JournalByUserId (userId : UserId) =
sprintf "%s where userId = '%s' and lastStatus <> 'Answered' order by showAfter as long"
(fromIndex typeof<Requests_ByUserId>) (string userId)
(fromIndex typeof<Requests_AsJournal>) (string userId)
|> this.Advanced.AsyncRawQuery<JournalRequest>
/// Retrieve a request by its ID and user ID
member this.TryRequestById (reqId : RequestId) userId =
/// Retrieve a request, including its history and notes, by its ID and user ID
member this.TryFullRequestById (reqId : RequestId) userId =
task {
let! req = this.LoadAsync (string reqId)
match Option.fromObject req with
@ -97,37 +133,56 @@ module Extensions =
| _ -> return None
}
/// Retrieve a request by its ID and user ID (without notes and history)
member this.TryRequestById reqId userId =
task {
match! this.TryFullRequestById reqId userId with
| Some r -> return Some { r with history = []; notes = [] }
| _ -> return None
}
/// Retrieve notes for a request by its ID and user ID
member this.NotesById reqId userId =
task {
match! this.TryRequestById reqId userId with
| Some _ -> return this.Notes.AsNoTracking().Where(fun n -> n.requestId = reqId) |> List.ofSeq
| Some req -> return req.notes
| None -> return []
}
/// Retrieve a journal request by its ID and user ID
member this.TryJournalById reqId userId =
member this.TryJournalById (reqId : RequestId) userId =
task {
let! req = this.Journal.FirstOrDefaultAsync(fun r -> r.requestId = reqId && r.userId = userId)
let! req =
this.Query<Request, Requests_AsJournal>()
.Where(fun x -> x.Id = (string reqId) && x.userId = userId)
.ProjectInto<JournalRequest>()
.FirstOrDefaultAsync ()
return Option.fromObject req
}
/// Retrieve a request, including its history and notes, by its ID and user ID
member this.TryFullRequestById requestId userId =
task {
match! this.TryJournalById requestId userId with
| Some req ->
let! fullReq =
this.Requests.AsNoTracking()
.Include(fun r -> r.history)
.Include(fun r -> r.notes)
.FirstOrDefaultAsync(fun r -> r.requestId = requestId && r.userId = userId)
match Option.fromObject fullReq with
| Some _ -> return Some { req with history = List.ofSeq fullReq.history; notes = List.ofSeq fullReq.notes }
| None -> return None
| None -> return None
}
/// Update the recurrence for a request
member this.UpdateRecurrence (reqId : RequestId) (recurType : Recurrence) (recurCount : int16) =
let r = PatchRequest()
r.Script <- "this.recurType = args.Type; this.recurCount = args.Count"
r.Values.["Type"] <- string recurType
r.Values.["Count"] <- recurCount
PatchCommandData (string reqId, null, r, null) |> this.Advanced.Defer
/// Update the "show after" timestamp for a request
member this.UpdateShowAfter (reqId : RequestId) (showAfter : Ticks) =
fieldUpdate "showAfter" (string reqId) (showAfter.toLong ())
|> this.Advanced.Defer
/// Update a snoozed request
member this.UpdateSnoozed (reqId : RequestId) (until : Ticks) =
let r = PatchRequest()
r.Script <- "this.snoozedUntil = args.Item; this.showAfter = args.Item"
r.Values.["Item"] <- until.toLong ()
PatchCommandData (string reqId, null, r, null) |> this.Advanced.Defer
(*
/// Entity Framework configuration for myPrayerJournal
module internal EFConfig =
@ -278,3 +333,4 @@ type AppDbContext (opts : DbContextOptions<AppDbContext>) =
| None -> return None
| None -> return None
}
*)

View File

@ -58,6 +58,13 @@ with
| "days" -> Days
| "weeks" -> Weeks
| _ -> invalidOp (sprintf "%s is not a valid recurrence" x)
/// The duration of the recurrence
member x.duration =
match x with
| Immediate -> 0L
| Hours -> 3600000L
| Days -> 86400000L
| Weeks -> 604800000L
/// History is a record of action taken on a prayer request, including updates to its text

View File

@ -45,8 +45,8 @@ module private Helpers =
open System.Security.Claims
/// Get the database context from DI
let db (ctx : HttpContext) =
ctx.GetService<AppDbContext> ()
// let db (ctx : HttpContext) =
// ctx.GetService<AppDbContext> ()
/// Create a RavenDB session
let session (ctx : HttpContext) =
@ -61,13 +61,16 @@ module private Helpers =
let userId ctx =
((user >> Option.get) ctx).Value |> UserId
/// Create a request ID from a string
let toReqId = Domain.Cuid >> RequestId
/// Return a 201 CREATED response
let created next ctx =
setStatusCode 201 next ctx
/// The "now" time in JavaScript
/// The "now" time in JavaScript as Ticks
let jsNow () =
DateTime.UtcNow.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds |> int64 |> (*) 1000L
(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 =
@ -143,9 +146,11 @@ module Journal =
let journal : HttpHandler =
authorize
>=> fun next ctx ->
userId ctx
|> (db ctx).JournalByUserId
|> asJson next ctx
task {
use sess = session ctx
let! jrnl = ((userId >> sess.JournalByUserId) ctx).ToListAsync ()
return! json jrnl next ctx
}
/// /api/request URLs
@ -153,15 +158,6 @@ module Request =
open NCuid
/// Ticks per recurrence
let private recurrence =
[ "immediate", 0L
"hours", 3600000L
"days", 86400000L
"weeks", 604800000L
]
|> Map.ofList
/// POST /api/request
let add : HttpHandler =
authorize
@ -169,9 +165,9 @@ module Request =
task {
let! r = ctx.BindJsonAsync<Models.Request> ()
use sess = session ctx
let reqId = (Cuid.Generate >> Domain.Cuid >> RequestId) ()
let reqId = (Cuid.Generate >> toReqId) ()
let usrId = userId ctx
let now = (jsNow >> Ticks) ()
let now = jsNow ()
do! sess.AddRequest
{ Request.empty with
Id = string reqId
@ -195,16 +191,16 @@ module Request =
}
/// POST /api/request/[req-id]/history
let addHistory reqId : HttpHandler =
let addHistory requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
use sess = session ctx
let reqId = (Domain.Cuid >> RequestId) reqId
let reqId = toReqId requestId
match! sess.TryRequestById reqId (userId ctx) with
| Some req ->
let! hist = ctx.BindJsonAsync<Models.HistoryEntry> ()
let now = (jsNow >> Ticks) ()
let now = jsNow ()
{ History.empty with
asOf = now
status = hist.status
@ -213,7 +209,7 @@ module Request =
|> sess.AddHistory reqId
match hist.status with
| "Prayed" ->
sess.UpdateEntry { req with showAfter = now + (recurrence.[req.recurType] * int64 req.recurCount) }
(Ticks >> sess.UpdateShowAfter reqId) <| now.toLong () + (req.recurType.duration * int64 req.recurCount)
| _ -> ()
do! sess.SaveChangesAsync ()
return! created next ctx
@ -221,20 +217,17 @@ module Request =
}
/// POST /api/request/[req-id]/note
let addNote reqId : HttpHandler =
let addNote requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
let db = db ctx
match! db.TryRequestById reqId (userId ctx) with
use sess = session ctx
let reqId = toReqId requestId
match! sess.TryRequestById reqId (userId ctx) with
| Some _ ->
let! notes = ctx.BindJsonAsync<Models.NoteEntry> ()
{ Note.empty with
asOf = (jsNow >> Ticks) ()
notes = notes.notes
}
|> db.AddEntry
let! _ = db.SaveChangesAsync ()
sess.AddNote reqId { asOf = jsNow (); notes = notes.notes }
do! sess.SaveChangesAsync ()
return! created next ctx
| None -> return! Error.notFound next ctx
}
@ -243,85 +236,88 @@ module Request =
let answered : HttpHandler =
authorize
>=> fun next ctx ->
userId ctx
|> (db ctx).AnsweredRequests
|> asJson next ctx
task {
use sess = session ctx
let! reqs = ((userId >> sess.AnsweredRequests) ctx).ToListAsync ()
return! json reqs next ctx
}
/// GET /api/request/[req-id]
let get reqId : HttpHandler =
let get requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
use sess = session ctx
match! sess.TryJournalById reqId (userId ctx) with
match! sess.TryJournalById (toReqId requestId) (userId ctx) with
| Some req -> return! json req next ctx
| None -> return! Error.notFound next ctx
}
/// GET /api/request/[req-id]/full
let getFull reqId : HttpHandler =
let getFull requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
use sess = session ctx
match! sess.TryFullRequestById reqId (userId ctx) with
match! sess.TryFullRequestById (toReqId requestId) (userId ctx) with
| Some req -> return! json req next ctx
| None -> return! Error.notFound next ctx
}
/// GET /api/request/[req-id]/notes
let getNotes reqId : HttpHandler =
let getNotes requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
let! notes = (db ctx).NotesById reqId (userId ctx)
use sess = session ctx
let! notes = sess.NotesById (toReqId requestId) (userId ctx)
return! json notes next ctx
}
/// PATCH /api/request/[req-id]/show
let show reqId : HttpHandler =
let show requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
let db = db ctx
match! db.TryRequestById reqId (userId ctx) with
| Some req ->
use sess = session ctx
let reqId = toReqId requestId
match! sess.TryRequestById reqId (userId ctx) with
| Some _ ->
let! show = ctx.BindJsonAsync<Models.Show> ()
{ req with showAfter = Ticks show.showAfter }
|> db.UpdateEntry
let! _ = db.SaveChangesAsync ()
sess.UpdateShowAfter reqId (Ticks show.showAfter)
do! sess.SaveChangesAsync ()
return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx
}
/// PATCH /api/request/[req-id]/snooze
let snooze reqId : HttpHandler =
let snooze requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
let db = db ctx
match! db.TryRequestById reqId (userId ctx) with
| Some req ->
use sess = session ctx
let reqId = toReqId requestId
match! sess.TryRequestById reqId (userId ctx) with
| Some _ ->
let! until = ctx.BindJsonAsync<Models.SnoozeUntil> ()
{ req with snoozedUntil = Ticks until.until; showAfter = Ticks until.until }
|> db.UpdateEntry
let! _ = db.SaveChangesAsync ()
sess.UpdateSnoozed reqId (Ticks until.until)
do! sess.SaveChangesAsync ()
return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx
}
/// PATCH /api/request/[req-id]/recurrence
let updateRecurrence reqId : HttpHandler =
let updateRecurrence requestId : HttpHandler =
authorize
>=> fun next ctx ->
task {
let db = db ctx
match! db.TryRequestById reqId (userId ctx) with
| Some req ->
use sess = session ctx
let reqId = toReqId requestId
match! sess.TryRequestById reqId (userId ctx) with
| Some _ ->
let! recur = ctx.BindJsonAsync<Models.Recurrence> ()
{ req with recurType = Recurrence.fromString recur.recurType; recurCount = recur.recurCount }
|> db.UpdateEntry
let! _ = db.SaveChangesAsync ()
sess.UpdateRecurrence reqId (Recurrence.fromString recur.recurType) recur.recurCount
do! sess.SaveChangesAsync ()
return! setStatusCode 204 next ctx
| None -> return! Error.notFound next ctx
}

View File

@ -2,22 +2,11 @@ namespace MyPrayerJournal.Api
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Hosting
open System
/// Configuration functions for the application
module Configure =
open Giraffe
open Giraffe.Serialization
open Giraffe.TokenRouter
open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.AspNetCore.Server.Kestrel.Core
open Microsoft.EntityFrameworkCore
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging
open Microsoft.FSharpLu.Json
open MyPrayerJournal
open Newtonsoft.Json
/// Set up the configuration for the app
@ -28,10 +17,15 @@ module Configure =
.AddEnvironmentVariables()
|> ignore
open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json
let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
open Giraffe.Serialization
open Microsoft.FSharpLu.Json
/// Custom settings for the JSON serializer (uses compact representation for options and DUs)
let jsonSettings =
let x = NewtonsoftJsonSerializer.DefaultSettings
@ -41,6 +35,15 @@ module Configure =
x.Formatting <- Formatting.Indented
x
open Giraffe
open Giraffe.TokenRouter
open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.Extensions.DependencyInjection
open MyPrayerJournal
open Raven.Client.Documents
open Raven.Client.Documents.Indexes
open System.Security.Cryptography.X509Certificates
/// Configure dependency injection
let services (sc : IServiceCollection) =
use sp = sc.BuildServiceProvider()
@ -58,9 +61,21 @@ module Configure =
opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
opts.Audience <- jwtCfg.["Id"])
|> ignore
sc.AddDbContext<AppDbContext>(fun opts -> opts.UseNpgsql(cfg.GetConnectionString "mpj") |> ignore)
.AddSingleton<IJsonSerializer>(NewtonsoftJsonSerializer jsonSettings)
sc.AddSingleton<IJsonSerializer>(NewtonsoftJsonSerializer jsonSettings)
|> ignore
let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB"
let store = new DocumentStore ()
store.Urls <- [| config.["URLs"] |]
store.Database <- config.["Database"]
store.Certificate <- new X509Certificate2 (config.["Certificate"], config.["Password"])
store.Conventions.CustomizeJsonSerializer <- (fun x ->
x.Converters.Add (RequestIdJsonConverter ())
x.Converters.Add (TicksJsonConverter ())
x.Converters.Add (UserIdJsonConverter ())
x.Converters.Add (CompactUnionJsonConverter true))
store.Initialize () |> sc.AddSingleton |> ignore
IndexCreation.CreateIndexes (typeof<Requests_ByUserId>.Assembly, store)
/// Routes for the available URLs within myPrayerJournal
let webApp =
@ -106,6 +121,8 @@ module Configure =
.UseGiraffe webApp
|> ignore
open Microsoft.Extensions.Logging
/// Configure logging
let logging (log : ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IHostingEnvironment> ()
@ -118,6 +135,7 @@ module Configure =
module Program =
open System
open System.IO
let exitCode = 0

View File

@ -3,8 +3,6 @@ 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.Domain", "MyPrayerJournal.Domain\MyPrayerJournal.Domain.fsproj", "{6236760D-B21E-4187-9D0B-7D5E1C6AD896}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MyPrayerJournal.Api", "MyPrayerJournal.Api\MyPrayerJournal.Api.fsproj", "{1887D1E1-544A-4F54-B266-38E7867DC842}"
EndProject
Global
@ -17,18 +15,6 @@ Global
Release|iPhoneSimulator = Release|iPhoneSimulator
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|iPhone.ActiveCfg = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|iPhone.Build.0 = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|Any CPU.Build.0 = Release|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|iPhone.ActiveCfg = Release|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|iPhone.Build.0 = Release|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
{6236760D-B21E-4187-9D0B-7D5E1C6AD896}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{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