Version 3.1 #71
@ -81,13 +81,19 @@ let convertNote (old : OldNote) =
 | 
			
		||||
        Notes = old.notes
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
/// Convert items that may be Instant.MinValue or Instant(0) to None
 | 
			
		||||
let noneIfOld ms =
 | 
			
		||||
    match Instant.FromUnixTimeMilliseconds ms with
 | 
			
		||||
    | instant when instant > Instant.FromUnixTimeMilliseconds 0 -> Some instant
 | 
			
		||||
    | _ -> None
 | 
			
		||||
    
 | 
			
		||||
/// Map the old request to the new request
 | 
			
		||||
let convert old =
 | 
			
		||||
    {   Id           = old.id
 | 
			
		||||
        EnteredOn    = Instant.FromUnixTimeMilliseconds old.enteredOn
 | 
			
		||||
        UserId       = old.userId
 | 
			
		||||
        SnoozedUntil = Instant.FromUnixTimeMilliseconds old.snoozedUntil
 | 
			
		||||
        ShowAfter    = Instant.FromUnixTimeMilliseconds old.showAfter
 | 
			
		||||
        SnoozedUntil = noneIfOld old.snoozedUntil
 | 
			
		||||
        ShowAfter    = noneIfOld old.showAfter
 | 
			
		||||
        Recurrence   = mapRecurrence old
 | 
			
		||||
        History      = old.history |> Array.map convertHistory |> List.ofArray
 | 
			
		||||
        Notes        = old.notes   |> Array.map convertNote    |> List.ofArray
 | 
			
		||||
@ -95,8 +101,8 @@ let convert old =
 | 
			
		||||
 | 
			
		||||
/// Remove the old request, add the converted one (removes recurType / recurCount fields)
 | 
			
		||||
let replace (req : Request) =
 | 
			
		||||
    db.requests.Delete (Mapping.RequestId.toBson req.Id) |> ignore
 | 
			
		||||
    db.requests.Insert req |> ignore
 | 
			
		||||
    db.Requests.Delete (Mapping.RequestId.toBson req.Id) |> ignore
 | 
			
		||||
    db.Requests.Insert req |> ignore
 | 
			
		||||
    db.Checkpoint ()
 | 
			
		||||
 | 
			
		||||
db.GetCollection<OldRequest>("request").FindAll ()
 | 
			
		||||
 | 
			
		||||
@ -2,11 +2,7 @@
 | 
			
		||||
 | 
			
		||||
open LiteDB
 | 
			
		||||
open MyPrayerJournal
 | 
			
		||||
open NodaTime
 | 
			
		||||
open System.Threading.Tasks
 | 
			
		||||
open NodaTime.Text
 | 
			
		||||
 | 
			
		||||
// fsharplint:disable MemberNames
 | 
			
		||||
 | 
			
		||||
/// LiteDB extensions
 | 
			
		||||
[<AutoOpen>]
 | 
			
		||||
@ -16,11 +12,10 @@ module Extensions =
 | 
			
		||||
    type LiteDatabase with
 | 
			
		||||
        
 | 
			
		||||
        /// The Request collection
 | 
			
		||||
        member this.requests
 | 
			
		||||
          with get () = this.GetCollection<Request> "request"
 | 
			
		||||
        member this.Requests = this.GetCollection<Request> "request"
 | 
			
		||||
        
 | 
			
		||||
        /// Async version of the checkpoint command (flushes log)
 | 
			
		||||
        member this.saveChanges () =
 | 
			
		||||
        member this.SaveChanges () =
 | 
			
		||||
            this.Checkpoint ()
 | 
			
		||||
            Task.CompletedTask
 | 
			
		||||
 | 
			
		||||
@ -30,6 +25,9 @@ module Extensions =
 | 
			
		||||
[<RequireQualifiedAccess>]
 | 
			
		||||
module Mapping =
 | 
			
		||||
    
 | 
			
		||||
    open NodaTime
 | 
			
		||||
    open NodaTime.Text
 | 
			
		||||
    
 | 
			
		||||
    /// A NodaTime instant pattern to use for parsing instants from the database
 | 
			
		||||
    let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
 | 
			
		||||
    
 | 
			
		||||
@ -40,6 +38,9 @@ module Mapping =
 | 
			
		||||
    
 | 
			
		||||
    /// Mapping for option types
 | 
			
		||||
    module Option =
 | 
			
		||||
        let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
 | 
			
		||||
        let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
 | 
			
		||||
        
 | 
			
		||||
        let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
 | 
			
		||||
        let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
 | 
			
		||||
    
 | 
			
		||||
@ -66,6 +67,7 @@ module Mapping =
 | 
			
		||||
    /// Set up the mapping
 | 
			
		||||
    let register () = 
 | 
			
		||||
        BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
 | 
			
		||||
        BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
 | 
			
		||||
        BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
 | 
			
		||||
        BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
 | 
			
		||||
        BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
 | 
			
		||||
@ -77,7 +79,7 @@ module Startup =
 | 
			
		||||
  
 | 
			
		||||
    /// Ensure the database is set up
 | 
			
		||||
    let ensureDb (db : LiteDatabase) =
 | 
			
		||||
        db.requests.EnsureIndex (fun it -> it.UserId) |> ignore
 | 
			
		||||
        db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
 | 
			
		||||
        Mapping.register ()
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -97,39 +99,42 @@ module private Helpers =
 | 
			
		||||
 | 
			
		||||
    /// Async wrapper around a request update
 | 
			
		||||
    let doUpdate (db : LiteDatabase) (req : Request) =
 | 
			
		||||
        db.requests.Update req |> ignore
 | 
			
		||||
        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
 | 
			
		||||
    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 }
 | 
			
		||||
    | Some req -> do! doUpdate db { req with History = Array.append [| 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 }
 | 
			
		||||
    | Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes }
 | 
			
		||||
    | None     -> invalidOp $"{RequestId.toString reqId} not found"
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
/// Add a request
 | 
			
		||||
let addRequest (req : Request) (db : LiteDatabase) =
 | 
			
		||||
    db.requests.Insert req |> ignore
 | 
			
		||||
    db.Requests.Insert req |> ignore
 | 
			
		||||
 | 
			
		||||
// FIXME: make a common function here
 | 
			
		||||
/// Find all requests for the given user
 | 
			
		||||
let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask {
 | 
			
		||||
    return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
/// 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
 | 
			
		||||
let answeredRequests userId db = backgroundTask {
 | 
			
		||||
    let! reqs = getRequestsForUser userId db
 | 
			
		||||
    return
 | 
			
		||||
        reqs
 | 
			
		||||
        |> Seq.map JournalRequest.ofRequestFull
 | 
			
		||||
@ -139,10 +144,10 @@ let answeredRequests userId (db : LiteDatabase) = backgroundTask {
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
/// Retrieve the user's current journal
 | 
			
		||||
let journalByUserId userId (db : LiteDatabase) = backgroundTask {
 | 
			
		||||
    let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
 | 
			
		||||
let journalByUserId userId db = backgroundTask {
 | 
			
		||||
    let! reqs = getRequestsForUser userId db
 | 
			
		||||
    return
 | 
			
		||||
        jrnl
 | 
			
		||||
        reqs
 | 
			
		||||
        |> Seq.map JournalRequest.ofRequestLite
 | 
			
		||||
        |> Seq.filter (fun it -> it.LastStatus <> Answered)
 | 
			
		||||
        |> Seq.sortBy (fun it -> it.AsOf)
 | 
			
		||||
@ -152,18 +157,18 @@ let journalByUserId userId (db : LiteDatabase) = backgroundTask {
 | 
			
		||||
/// 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)
 | 
			
		||||
    return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
/// 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 = [] })
 | 
			
		||||
    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 []
 | 
			
		||||
    match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||]
 | 
			
		||||
}
 | 
			
		||||
    
 | 
			
		||||
/// Retrieve a journal request by its ID and user ID
 | 
			
		||||
 | 
			
		||||
@ -160,19 +160,19 @@ type Request =
 | 
			
		||||
        UserId : UserId
 | 
			
		||||
        
 | 
			
		||||
        /// The time at which this request should reappear in the user's journal by manual user choice
 | 
			
		||||
        SnoozedUntil : Instant
 | 
			
		||||
        SnoozedUntil : Instant option
 | 
			
		||||
        
 | 
			
		||||
        /// The time at which this request should reappear in the user's journal by recurrence
 | 
			
		||||
        ShowAfter : Instant
 | 
			
		||||
        ShowAfter : Instant option
 | 
			
		||||
        
 | 
			
		||||
        /// The recurrence for this request
 | 
			
		||||
        Recurrence : Recurrence
 | 
			
		||||
        
 | 
			
		||||
        /// The history entries for this request
 | 
			
		||||
        History : History list
 | 
			
		||||
        History : History[]
 | 
			
		||||
        
 | 
			
		||||
        /// The notes for this request
 | 
			
		||||
        Notes : Note list
 | 
			
		||||
        Notes : Note[]
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
/// Functions to support requests
 | 
			
		||||
@ -183,11 +183,11 @@ module Request =
 | 
			
		||||
        {   Id           = Cuid.generate () |> RequestId
 | 
			
		||||
            EnteredOn    = Instant.MinValue
 | 
			
		||||
            UserId       = UserId ""
 | 
			
		||||
            SnoozedUntil = Instant.MinValue
 | 
			
		||||
            ShowAfter    = Instant.MinValue
 | 
			
		||||
            SnoozedUntil = None
 | 
			
		||||
            ShowAfter    = None
 | 
			
		||||
            Recurrence   = Immediate
 | 
			
		||||
            History      = []
 | 
			
		||||
            Notes        = []
 | 
			
		||||
            History      = [||]
 | 
			
		||||
            Notes        = [||]
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -211,10 +211,10 @@ type JournalRequest =
 | 
			
		||||
        LastStatus : RequestAction
 | 
			
		||||
        
 | 
			
		||||
        /// The time that this request should reappear in the user's journal
 | 
			
		||||
        SnoozedUntil : Instant
 | 
			
		||||
        SnoozedUntil : Instant option
 | 
			
		||||
        
 | 
			
		||||
        /// The time after which this request should reappear in the user's journal by configured recurrence
 | 
			
		||||
        ShowAfter : Instant
 | 
			
		||||
        ShowAfter : Instant option
 | 
			
		||||
        
 | 
			
		||||
        /// The recurrence for this request
 | 
			
		||||
        Recurrence : Recurrence
 | 
			
		||||
@ -231,17 +231,37 @@ module JournalRequest =
 | 
			
		||||
 | 
			
		||||
    /// Convert a request to the form used for the journal (precomputed values, no notes or history)
 | 
			
		||||
    let ofRequestLite (req : Request) =
 | 
			
		||||
        let hist = req.History |> List.sortByDescending (fun it -> it.AsOf) |> List.tryHead
 | 
			
		||||
        let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead
 | 
			
		||||
        // Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the
 | 
			
		||||
        // larger of either the last prayed date or the "show after" date; if neither of those are filled, we will use
 | 
			
		||||
        // the last activity date. This will mean that:
 | 
			
		||||
        //  - Immediately shown requests will be at the top of the list, in order from least recently prayed to most.
 | 
			
		||||
        //  - Non-immediate requests will enter the list as if they were marked as prayed at that time; this will put
 | 
			
		||||
        //    them at the bottom of the list.
 | 
			
		||||
        //  - New requests will go to the bottom of the list, but will rise as others are marked as prayed.
 | 
			
		||||
        let lastActivity = lastHistory |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue
 | 
			
		||||
        let lastPrayed =
 | 
			
		||||
            req.History
 | 
			
		||||
            |> Array.sortByDescending (fun it -> it.AsOf)
 | 
			
		||||
            |> Array.filter History.isPrayed
 | 
			
		||||
            |> Array.tryHead
 | 
			
		||||
            |> Option.map (fun it -> it.AsOf)
 | 
			
		||||
            |> Option.defaultValue Instant.MinValue
 | 
			
		||||
        let showAfter = defaultArg req.ShowAfter Instant.MinValue
 | 
			
		||||
        let asOf =
 | 
			
		||||
            if lastPrayed > showAfter then lastPrayed
 | 
			
		||||
            elif showAfter > lastPrayed then showAfter
 | 
			
		||||
            else lastActivity
 | 
			
		||||
        {   RequestId    = req.Id
 | 
			
		||||
            UserId       = req.UserId
 | 
			
		||||
            Text         = req.History
 | 
			
		||||
                           |> List.filter (fun it -> Option.isSome it.Text)
 | 
			
		||||
                           |> List.sortByDescending (fun it -> it.AsOf)
 | 
			
		||||
                           |> List.tryHead
 | 
			
		||||
                           |> Array.filter (fun it -> Option.isSome it.Text)
 | 
			
		||||
                           |> Array.sortByDescending (fun it -> it.AsOf)
 | 
			
		||||
                           |> Array.tryHead
 | 
			
		||||
                           |> Option.map (fun h -> Option.get h.Text)
 | 
			
		||||
                           |> Option.defaultValue ""
 | 
			
		||||
            AsOf         = match hist with Some h -> h.AsOf   | None -> Instant.MinValue
 | 
			
		||||
            LastStatus   = match hist with Some h -> h.Status | None -> Created
 | 
			
		||||
            AsOf         = asOf
 | 
			
		||||
            LastStatus   = match lastHistory with Some h -> h.Status | None -> Created
 | 
			
		||||
            SnoozedUntil = req.SnoozedUntil
 | 
			
		||||
            ShowAfter    = req.ShowAfter
 | 
			
		||||
            Recurrence   = req.Recurrence
 | 
			
		||||
@ -252,6 +272,6 @@ module JournalRequest =
 | 
			
		||||
    /// Same as `ofRequestLite`, but with notes and history
 | 
			
		||||
    let ofRequestFull req =
 | 
			
		||||
        { ofRequestLite req with 
 | 
			
		||||
            History = req.History
 | 
			
		||||
            Notes   = req.Notes
 | 
			
		||||
            History = List.ofArray req.History
 | 
			
		||||
            Notes   = List.ofArray req.Notes
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
@ -2,22 +2,18 @@
 | 
			
		||||
[<RequireQualifiedAccess>]
 | 
			
		||||
module MyPrayerJournal.Handlers
 | 
			
		||||
 | 
			
		||||
// fsharplint:disable RecordFieldNames
 | 
			
		||||
 | 
			
		||||
open Giraffe
 | 
			
		||||
open Giraffe.Htmx
 | 
			
		||||
open Microsoft.AspNetCore.Authentication
 | 
			
		||||
open Microsoft.AspNetCore.Http
 | 
			
		||||
open System
 | 
			
		||||
open System.Security.Claims
 | 
			
		||||
open NodaTime
 | 
			
		||||
 | 
			
		||||
/// Helper function to be able to split out log on
 | 
			
		||||
[<AutoOpen>]
 | 
			
		||||
module private LogOnHelpers =
 | 
			
		||||
 | 
			
		||||
    open Microsoft.AspNetCore.Authentication
 | 
			
		||||
    
 | 
			
		||||
    /// Log on, optionally specifying a redirected URL once authentication is complete
 | 
			
		||||
    let logOn url : HttpHandler = fun next ctx -> backgroundTask {
 | 
			
		||||
    let logOn url : HttpHandler = fun next ctx -> task {
 | 
			
		||||
        match url with
 | 
			
		||||
        | Some it ->
 | 
			
		||||
            do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it))
 | 
			
		||||
@ -30,7 +26,6 @@ module private LogOnHelpers =
 | 
			
		||||
module Error =
 | 
			
		||||
 | 
			
		||||
    open Microsoft.Extensions.Logging
 | 
			
		||||
    open System.Threading.Tasks
 | 
			
		||||
 | 
			
		||||
    /// Handle errors
 | 
			
		||||
    let error (ex : Exception) (log : ILogger) =
 | 
			
		||||
@ -42,52 +37,59 @@ module Error =
 | 
			
		||||
 | 
			
		||||
    /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
 | 
			
		||||
    let notAuthorized : HttpHandler = fun next ctx ->
 | 
			
		||||
        (next, ctx)
 | 
			
		||||
        ||> match ctx.Request.Method with
 | 
			
		||||
            | "GET" -> logOn None
 | 
			
		||||
            | _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult<HttpContext option> None
 | 
			
		||||
        (if ctx.Request.Method = "GET" then logOn None next else setStatusCode 401 earlyReturn) ctx
 | 
			
		||||
 | 
			
		||||
    /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there
 | 
			
		||||
    let notFound : HttpHandler =
 | 
			
		||||
        setStatusCode 404 >=> text "Not found"
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
/// Handler helpers
 | 
			
		||||
[<AutoOpen>]
 | 
			
		||||
module private Helpers =
 | 
			
		||||
open System.Security.Claims
 | 
			
		||||
open LiteDB
 | 
			
		||||
open Microsoft.AspNetCore.Http
 | 
			
		||||
open NodaTime
 | 
			
		||||
 | 
			
		||||
    open LiteDB
 | 
			
		||||
    open Microsoft.Extensions.Logging
 | 
			
		||||
    open Microsoft.Net.Http.Headers
 | 
			
		||||
/// Extensions on the HTTP context
 | 
			
		||||
type HttpContext with
 | 
			
		||||
    
 | 
			
		||||
    let debug (ctx : HttpContext) message =
 | 
			
		||||
        let fac = ctx.GetService<ILoggerFactory>()
 | 
			
		||||
        let log = fac.CreateLogger "Debug"
 | 
			
		||||
        log.LogInformation message
 | 
			
		||||
    /// The LiteDB database
 | 
			
		||||
    member this.Db = this.GetService<LiteDatabase> ()
 | 
			
		||||
    
 | 
			
		||||
    /// Get the LiteDB database
 | 
			
		||||
    let db (ctx : HttpContext) = ctx.GetService<LiteDatabase>()
 | 
			
		||||
 | 
			
		||||
    /// Get the user's "sub" claim
 | 
			
		||||
    let user (ctx : HttpContext) =
 | 
			
		||||
        ctx.User
 | 
			
		||||
    /// The "sub" for the current user (None if no user is authenticated)
 | 
			
		||||
    member this.CurrentUser =
 | 
			
		||||
        this.User
 | 
			
		||||
        |> Option.ofObj
 | 
			
		||||
        |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
 | 
			
		||||
        |> Option.flatten
 | 
			
		||||
        |> Option.map (fun claim -> claim.Value)
 | 
			
		||||
    
 | 
			
		||||
    /// Get the current user's ID
 | 
			
		||||
    //  NOTE: this may raise if you don't run the request through the requiresAuthentication handler first
 | 
			
		||||
    let userId ctx =
 | 
			
		||||
        (user >> Option.get) ctx |> UserId
 | 
			
		||||
    /// The current user's ID
 | 
			
		||||
    //  NOTE: this may raise if you don't run the request through the requireUser handler first
 | 
			
		||||
    member this.UserId = UserId this.CurrentUser.Value
 | 
			
		||||
    
 | 
			
		||||
    /// Get the system clock
 | 
			
		||||
    let clock (ctx : HttpContext) =
 | 
			
		||||
        ctx.GetService<IClock> ()
 | 
			
		||||
    /// The system clock
 | 
			
		||||
    member this.Clock = this.GetService<IClock> ()
 | 
			
		||||
    
 | 
			
		||||
    /// Get the current instant
 | 
			
		||||
    let now ctx =
 | 
			
		||||
        (clock ctx).GetCurrentInstant ()
 | 
			
		||||
    /// Get the current instant from the system clock
 | 
			
		||||
    member this.Now = this.Clock.GetCurrentInstant
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
/// Handler helpers
 | 
			
		||||
[<AutoOpen>]
 | 
			
		||||
module private Helpers =
 | 
			
		||||
  
 | 
			
		||||
    open Microsoft.Extensions.Logging
 | 
			
		||||
    open Microsoft.Net.Http.Headers
 | 
			
		||||
 | 
			
		||||
    /// Require a user to be logged on
 | 
			
		||||
    let requireUser : HttpHandler =
 | 
			
		||||
        requiresAuthentication Error.notAuthorized
 | 
			
		||||
    
 | 
			
		||||
    /// Debug logger
 | 
			
		||||
    let debug (ctx : HttpContext) message =
 | 
			
		||||
        let fac = ctx.GetService<ILoggerFactory> ()
 | 
			
		||||
        let log = fac.CreateLogger "Debug"
 | 
			
		||||
        log.LogInformation message
 | 
			
		||||
 | 
			
		||||
    /// Return a 201 CREATED response
 | 
			
		||||
    let created =
 | 
			
		||||
@ -110,20 +112,20 @@ module private Helpers =
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
    open Views.Layout
 | 
			
		||||
    open System.Threading.Tasks
 | 
			
		||||
    
 | 
			
		||||
    /// Create a page rendering context
 | 
			
		||||
    let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
 | 
			
		||||
        let! hasSnoozed = backgroundTask {
 | 
			
		||||
          match user ctx with
 | 
			
		||||
          | Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx)
 | 
			
		||||
          | None   -> return  false
 | 
			
		||||
          }
 | 
			
		||||
        return {
 | 
			
		||||
          isAuthenticated = (user >> Option.isSome) ctx
 | 
			
		||||
          hasSnoozed      = hasSnoozed
 | 
			
		||||
          currentUrl      = ctx.Request.Path.Value
 | 
			
		||||
          pageTitle       = pageTitle
 | 
			
		||||
          content         = content
 | 
			
		||||
        let! hasSnoozed =
 | 
			
		||||
            match ctx.CurrentUser with
 | 
			
		||||
            | Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db
 | 
			
		||||
            | None   -> Task.FromResult false
 | 
			
		||||
        return
 | 
			
		||||
            {   IsAuthenticated = Option.isSome ctx.CurrentUser
 | 
			
		||||
                HasSnoozed      = hasSnoozed
 | 
			
		||||
                CurrentUrl      = ctx.Request.Path.Value
 | 
			
		||||
                PageTitle       = pageTitle
 | 
			
		||||
                Content         = content
 | 
			
		||||
            }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
@ -137,18 +139,18 @@ module private Helpers =
 | 
			
		||||
    module Messages =
 | 
			
		||||
 | 
			
		||||
        /// The messages being held
 | 
			
		||||
        let mutable private messages : Map<string, string * string> = Map.empty
 | 
			
		||||
        let mutable private messages : Map<UserId, string * string> = Map.empty
 | 
			
		||||
 | 
			
		||||
        /// Locked update to prevent updates by multiple threads
 | 
			
		||||
        let private upd8 = obj ()
 | 
			
		||||
 | 
			
		||||
        /// Push a new message into the list
 | 
			
		||||
        let push ctx message url = lock upd8 (fun () ->
 | 
			
		||||
          messages <- messages.Add (ctx |> (user >> Option.get), (message, url)))
 | 
			
		||||
        let push (ctx : HttpContext) message url = lock upd8 (fun () ->
 | 
			
		||||
          messages <- messages.Add (ctx.UserId, (message, url)))
 | 
			
		||||
 | 
			
		||||
        /// Add a success message header to the response
 | 
			
		||||
        let pushSuccess ctx message url =
 | 
			
		||||
          push ctx $"success|||{message}" url
 | 
			
		||||
          push ctx $"success|||%s{message}" url
 | 
			
		||||
        
 | 
			
		||||
        /// Pop the messages for the given user
 | 
			
		||||
        let pop userId = lock upd8 (fun () ->
 | 
			
		||||
@ -157,15 +159,15 @@ module private Helpers =
 | 
			
		||||
          msg)
 | 
			
		||||
 | 
			
		||||
    /// Send a partial result if this is not a full page load (does not append no-cache headers)
 | 
			
		||||
    let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> backgroundTask {
 | 
			
		||||
    let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task {
 | 
			
		||||
        let  isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
 | 
			
		||||
        let! pageCtx   = pageContext ctx pageTitle content
 | 
			
		||||
        let  view      = (match isPartial with true -> partial | false -> view) pageCtx
 | 
			
		||||
        return! 
 | 
			
		||||
            (next, ctx)
 | 
			
		||||
            ||> match user ctx with
 | 
			
		||||
                | Some u ->
 | 
			
		||||
                    match Messages.pop u with
 | 
			
		||||
            ||> match ctx.CurrentUser with
 | 
			
		||||
                | Some _ ->
 | 
			
		||||
                    match Messages.pop ctx.UserId with
 | 
			
		||||
                    | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> writeView view
 | 
			
		||||
                    | None -> writeView view
 | 
			
		||||
                | None -> writeView view
 | 
			
		||||
@ -234,35 +236,40 @@ open NodaTime.Text
 | 
			
		||||
module Components =
 | 
			
		||||
 | 
			
		||||
    // GET /components/journal-items
 | 
			
		||||
    let journalItems : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let  now   = now ctx
 | 
			
		||||
        let! jrnl  = Data.journalByUserId (userId ctx) (db ctx)
 | 
			
		||||
        let  shown = jrnl |> List.filter (fun it -> now > it.SnoozedUntil && now > it.ShowAfter)
 | 
			
		||||
    let journalItems : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let now = ctx.Now ()
 | 
			
		||||
        let shouldBeShown (req : JournalRequest) =
 | 
			
		||||
            match req.SnoozedUntil, req.ShowAfter with
 | 
			
		||||
            | None, None -> true
 | 
			
		||||
            | Some snooze, Some hide when snooze < now && hide < now -> true
 | 
			
		||||
            | Some snooze, _ when snooze < now -> true
 | 
			
		||||
            | _, Some hide when hide < now -> true
 | 
			
		||||
            | _, _ -> false
 | 
			
		||||
        let! journal = Data.journalByUserId ctx.UserId ctx.Db
 | 
			
		||||
        let  shown   = journal |> List.filter shouldBeShown
 | 
			
		||||
        return! renderComponent [ Views.Journal.journalItems now shown ] next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // GET /components/request-item/[req-id]
 | 
			
		||||
    let requestItem reqId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with
 | 
			
		||||
        | Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx
 | 
			
		||||
    let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with
 | 
			
		||||
        | Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) req ] next ctx
 | 
			
		||||
        | None     -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    // GET /components/request/[req-id]/add-notes
 | 
			
		||||
    let addNotes requestId : HttpHandler =
 | 
			
		||||
        requiresAuthentication Error.notAuthorized
 | 
			
		||||
        >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
 | 
			
		||||
        requireUser >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
 | 
			
		||||
 | 
			
		||||
    // GET /components/request/[req-id]/notes
 | 
			
		||||
    let notes requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx)
 | 
			
		||||
        return! renderComponent (Views.Request.notes (now ctx) notes) next ctx
 | 
			
		||||
    let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db
 | 
			
		||||
        return! renderComponent (Views.Request.notes (ctx.Now ()) (List.ofArray notes)) next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // GET /components/request/[req-id]/snooze
 | 
			
		||||
    let snooze requestId : HttpHandler =
 | 
			
		||||
        requiresAuthentication Error.notAuthorized
 | 
			
		||||
        >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
 | 
			
		||||
        requireUser >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ]
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
/// / URL    
 | 
			
		||||
@ -277,7 +284,7 @@ module Home =
 | 
			
		||||
module Journal =
 | 
			
		||||
  
 | 
			
		||||
    // GET /journal
 | 
			
		||||
    let journal : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
    let journal : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let usr =
 | 
			
		||||
            ctx.User.Claims
 | 
			
		||||
            |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
 | 
			
		||||
@ -304,7 +311,7 @@ module Legal =
 | 
			
		||||
module Request =
 | 
			
		||||
 | 
			
		||||
    // GET /request/[req-id]/edit  
 | 
			
		||||
    let edit requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
    let edit requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let returnTo =
 | 
			
		||||
            match ctx.Request.Headers.Referer[0] with
 | 
			
		||||
            | it when it.EndsWith "/active"  -> "active"
 | 
			
		||||
@ -315,7 +322,7 @@ module Request =
 | 
			
		||||
            return! partial "Add Prayer Request"
 | 
			
		||||
                        (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
 | 
			
		||||
        | _     ->
 | 
			
		||||
            match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
 | 
			
		||||
            match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with
 | 
			
		||||
            | Some req ->
 | 
			
		||||
                debug ctx "Found - sending view"
 | 
			
		||||
                return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
 | 
			
		||||
@ -325,92 +332,93 @@ module Request =
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    // PATCH /request/[req-id]/prayed
 | 
			
		||||
    let prayed requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let db    = db     ctx
 | 
			
		||||
        let usrId = userId ctx
 | 
			
		||||
    let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let db     = ctx.Db
 | 
			
		||||
        let userId = ctx.UserId
 | 
			
		||||
        let reqId  = RequestId.ofString requestId
 | 
			
		||||
        match! Data.tryRequestById reqId usrId db with
 | 
			
		||||
        match! Data.tryRequestById reqId userId db with
 | 
			
		||||
        | Some req ->
 | 
			
		||||
            let now  = now ctx
 | 
			
		||||
            do! Data.addHistory reqId usrId { AsOf = now; Status = Prayed; Text = None } db
 | 
			
		||||
            let now  = ctx.Now ()
 | 
			
		||||
            do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db
 | 
			
		||||
            let nextShow =
 | 
			
		||||
                match Recurrence.duration req.Recurrence with
 | 
			
		||||
                | 0L       -> Instant.MinValue
 | 
			
		||||
                | duration -> now.Plus (Duration.FromSeconds duration)
 | 
			
		||||
            do! Data.updateShowAfter reqId usrId nextShow db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
                | 0L       -> None
 | 
			
		||||
                | duration -> Some <| now.Plus (Duration.FromSeconds duration)
 | 
			
		||||
            do! Data.updateShowAfter reqId userId nextShow db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
 | 
			
		||||
        | None -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    /// POST /request/[req-id]/note
 | 
			
		||||
    let addNote requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let db    = db     ctx
 | 
			
		||||
        let usrId = userId ctx
 | 
			
		||||
    let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let db     = ctx.Db
 | 
			
		||||
        let userId = ctx.UserId
 | 
			
		||||
        let reqId  = RequestId.ofString requestId
 | 
			
		||||
        match! Data.tryRequestById reqId usrId db with
 | 
			
		||||
        match! Data.tryRequestById reqId userId db with
 | 
			
		||||
        | Some _ ->
 | 
			
		||||
            let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
 | 
			
		||||
            do! Data.addNote reqId usrId { AsOf = now ctx; Notes = notes.notes } db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
            do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
 | 
			
		||||
        | None -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
          
 | 
			
		||||
    // GET /requests/active
 | 
			
		||||
    let active : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let! reqs = Data.journalByUserId (userId ctx) (db ctx)
 | 
			
		||||
        return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx
 | 
			
		||||
    let active : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! reqs = Data.journalByUserId ctx.UserId ctx.Db
 | 
			
		||||
        return! partial "Active Requests" (Views.Request.active (ctx.Now ()) reqs) next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // GET /requests/snoozed
 | 
			
		||||
    let snoozed : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let! reqs    = Data.journalByUserId (userId ctx) (db ctx)
 | 
			
		||||
        let  now     = now ctx
 | 
			
		||||
        let  snoozed = reqs |> List.filter (fun it -> it.SnoozedUntil > now)
 | 
			
		||||
        return! partial "Active Requests" (Views.Request.snoozed now snoozed) next ctx
 | 
			
		||||
    let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! reqs    = Data.journalByUserId ctx.UserId ctx.Db
 | 
			
		||||
        let  now     = ctx.Now ()
 | 
			
		||||
        let  snoozed = reqs
 | 
			
		||||
                       |> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
 | 
			
		||||
        return! partial "Snoozed Requests" (Views.Request.snoozed now snoozed) next ctx
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    // GET /requests/answered
 | 
			
		||||
    let answered : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let! reqs = Data.answeredRequests (userId ctx) (db ctx)
 | 
			
		||||
        return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx
 | 
			
		||||
    let answered : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! reqs = Data.answeredRequests ctx.UserId ctx.Db
 | 
			
		||||
        return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) reqs) next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // GET /request/[req-id]/full
 | 
			
		||||
    let getFull requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with
 | 
			
		||||
        | Some req -> return! partial "Prayer Request" (Views.Request.full (clock ctx) req) next ctx
 | 
			
		||||
    let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with
 | 
			
		||||
        | Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock req) next ctx
 | 
			
		||||
        | None     -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // PATCH /request/[req-id]/show
 | 
			
		||||
    let show requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let db    = db     ctx
 | 
			
		||||
        let usrId = userId ctx
 | 
			
		||||
    let show requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let db     = ctx.Db
 | 
			
		||||
        let userId = ctx.UserId
 | 
			
		||||
        let reqId  = RequestId.ofString requestId
 | 
			
		||||
        match! Data.tryRequestById reqId usrId db with
 | 
			
		||||
        match! Data.tryRequestById reqId userId db with
 | 
			
		||||
        | Some _ ->
 | 
			
		||||
            do! Data.updateShowAfter reqId usrId Instant.MinValue db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
            do! Data.updateShowAfter reqId userId None db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
 | 
			
		||||
        | None -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // PATCH /request/[req-id]/snooze
 | 
			
		||||
    let snooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let db    = db     ctx
 | 
			
		||||
        let usrId = userId ctx
 | 
			
		||||
    let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let db     = ctx.Db
 | 
			
		||||
        let userId = ctx.UserId
 | 
			
		||||
        let reqId  = RequestId.ofString requestId
 | 
			
		||||
        match! Data.tryRequestById reqId usrId db with
 | 
			
		||||
        match! Data.tryRequestById reqId userId db with
 | 
			
		||||
        | Some _ ->
 | 
			
		||||
            let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
 | 
			
		||||
            let date =
 | 
			
		||||
                LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
 | 
			
		||||
                    .AtStartOfDayInZone(DateTimeZone.Utc)
 | 
			
		||||
                    .ToInstant ()
 | 
			
		||||
            do! Data.updateSnoozed reqId usrId date db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
            do! Data.updateSnoozed reqId userId (Some date) db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            return!
 | 
			
		||||
                (withSuccessMessage $"Request snoozed until {until.until}"
 | 
			
		||||
                 >=> hideModal "snooze"
 | 
			
		||||
@ -419,14 +427,14 @@ module Request =
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // PATCH /request/[req-id]/cancel-snooze
 | 
			
		||||
    let cancelSnooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
        let db    = db     ctx
 | 
			
		||||
        let usrId = userId ctx
 | 
			
		||||
    let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let db     = ctx.Db
 | 
			
		||||
        let userId = ctx.UserId
 | 
			
		||||
        let reqId  = RequestId.ofString requestId
 | 
			
		||||
        match! Data.tryRequestById reqId usrId db with
 | 
			
		||||
        match! Data.tryRequestById reqId userId db with
 | 
			
		||||
        | Some _ ->
 | 
			
		||||
            do! Data.updateSnoozed reqId usrId Instant.MinValue db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
            do! Data.updateSnoozed reqId userId None db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
 | 
			
		||||
        | None -> return! Error.notFound next ctx
 | 
			
		||||
    }
 | 
			
		||||
@ -437,52 +445,52 @@ module Request =
 | 
			
		||||
        |> Recurrence.ofString
 | 
			
		||||
 | 
			
		||||
    // POST /request
 | 
			
		||||
    let add : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
    let add : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! form   = ctx.BindModelAsync<Models.Request> ()
 | 
			
		||||
        let  db    = db ctx
 | 
			
		||||
        let  usrId = userId ctx
 | 
			
		||||
        let  now   = now ctx
 | 
			
		||||
        let  db     = ctx.Db
 | 
			
		||||
        let  userId = ctx.UserId
 | 
			
		||||
        let  now    = ctx.Now ()
 | 
			
		||||
        let  req    =
 | 
			
		||||
            { Request.empty with
 | 
			
		||||
                UserId     = usrId
 | 
			
		||||
                UserId     = userId
 | 
			
		||||
                EnteredOn  = now
 | 
			
		||||
                ShowAfter  = Instant.MinValue
 | 
			
		||||
                ShowAfter  = None
 | 
			
		||||
                Recurrence = parseRecurrence form
 | 
			
		||||
                History    = [
 | 
			
		||||
                History    = [|
 | 
			
		||||
                    {   AsOf   = now
 | 
			
		||||
                        Status = Created
 | 
			
		||||
                        Text   = Some form.requestText
 | 
			
		||||
                    }      
 | 
			
		||||
                ]
 | 
			
		||||
                |]
 | 
			
		||||
            }
 | 
			
		||||
        Data.addRequest req db
 | 
			
		||||
        do! db.saveChanges ()
 | 
			
		||||
        do! db.SaveChanges ()
 | 
			
		||||
        Messages.pushSuccess ctx "Added prayer request" "/journal"
 | 
			
		||||
        return! seeOther "/journal" next ctx
 | 
			
		||||
    }
 | 
			
		||||
  
 | 
			
		||||
    // PATCH /request
 | 
			
		||||
    let update : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
 | 
			
		||||
    let update : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        let! form   = ctx.BindModelAsync<Models.Request> ()
 | 
			
		||||
        let  db    = db ctx
 | 
			
		||||
        let  usrId = userId ctx
 | 
			
		||||
        match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with
 | 
			
		||||
        let  db     = ctx.Db
 | 
			
		||||
        let  userId = ctx.UserId
 | 
			
		||||
        match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with
 | 
			
		||||
        | Some req ->
 | 
			
		||||
            // update recurrence if changed
 | 
			
		||||
            let recur = parseRecurrence form
 | 
			
		||||
            match recur = req.Recurrence with
 | 
			
		||||
            | true  -> ()
 | 
			
		||||
            | false ->
 | 
			
		||||
                do! Data.updateRecurrence req.RequestId usrId recur db
 | 
			
		||||
                do! Data.updateRecurrence req.RequestId userId recur db
 | 
			
		||||
                match recur with
 | 
			
		||||
                | Immediate -> do! Data.updateShowAfter req.RequestId usrId Instant.MinValue db
 | 
			
		||||
                | Immediate -> do! Data.updateShowAfter req.RequestId userId None db
 | 
			
		||||
                | _         -> ()
 | 
			
		||||
            // append history
 | 
			
		||||
            let upd8Text = form.requestText.Trim ()
 | 
			
		||||
            let text     = match upd8Text = req.Text with true -> None | false -> Some upd8Text
 | 
			
		||||
            do! Data.addHistory req.RequestId usrId
 | 
			
		||||
                    { AsOf = now ctx; Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
 | 
			
		||||
            do! db.saveChanges ()
 | 
			
		||||
            let text     = if upd8Text = req.Text then None else Some upd8Text
 | 
			
		||||
            do! Data.addHistory req.RequestId userId
 | 
			
		||||
                    { AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db
 | 
			
		||||
            do! db.SaveChanges ()
 | 
			
		||||
            let nextUrl =
 | 
			
		||||
                match form.returnTo with
 | 
			
		||||
                | "active"          -> "/requests/active"
 | 
			
		||||
@ -497,6 +505,7 @@ module Request =
 | 
			
		||||
/// Handlers for /user URLs
 | 
			
		||||
module User =
 | 
			
		||||
 | 
			
		||||
    open Microsoft.AspNetCore.Authentication
 | 
			
		||||
    open Microsoft.AspNetCore.Authentication.Cookies
 | 
			
		||||
 | 
			
		||||
    // GET /user/log-on
 | 
			
		||||
@ -504,7 +513,7 @@ module User =
 | 
			
		||||
        logOn (Some "/journal")
 | 
			
		||||
  
 | 
			
		||||
    // GET /user/log-off
 | 
			
		||||
    let logOff : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> task {
 | 
			
		||||
    let logOff : HttpHandler = requireUser >=> fun next ctx -> task {
 | 
			
		||||
        do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/"))
 | 
			
		||||
        do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
 | 
			
		||||
        return! next ctx
 | 
			
		||||
 | 
			
		||||
@ -47,9 +47,7 @@ module Configure =
 | 
			
		||||
 | 
			
		||||
    /// Configure logging
 | 
			
		||||
    let logging (bldr : WebApplicationBuilder) =
 | 
			
		||||
    match bldr.Environment.IsDevelopment () with
 | 
			
		||||
    | true -> ()
 | 
			
		||||
    | false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
 | 
			
		||||
        if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
 | 
			
		||||
        bldr.Logging.AddConsole().AddDebug() |> ignore
 | 
			
		||||
        bldr
 | 
			
		||||
 | 
			
		||||
@ -74,25 +72,23 @@ module Configure =
 | 
			
		||||
            | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
 | 
			
		||||
            | _, _ -> ()
 | 
			
		||||
 | 
			
		||||
    bldr.Services
 | 
			
		||||
      .AddRouting()
 | 
			
		||||
      .AddGiraffe()
 | 
			
		||||
      .AddSingleton<IClock>(SystemClock.Instance)
 | 
			
		||||
      .Configure<CookiePolicyOptions>(
 | 
			
		||||
        fun (opts : CookiePolicyOptions) ->
 | 
			
		||||
        let _ = bldr.Services.AddRouting ()
 | 
			
		||||
        let _ = bldr.Services.AddGiraffe ()
 | 
			
		||||
        let _ = bldr.Services.AddSingleton<IClock>(SystemClock.Instance)
 | 
			
		||||
        
 | 
			
		||||
        let _ =
 | 
			
		||||
            bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
 | 
			
		||||
                opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
 | 
			
		||||
                opts.OnAppendCookie        <- fun ctx -> sameSite ctx.CookieOptions
 | 
			
		||||
                opts.OnDeleteCookie        <- fun ctx -> sameSite ctx.CookieOptions)
 | 
			
		||||
      .AddAuthentication(
 | 
			
		||||
        // Use HTTP "Bearer" authentication with JWTs
 | 
			
		||||
        fun opts ->
 | 
			
		||||
        let _ =
 | 
			
		||||
            bldr.Services.AddAuthentication(fun opts ->
 | 
			
		||||
                opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
 | 
			
		||||
                opts.DefaultSignInScheme       <- CookieAuthenticationDefaults.AuthenticationScheme
 | 
			
		||||
                opts.DefaultChallengeScheme    <- CookieAuthenticationDefaults.AuthenticationScheme)
 | 
			
		||||
                .AddCookie()
 | 
			
		||||
      .AddOpenIdConnect("Auth0",
 | 
			
		||||
                .AddOpenIdConnect("Auth0", fun opts ->
 | 
			
		||||
                    // Configure OIDC with Auth0 options from configuration
 | 
			
		||||
        fun opts ->
 | 
			
		||||
                    let cfg = bldr.Configuration.GetSection "Auth0"
 | 
			
		||||
                    opts.Authority    <- $"""https://{cfg["Domain"]}/"""
 | 
			
		||||
                    opts.ClientId     <- cfg["Id"]
 | 
			
		||||
@ -123,24 +119,22 @@ module Configure =
 | 
			
		||||
                                Uri.EscapeDataString $"&returnTo={finalRedirUri}"
 | 
			
		||||
                        ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
 | 
			
		||||
                        ctx.HandleResponse ()
 | 
			
		||||
 | 
			
		||||
                        Task.CompletedTask
 | 
			
		||||
                    opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
 | 
			
		||||
                        let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
 | 
			
		||||
                        bldr.Scheme <- cfg["Scheme"]
 | 
			
		||||
                        bldr.Port   <- int cfg["Port"]
 | 
			
		||||
                        ctx.ProtocolMessage.RedirectUri <- string bldr
 | 
			
		||||
            Task.CompletedTask
 | 
			
		||||
          )
 | 
			
		||||
    |> ignore
 | 
			
		||||
                        Task.CompletedTask)
 | 
			
		||||
        
 | 
			
		||||
        let jsonOptions = JsonSerializerOptions ()
 | 
			
		||||
        jsonOptions.Converters.Add (JsonFSharpConverter ())
 | 
			
		||||
        let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
 | 
			
		||||
        Data.Startup.ensureDb db
 | 
			
		||||
    bldr.Services.AddSingleton(jsonOptions)
 | 
			
		||||
      .AddSingleton<Json.ISerializer, SystemTextJson.Serializer>()
 | 
			
		||||
      .AddSingleton<LiteDatabase> db
 | 
			
		||||
    |> ignore
 | 
			
		||||
        let _ = bldr.Services.AddSingleton jsonOptions
 | 
			
		||||
        let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
 | 
			
		||||
        let _ = bldr.Services.AddSingleton<LiteDatabase> db
 | 
			
		||||
        
 | 
			
		||||
        bldr.Build ()
 | 
			
		||||
  
 | 
			
		||||
 | 
			
		||||
@ -148,18 +142,12 @@ module Configure =
 | 
			
		||||
 | 
			
		||||
    /// Configure the web application
 | 
			
		||||
    let application (app : WebApplication) =
 | 
			
		||||
    // match app.Environment.IsDevelopment () with
 | 
			
		||||
    // | true -> app.UseDeveloperExceptionPage ()
 | 
			
		||||
    // | false -> app.UseGiraffeErrorHandler Handlers.Error.error
 | 
			
		||||
    // |> ignore
 | 
			
		||||
    app
 | 
			
		||||
      .UseStaticFiles()
 | 
			
		||||
      .UseCookiePolicy()
 | 
			
		||||
      .UseRouting()
 | 
			
		||||
      .UseAuthentication()
 | 
			
		||||
      .UseGiraffeErrorHandler(Handlers.Error.error)
 | 
			
		||||
      .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
 | 
			
		||||
    |> ignore
 | 
			
		||||
        let _ = app.UseStaticFiles ()
 | 
			
		||||
        let _ = app.UseCookiePolicy ()
 | 
			
		||||
        let _ = app.UseRouting ()
 | 
			
		||||
        let _ = app.UseAuthentication ()
 | 
			
		||||
        let _ = app.UseGiraffeErrorHandler Handlers.Error.error
 | 
			
		||||
        let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
 | 
			
		||||
        app
 | 
			
		||||
 | 
			
		||||
    /// Compose all the configurations into one
 | 
			
		||||
 | 
			
		||||
@ -1,27 +1,25 @@
 | 
			
		||||
/// Layout / home views
 | 
			
		||||
module MyPrayerJournal.Views.Layout
 | 
			
		||||
 | 
			
		||||
// fsharplint:disable RecordFieldNames
 | 
			
		||||
 | 
			
		||||
open Giraffe.ViewEngine
 | 
			
		||||
open Giraffe.ViewEngine.Accessibility
 | 
			
		||||
 | 
			
		||||
/// The data needed to render a page-level view
 | 
			
		||||
type PageRenderContext =
 | 
			
		||||
    {   /// Whether the user is authenticated
 | 
			
		||||
        isAuthenticated : bool
 | 
			
		||||
        IsAuthenticated : bool
 | 
			
		||||
        
 | 
			
		||||
        /// Whether the user has snoozed requests
 | 
			
		||||
        hasSnoozed      : bool
 | 
			
		||||
        HasSnoozed      : bool
 | 
			
		||||
        
 | 
			
		||||
        /// The current URL
 | 
			
		||||
        currentUrl      : string
 | 
			
		||||
        CurrentUrl      : string
 | 
			
		||||
        
 | 
			
		||||
        /// The title for the page to be rendered
 | 
			
		||||
        pageTitle       : string
 | 
			
		||||
        PageTitle       : string
 | 
			
		||||
        
 | 
			
		||||
        /// The content of the page
 | 
			
		||||
        content         : XmlNode
 | 
			
		||||
        Content         : XmlNode
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
/// The home page
 | 
			
		||||
@ -51,12 +49,12 @@ let private navBar ctx =
 | 
			
		||||
            ]
 | 
			
		||||
            seq {
 | 
			
		||||
                let navLink (matchUrl : string) =
 | 
			
		||||
                    match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
 | 
			
		||||
                    match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
 | 
			
		||||
                    |> pageLink matchUrl
 | 
			
		||||
                if ctx.isAuthenticated then
 | 
			
		||||
                if ctx.IsAuthenticated then
 | 
			
		||||
                    li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
 | 
			
		||||
                    li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ]
 | 
			
		||||
                    if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ]
 | 
			
		||||
                    if ctx.HasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ]
 | 
			
		||||
                    li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
 | 
			
		||||
                    li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
 | 
			
		||||
                else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
 | 
			
		||||
@ -71,7 +69,7 @@ let private navBar ctx =
 | 
			
		||||
 | 
			
		||||
/// The title tag with the application name appended
 | 
			
		||||
let titleTag ctx =
 | 
			
		||||
    title [] [ str ctx.pageTitle; rawText " « myPrayerJournal" ]
 | 
			
		||||
    title [] [ str ctx.PageTitle; rawText " « myPrayerJournal" ]
 | 
			
		||||
 | 
			
		||||
/// The HTML `head` element
 | 
			
		||||
let htmlHead ctx =
 | 
			
		||||
@ -136,7 +134,7 @@ let view ctx =
 | 
			
		||||
    html [ _lang "en" ] [
 | 
			
		||||
        htmlHead ctx
 | 
			
		||||
        body [] [
 | 
			
		||||
            section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
 | 
			
		||||
            section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
 | 
			
		||||
            toaster
 | 
			
		||||
            htmlFoot
 | 
			
		||||
        ]
 | 
			
		||||
@ -146,5 +144,5 @@ let view ctx =
 | 
			
		||||
let partial ctx =
 | 
			
		||||
    html [ _lang "en" ] [
 | 
			
		||||
        head [] [ titleTag ctx ]
 | 
			
		||||
        body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
 | 
			
		||||
        body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
 | 
			
		||||
    ]
 | 
			
		||||
 | 
			
		||||
@ -8,10 +8,11 @@ open NodaTime
 | 
			
		||||
 | 
			
		||||
/// Create a request within the list
 | 
			
		||||
let reqListItem now req =
 | 
			
		||||
    let isFuture instant = defaultArg (instant |> Option.map (fun it -> it > now)) false
 | 
			
		||||
    let reqId      = RequestId.toString req.RequestId
 | 
			
		||||
    let isAnswered = req.LastStatus = Answered
 | 
			
		||||
    let isSnoozed  = req.SnoozedUntil > now
 | 
			
		||||
    let isPending  = (not isSnoozed) && req.ShowAfter > now
 | 
			
		||||
    let isSnoozed  = isFuture req.SnoozedUntil
 | 
			
		||||
    let isPending  = (not isSnoozed) && isFuture req.ShowAfter
 | 
			
		||||
    let btnClass   = _class "btn btn-light mx-2"
 | 
			
		||||
    let restoreBtn (link : string) title =
 | 
			
		||||
        button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
 | 
			
		||||
@ -27,8 +28,8 @@ let reqListItem now req =
 | 
			
		||||
            if isSnoozed || isPending || isAnswered then
 | 
			
		||||
                br []
 | 
			
		||||
                small [ _class "text-muted" ] [
 | 
			
		||||
                    if   isSnoozed then   [ str "Snooze expires ";       relativeDate req.SnoozedUntil now ]
 | 
			
		||||
                    elif isPending then   [ str "Request appears next "; relativeDate req.ShowAfter    now ]
 | 
			
		||||
                    if   isSnoozed then   [ str "Snooze expires ";       relativeDate req.SnoozedUntil.Value now ]
 | 
			
		||||
                    elif isPending then   [ str "Request appears next "; relativeDate req.ShowAfter.Value    now ]
 | 
			
		||||
                    else (* isAnswered *) [ str "Answered ";             relativeDate req.AsOf               now ]
 | 
			
		||||
                    |> em []
 | 
			
		||||
                ]
 | 
			
		||||
@ -56,7 +57,7 @@ let answered now reqs =
 | 
			
		||||
    article [ _class "container mt-3" ] [
 | 
			
		||||
        h2 [ _class "pb-3" ] [ str "Answered Requests" ]
 | 
			
		||||
        if List.isEmpty reqs then
 | 
			
		||||
            noResults "No Active Requests" "/journal" "Return to your journal" [
 | 
			
		||||
            noResults "No Answered Requests" "/journal" "Return to your journal" [
 | 
			
		||||
                str "Your prayer journal has no answered requests; once you have marked one as "
 | 
			
		||||
                rawText "“Answered”, it will appear here"
 | 
			
		||||
            ]
 | 
			
		||||
@ -75,29 +76,30 @@ let full (clock : IClock) (req : Request) =
 | 
			
		||||
    let now = clock.GetCurrentInstant ()
 | 
			
		||||
    let answered =
 | 
			
		||||
        req.History
 | 
			
		||||
        |> List.filter History.isAnswered
 | 
			
		||||
        |> List.tryHead
 | 
			
		||||
        |> Array.filter History.isAnswered
 | 
			
		||||
        |> Array.tryHead
 | 
			
		||||
        |> Option.map (fun x -> x.AsOf)
 | 
			
		||||
    let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0"
 | 
			
		||||
    let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0"
 | 
			
		||||
    let daysOpen =
 | 
			
		||||
        let asOf = defaultArg answered now
 | 
			
		||||
        ((asOf - (req.History |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0"
 | 
			
		||||
        ((asOf - (req.History |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0"
 | 
			
		||||
    let lastText =
 | 
			
		||||
        req.History
 | 
			
		||||
        |> List.filter (fun h -> Option.isSome h.Text)
 | 
			
		||||
        |> List.sortByDescending (fun h -> h.AsOf)
 | 
			
		||||
        |> List.map (fun h -> Option.get h.Text)
 | 
			
		||||
        |> List.head
 | 
			
		||||
        |> Array.filter (fun h -> Option.isSome h.Text)
 | 
			
		||||
        |> Array.sortByDescending (fun h -> h.AsOf)
 | 
			
		||||
        |> Array.map (fun h -> Option.get h.Text)
 | 
			
		||||
        |> Array.head
 | 
			
		||||
    // The history log including notes (and excluding the final entry for answered requests)
 | 
			
		||||
    let log =
 | 
			
		||||
        let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |}
 | 
			
		||||
        let all =
 | 
			
		||||
            req.Notes
 | 
			
		||||
            |> List.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
 | 
			
		||||
            |> List.append (req.History |> List.map toDisp)
 | 
			
		||||
            |> List.sortByDescending (fun it -> it.asOf)
 | 
			
		||||
            |> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
 | 
			
		||||
            |> Array.append (req.History |> Array.map toDisp)
 | 
			
		||||
            |> Array.sortByDescending (fun it -> it.asOf)
 | 
			
		||||
            |> List.ofArray
 | 
			
		||||
        // Skip the first entry for answered requests; that info is already displayed
 | 
			
		||||
        match answered with Some _ -> all |> List.skip 1 | None -> all
 | 
			
		||||
        match answered with Some _ -> all.Tail | None -> all
 | 
			
		||||
    article [ _class "container mt-3" ] [
 | 
			
		||||
        div [_class "card" ] [
 | 
			
		||||
            h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
 | 
			
		||||
@ -111,7 +113,7 @@ let full (clock : IClock) (req : Request) =
 | 
			
		||||
                        relativeDate date now
 | 
			
		||||
                        rawText ") • "
 | 
			
		||||
                    | None -> ()
 | 
			
		||||
                    sprintf "Prayed %s times • Open %s days" prayed daysOpen |> rawText
 | 
			
		||||
                    rawText $"Prayed %s{prayed} times • Open %s{daysOpen} days"
 | 
			
		||||
                ]
 | 
			
		||||
                p [ _class "card-text" ] [ str lastText ]
 | 
			
		||||
            ]
 | 
			
		||||
 | 
			
		||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user