Reformat source files

This commit is contained in:
Daniel J. Summers 2022-07-29 20:20:18 -04:00
parent 1901bab14e
commit 0d86bad7c5
10 changed files with 1519 additions and 1490 deletions

View File

@ -3,27 +3,57 @@ open NodaTime
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type OldRequest = { type OldRequest =
/// The ID of the request { /// The ID of the request
id : RequestId id : RequestId
/// The time this request was initially entered /// The time this request was initially entered
enteredOn : Instant enteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT) /// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice /// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : Instant snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence /// The time at which this request should reappear in the user's journal by recurrence
showAfter : Instant showAfter : Instant
/// The type of recurrence for this request /// The type of recurrence for this request
recurType : string recurType : string
/// How many of the recurrence intervals should occur between appearances in the journal /// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16 recurCount : int16
/// The history entries for this request /// The history entries for this request
history : History array history : History array
/// The notes for this request /// The notes for this request
notes : Note array notes : Note array
} }
/// The old definition of the history entry
[<CLIMutable; NoComparison; NoEquality>]
type OldHistory =
{ /// The time when this history entry was made
asOf : Instant
/// The status for this history entry
status : RequestAction
/// The text of the update, if applicable
text : string option
}
/// The old definition of of the note entry
[<CLIMutable; NoComparison; NoEquality>]
type OldNote =
{ /// The time when this note was made
asOf : Instant
/// The text of the notes
notes : string
}
open LiteDB open LiteDB
open MyPrayerJournal.Data open MyPrayerJournal.Data
@ -39,8 +69,8 @@ let mapRecurrence old =
| _ -> Immediate | _ -> Immediate
/// Map the old request to the new request /// Map the old request to the new request
let convert old = { let convert old =
id = old.id { id = old.id
enteredOn = old.enteredOn enteredOn = old.enteredOn
userId = old.userId userId = old.userId
snoozedUntil = old.snoozedUntil snoozedUntil = old.snoozedUntil
@ -56,12 +86,9 @@ let replace (req : Request) =
db.requests.Insert(req) |> ignore db.requests.Insert(req) |> ignore
db.Checkpoint() db.Checkpoint()
let reqs = db.GetCollection<OldRequest>("request").FindAll() db.GetCollection<OldRequest>("request").FindAll()
let rList = reqs |> Seq.toList |> Seq.map convert
let mapped = rList |> List.map convert |> Seq.iter replace
//let reqList = mapped |> List.ofSeq
mapped |> List.iter replace
// For more information see https://aka.ms/fsharp-console-apps // For more information see https://aka.ms/fsharp-console-apps
printfn "Done" printfn "Done"

View File

@ -13,9 +13,11 @@ module Extensions =
/// Extensions on the LiteDatabase class /// Extensions on the LiteDatabase class
type LiteDatabase with type LiteDatabase with
/// The Request collection /// The Request collection
member this.requests member this.requests
with get () = this.GetCollection<Request> "request" with get () = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log) /// Async version of the checkpoint command (flushes log)
member this.saveChanges () = member this.saveChanges () =
this.Checkpoint () this.Checkpoint ()

View File

@ -9,36 +9,42 @@ open Cuid
open NodaTime open NodaTime
/// An identifier for a request /// An identifier for a request
type RequestId = type RequestId = RequestId of Cuid
| RequestId of Cuid
/// Functions to manipulate request IDs /// Functions to manipulate request IDs
module RequestId = module RequestId =
/// The string representation of the request ID /// The string representation of the request ID
let toString = function RequestId x -> Cuid.toString x let toString = function RequestId x -> Cuid.toString x
/// Create a request ID from a string representation /// Create a request ID from a string representation
let ofString = Cuid >> RequestId let ofString = Cuid >> RequestId
/// The identifier of a user (the "sub" part of the JWT) /// The identifier of a user (the "sub" part of the JWT)
type UserId = type UserId = UserId of string
| UserId of string
/// Functions to manipulate user IDs /// Functions to manipulate user IDs
module UserId = module UserId =
/// The string representation of the user ID /// The string representation of the user ID
let toString = function UserId x -> x let toString = function UserId x -> x
/// How frequently a request should reappear after it is marked "Prayed" /// How frequently a request should reappear after it is marked "Prayed"
type Recurrence = type Recurrence =
/// A request should reappear immediately at the bottom of the list
| Immediate | Immediate
/// A request should reappear in the given number of hours
| Hours of int16 | Hours of int16
/// A request should reappear in the given number of days
| Days of int16 | Days of int16
/// A request should reappear in the given number of weeks (7-day increments)
| Weeks of int16 | Weeks of int16
/// Functions to manipulate recurrences /// Functions to manipulate recurrences
module Recurrence = module Recurrence =
/// Create a string representation of a recurrence /// Create a string representation of a recurrence
let toString = let toString =
function function
@ -46,6 +52,7 @@ module Recurrence =
| Hours h -> $"{h} Hours" | Hours h -> $"{h} Hours"
| Days d -> $"{d} Days" | Days d -> $"{d} Days"
| Weeks w -> $"{w} Weeks" | Weeks w -> $"{w} Weeks"
/// Create a recurrence value from a string /// Create a recurrence value from a string
let ofString = let ofString =
function function
@ -59,8 +66,10 @@ module Recurrence =
| "Weeks" -> Weeks length | "Weeks" -> Weeks length
| _ -> invalidOp $"{parts[1]} is not a valid recurrence" | _ -> invalidOp $"{parts[1]} is not a valid recurrence"
| it -> invalidOp $"{it} is not a valid recurrence" | it -> invalidOp $"{it} is not a valid recurrence"
/// An hour's worth of seconds /// An hour's worth of seconds
let private oneHour = 3_600L let private oneHour = 3_600L
/// The duration of the recurrence (in milliseconds) /// The duration of the recurrence (in milliseconds)
let duration = let duration =
function function
@ -80,47 +89,62 @@ type RequestAction =
/// History is a record of action taken on a prayer request, including updates to its text /// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type History = { type History =
/// The time when this history entry was made { /// The time when this history entry was made
asOf : Instant asOf : Instant
/// The status for this history entry /// The status for this history entry
status : RequestAction status : RequestAction
/// The text of the update, if applicable /// The text of the update, if applicable
text : string option text : string option
} }
/// Note is a note regarding a prayer request that does not result in an update to its text /// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Note = { type Note =
/// The time when this note was made { /// The time when this note was made
asOf : Instant asOf : Instant
/// The text of the notes /// The text of the notes
notes : string notes : string
} }
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = { type Request =
/// The ID of the request { /// The ID of the request
id : RequestId id : RequestId
/// The time this request was initially entered /// The time this request was initially entered
enteredOn : Instant enteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT) /// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice /// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : Instant snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence /// The time at which this request should reappear in the user's journal by recurrence
showAfter : Instant showAfter : Instant
/// The recurrence for this request /// The recurrence for this request
recurrence : Recurrence recurrence : Recurrence
/// The history entries for this request /// The history entries for this request
history : History list history : History list
/// The notes for this request /// The notes for this request
notes : Note list notes : Note list
} }
with
/// Functions to support requests
module Request =
/// An empty request /// An empty request
static member empty = let empty =
{ id = Cuid.generate () |> RequestId { id = Cuid.generate () |> RequestId
enteredOn = Instant.MinValue enteredOn = Instant.MinValue
userId = UserId "" userId = UserId ""
@ -131,28 +155,38 @@ with
notes = [] notes = []
} }
/// JournalRequest is the form of a prayer request returned for the request journal display. It also contains /// JournalRequest is the form of a prayer request returned for the request journal display. It also contains
/// properties that may be filled for history and notes. /// properties that may be filled for history and notes.
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type JournalRequest = { type JournalRequest =
/// The ID of the request (just the CUID part) { /// The ID of the request (just the CUID part)
requestId : RequestId requestId : RequestId
/// The ID of the user to whom the request belongs /// The ID of the user to whom the request belongs
userId : UserId userId : UserId
/// The current text of the request /// The current text of the request
text : string text : string
/// The last time action was taken on the request /// The last time action was taken on the request
asOf : Instant asOf : Instant
/// The last status for the request /// The last status for the request
lastStatus : RequestAction lastStatus : RequestAction
/// The time that this request should reappear in the user's journal /// The time that this request should reappear in the user's journal
snoozedUntil : Instant snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence /// The time after which this request should reappear in the user's journal by configured recurrence
showAfter : Instant showAfter : Instant
/// The recurrence for this request /// The recurrence for this request
recurrence : Recurrence recurrence : Recurrence
/// History entries for the request /// History entries for the request
history : History list history : History list
/// Note entries for the request /// Note entries for the request
notes : Note list notes : Note list
} }
@ -190,6 +224,7 @@ module JournalRequest =
/// Functions to manipulate request actions /// Functions to manipulate request actions
module RequestAction = module RequestAction =
/// Create a string representation of an action /// Create a string representation of an action
let toString = let toString =
function function
@ -197,6 +232,7 @@ module RequestAction =
| Prayed -> "Prayed" | Prayed -> "Prayed"
| Updated -> "Updated" | Updated -> "Updated"
| Answered -> "Answered" | Answered -> "Answered"
/// Create a RequestAction from a string /// Create a RequestAction from a string
let ofString = let ofString =
function function
@ -205,9 +241,12 @@ module RequestAction =
| "Updated" -> Updated | "Updated" -> Updated
| "Answered" -> Answered | "Answered" -> Answered
| it -> invalidOp $"Bad request action {it}" | it -> invalidOp $"Bad request action {it}"
/// Determine if a history's status is `Created` /// Determine if a history's status is `Created`
let isCreated hist = hist.status = Created let isCreated hist = hist.status = Created
/// Determine if a history's status is `Prayed` /// Determine if a history's status is `Prayed`
let isPrayed hist = hist.status = Prayed let isPrayed hist = hist.status = Prayed
/// Determine if a history's status is `Answered` /// Determine if a history's status is `Answered`
let isAnswered hist = hist.status = Answered let isAnswered hist = hist.status = Answered

View File

@ -17,8 +17,7 @@ open NodaTime
module private LogOnHelpers = module private LogOnHelpers =
/// Log on, optionally specifying a redirected URL once authentication is complete /// Log on, optionally specifying a redirected URL once authentication is complete
let logOn url : HttpHandler = let logOn url : HttpHandler = fun next ctx -> backgroundTask {
fun next ctx -> backgroundTask {
match url with match url with
| Some it -> | Some it ->
do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it))
@ -26,6 +25,7 @@ module private LogOnHelpers =
| None -> return! challenge "Auth0" next ctx | None -> return! challenge "Auth0" next ctx
} }
/// Handlers for error conditions /// Handlers for error conditions
module Error = module Error =
@ -41,8 +41,7 @@ module Error =
>=> text ex.Message >=> text ex.Message
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = let notAuthorized : HttpHandler = fun next ctx ->
fun next ctx ->
(next, ctx) (next, ctx)
||> match ctx.Request.Method with ||> match ctx.Request.Method with
| "GET" -> logOn None | "GET" -> logOn None
@ -95,10 +94,9 @@ module private Helpers =
setStatusCode 201 setStatusCode 201
/// Return a 201 CREATED response with the location header set for the created resource /// Return a 201 CREATED response with the location header set for the created resource
let createdAt url : HttpHandler = let createdAt url : HttpHandler = fun next ctx ->
fun next ctx -> Successful.CREATED
($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location ($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location) next ctx
>=> created) next ctx
/// Return a 303 SEE OTHER response (forces a GET on the redirected URL) /// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
let seeOther (url : string) = let seeOther (url : string) =
@ -130,11 +128,11 @@ module private Helpers =
} }
/// Composable handler to write a view to the output /// Composable handler to write a view to the output
let writeView view : HttpHandler = let writeView view : HttpHandler = fun _ ctx -> backgroundTask {
fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlViewAsync view return! ctx.WriteHtmlViewAsync view
} }
/// Hold messages across redirects /// Hold messages across redirects
module Messages = module Messages =
@ -159,8 +157,7 @@ module private Helpers =
msg) msg)
/// Send a partial result if this is not a full page load (does not append no-cache headers) /// Send a partial result if this is not a full page load (does not append no-cache headers)
let partialStatic (pageTitle : string) content : HttpHandler = let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> backgroundTask {
fun next ctx -> backgroundTask {
let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let! pageCtx = pageContext ctx pageTitle content let! pageCtx = pageContext ctx pageTitle content
let view = (match isPartial with true -> partial | false -> view) pageCtx let view = (match isPartial with true -> partial | false -> view) pageCtx
@ -192,34 +189,40 @@ module Models =
/// An additional note /// An additional note
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type NoteEntry = { type NoteEntry =
/// The notes being added { /// The notes being added
notes : string notes : string
} }
/// A prayer request /// A prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = { type Request =
/// The ID of the request { /// The ID of the request
requestId : string requestId : string
/// Where to redirect after saving /// Where to redirect after saving
returnTo : string returnTo : string
/// The text of the request /// The text of the request
requestText : string requestText : string
/// The additional status to record /// The additional status to record
status : string option status : string option
/// The recurrence type /// The recurrence type
recurType : string recurType : string
/// The recurrence count /// The recurrence count
recurCount : int16 option recurCount : int16 option
/// The recurrence interval /// The recurrence interval
recurInterval : string option recurInterval : string option
} }
/// The date until which a request should not appear in the journal /// The date until which a request should not appear in the journal
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type SnoozeUntil = { type SnoozeUntil =
/// The date (YYYY-MM-DD) at which the request should reappear { /// The date (YYYY-MM-DD) at which the request should reappear
until : string until : string
} }
@ -231,9 +234,7 @@ open NodaTime.Text
module Components = module Components =
// GET /components/journal-items // GET /components/journal-items
let journalItems : HttpHandler = let journalItems : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let now = now ctx let now = now ctx
let! jrnl = Data.journalByUserId (userId ctx) (db ctx) let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
let shown = jrnl |> List.filter (fun it -> now > it.snoozedUntil && now > it.showAfter) let shown = jrnl |> List.filter (fun it -> now > it.snoozedUntil && now > it.showAfter)
@ -241,9 +242,7 @@ module Components =
} }
// GET /components/request-item/[req-id] // GET /components/request-item/[req-id]
let requestItem reqId : HttpHandler = let requestItem reqId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with
| Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx | Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -255,9 +254,7 @@ module Components =
>=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId)) >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
// GET /components/request/[req-id]/notes // GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = let notes requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx)
return! renderComponent (Views.Request.notes (now ctx) notes) next ctx return! renderComponent (Views.Request.notes (now ctx) notes) next ctx
} }
@ -280,9 +277,7 @@ module Home =
module Journal = module Journal =
// GET /journal // GET /journal
let journal : HttpHandler = let journal : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let usr = let usr =
ctx.User.Claims ctx.User.Claims
|> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName) |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName)
@ -309,11 +304,9 @@ module Legal =
module Request = module Request =
// GET /request/[req-id]/edit // GET /request/[req-id]/edit
let edit requestId : HttpHandler = let edit requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let returnTo = let returnTo =
match ctx.Request.Headers.Referer.[0] with match ctx.Request.Headers.Referer[0] with
| it when it.EndsWith "/active" -> "active" | it when it.EndsWith "/active" -> "active"
| it when it.EndsWith "/snoozed" -> "snoozed" | it when it.EndsWith "/snoozed" -> "snoozed"
| _ -> "journal" | _ -> "journal"
@ -332,9 +325,7 @@ module Request =
} }
// PATCH /request/[req-id]/prayed // PATCH /request/[req-id]/prayed
let prayed requestId : HttpHandler = let prayed requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
@ -353,9 +344,7 @@ module Request =
} }
/// POST /request/[req-id]/note /// POST /request/[req-id]/note
let addNote requestId : HttpHandler = let addNote requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
@ -369,17 +358,13 @@ module Request =
} }
// GET /requests/active // GET /requests/active
let active : HttpHandler = let active : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx
} }
// GET /requests/snoozed // GET /requests/snoozed
let snoozed : HttpHandler = let snoozed : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
let now = now ctx let now = now ctx
let snoozed = reqs |> List.filter (fun it -> it.snoozedUntil > now) let snoozed = reqs |> List.filter (fun it -> it.snoozedUntil > now)
@ -387,35 +372,20 @@ module Request =
} }
// GET /requests/answered // GET /requests/answered
let answered : HttpHandler = let answered : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! reqs = Data.answeredRequests (userId ctx) (db ctx) let! reqs = Data.answeredRequests (userId ctx) (db ctx)
return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx
} }
// GET /api/request/[req-id]
let get requestId : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! json req next ctx
| None -> return! Error.notFound next ctx
}
// GET /request/[req-id]/full // GET /request/[req-id]/full
let getFull requestId : HttpHandler = let getFull requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with 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 | Some req -> return! partial "Prayer Request" (Views.Request.full (clock ctx) req) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/show // PATCH /request/[req-id]/show
let show requestId : HttpHandler = let show requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
@ -428,9 +398,7 @@ module Request =
} }
// PATCH /request/[req-id]/snooze // PATCH /request/[req-id]/snooze
let snooze requestId : HttpHandler = let snooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
@ -451,9 +419,7 @@ module Request =
} }
// PATCH /request/[req-id]/cancel-snooze // PATCH /request/[req-id]/cancel-snooze
let cancelSnooze requestId : HttpHandler = let cancelSnooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
@ -471,9 +437,7 @@ module Request =
|> Recurrence.ofString |> Recurrence.ofString
// POST /request // POST /request
let add : HttpHandler = let add : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
@ -498,9 +462,7 @@ module Request =
} }
// PATCH /request // PATCH /request
let update : HttpHandler = let update : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
@ -542,9 +504,7 @@ module User =
logOn (Some "/journal") logOn (Some "/journal")
// GET /user/log-off // GET /user/log-off
let logOff : HttpHandler = let logOff : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> task {
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> task {
do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/")) do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/"))
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
return! next ctx return! next ctx
@ -554,8 +514,8 @@ module User =
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// The routes for myPrayerJournal /// The routes for myPrayerJournal
let routes = let routes = [
[ GET_HEAD [ route "/" Home.home ] GET_HEAD [ route "/" Home.home ]
subRoute "/components/" [ subRoute "/components/" [
GET_HEAD [ GET_HEAD [
route "journal-items" Components.journalItems route "journal-items" Components.journalItems

View File

@ -15,34 +15,34 @@ let journalCard now req =
div [ _class "card-header p-0 d-flex"; _roleToolBar ] [ div [ _class "card-header p-0 d-flex"; _roleToolBar ] [
pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ] pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ]
spacer spacer
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_title "Add Notes" _title "Add Notes"
_data "bs-toggle" "modal" _data "bs-toggle" "modal"
_data "bs-target" "#notesModal" _data "bs-target" "#notesModal"
_hxGet $"/components/request/{reqId}/add-notes" _hxGet $"/components/request/{reqId}/add-notes"
_hxTarget "#notesBody" _hxTarget "#notesBody"
_hxSwap HxSwap.InnerHtml _hxSwap HxSwap.InnerHtml ] [
] [ icon "comment" ] icon "comment"
]
spacer spacer
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_title "Snooze Request" _title "Snooze Request"
_data "bs-toggle" "modal" _data "bs-toggle" "modal"
_data "bs-target" "#snoozeModal" _data "bs-target" "#snoozeModal"
_hxGet $"/components/request/{reqId}/snooze" _hxGet $"/components/request/{reqId}/snooze"
_hxTarget "#snoozeBody" _hxTarget "#snoozeBody"
_hxSwap HxSwap.InnerHtml _hxSwap HxSwap.InnerHtml ] [
] [ icon "schedule" ] icon "schedule"
]
div [ _class "flex-grow-1" ] [] div [ _class "flex-grow-1" ] []
button [ button [ _type "button"
_type "button"
_class "btn btn-success w-25" _class "btn btn-success w-25"
_hxPatch $"/request/{reqId}/prayed" _hxPatch $"/request/{reqId}/prayed"
_title "Mark as Prayed" _title "Mark as Prayed" ] [
] [ icon "done" ] icon "done"
]
] ]
div [ _class "card-body" ] [ div [ _class "card-body" ] [
p [ _class "request-text" ] [ str req.text ] p [ _class "request-text" ] [ str req.text ]
@ -54,7 +54,8 @@ let journalCard now req =
] ]
/// The journal loading page /// The journal loading page
let journal user = article [ _class "container-fluid mt-3" ] [ let journal user =
article [ _class "container-fluid mt-3" ] [
h2 [ _class "pb-3" ] [ h2 [ _class "pb-3" ] [
str user str user
match user with "Your" -> () | _ -> rawText "&rsquo;s" match user with "Your" -> () | _ -> rawText "&rsquo;s"
@ -66,13 +67,11 @@ let journal user = article [ _class "container-fluid mt-3" ] [
p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [ p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
rawText "Loading your prayer journal&hellip;" rawText "Loading your prayer journal&hellip;"
] ]
div [ div [ _id "notesModal"
_id "notesModal"
_class "modal fade" _class "modal fade"
_tabindex "-1" _tabindex "-1"
_ariaLabelledBy "nodesModalLabel" _ariaLabelledBy "nodesModalLabel"
_ariaHidden "true" _ariaHidden "true" ] [
] [
div [ _class "modal-dialog modal-dialog-scrollable" ] [ div [ _class "modal-dialog modal-dialog-scrollable" ] [
div [ _class "modal-content" ] [ div [ _class "modal-content" ] [
div [ _class "modal-header" ] [ div [ _class "modal-header" ] [
@ -81,20 +80,21 @@ let journal user = article [ _class "container-fluid mt-3" ] [
] ]
div [ _class "modal-body"; _id "notesBody" ] [ ] div [ _class "modal-body"; _id "notesBody" ] [ ]
div [ _class "modal-footer" ] [ div [ _class "modal-footer" ] [
button [ _type "button"; _id "notesDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ button [ _type "button"
_id "notesDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close" str "Close"
] ]
] ]
] ]
] ]
] ]
div [ div [ _id "snoozeModal"
_id "snoozeModal"
_class "modal fade" _class "modal fade"
_tabindex "-1" _tabindex "-1"
_ariaLabelledBy "snoozeModalLabel" _ariaLabelledBy "snoozeModalLabel"
_ariaHidden "true" _ariaHidden "true" ] [
] [
div [ _class "modal-dialog modal-sm" ] [ div [ _class "modal-dialog modal-sm" ] [
div [ _class "modal-content" ] [ div [ _class "modal-content" ] [
div [ _class "modal-header" ] [ div [ _class "modal-header" ] [
@ -103,7 +103,10 @@ let journal user = article [ _class "container-fluid mt-3" ] [
] ]
div [ _class "modal-body"; _id "snoozeBody" ] [ ] div [ _class "modal-body"; _id "snoozeBody" ] [ ]
div [ _class "modal-footer" ] [ div [ _class "modal-footer" ] [
button [ _type "button"; _id "snoozeDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ button [ _type "button"
_id "snoozeDismiss"
_class "btn btn-secondary"
_data "bs-dismiss" "modal" ] [
str "Close" str "Close"
] ]
] ]
@ -123,26 +126,22 @@ let journalItems now items =
| false -> | false ->
items items
|> List.map (journalCard now) |> List.map (journalCard now)
|> section [ |> section [ _id "journalItems"
_id "journalItems"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
_hxTarget "this" _hxTarget "this"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml ]
]
/// The notes edit modal body /// The notes edit modal body
let notesEdit requestId = let notesEdit requestId =
let reqId = RequestId.toString requestId let reqId = RequestId.toString requestId
[ form [ _hxPost $"/request/{reqId}/note" ] [ [ form [ _hxPost $"/request/{reqId}/note" ] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
textarea [ textarea [ _id "notes"
_id "notes"
_name "notes" _name "notes"
_class "form-control" _class "form-control"
_style "min-height: 8rem;" _style "min-height: 8rem;"
_placeholder "Notes" _placeholder "Notes"
_autofocus; _required _autofocus; _required ] [ ]
] [ ]
label [ _for "notes" ] [ str "Notes" ] label [ _for "notes" ] [ str "Notes" ]
] ]
p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ] p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ]
@ -150,13 +149,13 @@ let notesEdit requestId =
hr [ _style "margin: .5rem -1rem" ] hr [ _style "margin: .5rem -1rem" ]
div [ _id "priorNotes" ] [ div [ _id "priorNotes" ] [
p [ _class "text-center pt-3" ] [ p [ _class "text-center pt-3" ] [
button [ button [ _type "button"
_type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_hxGet $"/components/request/{reqId}/notes" _hxGet $"/components/request/{reqId}/notes"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml
_hxTarget "#priorNotes" _hxTarget "#priorNotes" ] [
] [str "Load Prior Notes" ] str "Load Prior Notes"
]
] ]
] ]
] ]
@ -164,11 +163,9 @@ let notesEdit requestId =
/// The snooze edit form /// The snooze edit form
let snooze requestId = let snooze requestId =
let today = System.DateTime.Today.ToString "yyyy-MM-dd" let today = System.DateTime.Today.ToString "yyyy-MM-dd"
form [ form [ _hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxTarget "#journalItems" _hxTarget "#journalItems"
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml ] [
] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ] input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
label [ _for "until" ] [ str "Until" ] label [ _for "until" ] [ str "Until" ]

View File

@ -7,31 +7,36 @@ open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
/// The data needed to render a page-level view /// The data needed to render a page-level view
type PageRenderContext = { type PageRenderContext =
/// Whether the user is authenticated { /// Whether the user is authenticated
isAuthenticated : bool isAuthenticated : bool
/// Whether the user has snoozed requests /// Whether the user has snoozed requests
hasSnoozed : bool hasSnoozed : bool
/// The current URL /// The current URL
currentUrl : string currentUrl : string
/// The title for the page to be rendered /// The title for the page to be rendered
pageTitle : string pageTitle : string
/// The content of the page /// The content of the page
content : XmlNode content : XmlNode
} }
/// The home page /// The home page
let home = article [ _class "container mt-3" ] [ let home =
article [ _class "container mt-3" ] [
p [] [ rawText "&nbsp;" ] p [] [ rawText "&nbsp;" ]
p [] [ p [] [
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for " str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "them, update them as God moves in the situation, and record a final answer received on that request. It also " str "prayed for them, update them as God moves in the situation, and record a final answer received on "
str "allows individuals to review their answered prayers." str "that request. It also allows individuals to review their answered prayers."
] ]
p [] [ p [] [
str "This site is open and available to the general public. To get started, simply click the " str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can also " rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "learn more about the site at the &ldquo;Docs&rdquo; link, also above." rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
] ]
] ]
@ -48,14 +53,13 @@ let private navBar ctx =
let navLink (matchUrl : string) = 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 |> pageLink matchUrl
match ctx.isAuthenticated with if ctx.isAuthenticated then
| true ->
li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] 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" ] [ navLink "/requests/answered" [ str "Answered" ] ]
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
| false -> li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
li [ _class "nav-item" ] [ li [ _class "nav-item" ] [
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ] a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
] ]
@ -66,7 +70,8 @@ let private navBar ctx =
] ]
/// The title tag with the application name appended /// The title tag with the application name appended
let titleTag ctx = title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ] let titleTag ctx =
title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element /// The HTML `head` element
let htmlHead ctx = let htmlHead ctx =
@ -74,12 +79,10 @@ let htmlHead ctx =
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx titleTag ctx
link [ link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
_href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
_rel "stylesheet" _rel "stylesheet"
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" _integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
_crossorigin "anonymous" _crossorigin "anonymous" ]
]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ] link [ _href "/style/style.css"; _rel "stylesheet" ]
] ]
@ -106,7 +109,9 @@ let htmlFoot =
str "Developed" str "Developed"
] ]
str " and hosted by " str " and hosted by "
a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [ str "Bit Badger Solutions" ] a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [
str "Bit Badger Solutions"
]
] ]
] ]
] ]
@ -114,12 +119,10 @@ let htmlFoot =
script [] [ script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')" rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
] ]
script [ script [ _async
_async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" _src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" _integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
_crossorigin "anonymous" _crossorigin "anonymous" ] []
] []
script [] [ script [] [
rawText "setTimeout(function () { " rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') " rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
@ -133,7 +136,7 @@ let view ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [
htmlHead ctx htmlHead ctx
body [] [ body [] [
section [ _id "top" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
toaster toaster
htmlFoot htmlFoot
] ]

View File

@ -4,23 +4,26 @@ module MyPrayerJournal.Views.Legal
open Giraffe.ViewEngine open Giraffe.ViewEngine
/// View for the "Privacy Policy" page /// View for the "Privacy Policy" page
let privacyPolicy = article [ _class "container mt-3" ] [ let privacyPolicy =
article [ _class "container mt-3" ] [
h2 [ _class "mb-2" ] [ str "Privacy Policy" ] h2 [ _class "mb-2" ] [ str "Privacy Policy" ]
h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ] h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ]
p [] [ p [] [
str "The nature of the service is one where privacy is a must. The items below will help you understand the data " str "The nature of the service is one where privacy is a must. The items below will help you understand "
str "we collect, access, and store on your behalf as you use this service." str "the data we collect, access, and store on your behalf as you use this service."
] ]
div [ _class "card" ] [ div [ _class "card" ] [
div [ _class "list-group list-group-flush" ] [ div [ _class "list-group list-group-flush" ] [
div [ _class "list-group-item"] [ div [ _class "list-group-item"] [
h3 [] [ str "Third Party Services" ] h3 [] [ str "Third Party Services" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should familiarize " str "myPrayerJournal utilizes a third-party authentication and identity provider. You should "
str "yourself with the privacy policy for " str "familiarize yourself with the privacy policy for "
a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ] a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ]
str ", as well as your chosen provider (" str ", as well as your chosen provider ("
a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [ str "Microsoft"] a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [
str "Microsoft"
]
str " or " str " or "
a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ] a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ]
str ")." str ")."
@ -31,22 +34,23 @@ let privacyPolicy = article [ _class "container mt-3" ] [
h4 [] [ str "Identifying Data" ] h4 [] [ str "Identifying Data" ]
ul [] [ ul [] [
li [] [ li [] [
rawText "The only identifying data myPrayerJournal stores is the subscriber (&ldquo;sub&rdquo;) field from " str "The only identifying data myPrayerJournal stores is the subscriber "
str "the token we receive from Auth0, once you have signed in through their hosted service. All " rawText "(&ldquo;sub&rdquo;) field from the token we receive from Auth0, once you have "
str "information is associated with you via this field." str "signed in through their hosted service. All information is associated with you via "
str "this field."
] ]
li [] [ li [] [
str "While you are signed in, within your browser, the service has access to your first and last names, " str "While you are signed in, within your browser, the service has access to your first "
str "along with a URL to the profile picture (provided by your selected identity provider). This " str "and last names, along with a URL to the profile picture (provided by your selected "
rawText "information is not transmitted to the server, and is removed when &ldquo;Log Off&rdquo; is " str "identity provider). This information is not transmitted to the server, and is removed "
str "clicked." rawText "when &ldquo;Log Off&rdquo; is clicked."
] ]
] ]
h4 [] [ str "User Provided Data" ] h4 [] [ str "User Provided Data" ]
ul [ _class "mb-0" ] [ ul [ _class "mb-0" ] [
li [] [ li [] [
str "myPrayerJournal stores the information you provide, including the text of prayer requests, updates, " str "myPrayerJournal stores the information you provide, including the text of prayer "
str "and notes; and the date/time when certain actions are taken." str "requests, updates, and notes; and the date/time when certain actions are taken."
] ]
] ]
] ]
@ -54,35 +58,38 @@ let privacyPolicy = article [ _class "container mt-3" ] [
h3 [] [ str "How Your Data Is Accessed / Secured" ] h3 [] [ str "How Your Data Is Accessed / Secured" ]
ul [ _class "mb-0" ] [ ul [ _class "mb-0" ] [
li [] [ li [] [
str "Your provided data is returned to you, as required, to display your journal or your answered " str "Your provided data is returned to you, as required, to display your journal or your "
str "requests. On the server, it is stored in a controlled-access database." str "answered requests. On the server, it is stored in a controlled-access database."
] ]
li [] [ li [] [
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; " str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a "
str "backups are preserved for the prior 7 days, and backups from the 1" str "rolling manner; backups are preserved for the prior 7 days, and backups from the 1"
sup [] [ str "st" ] sup [] [ str "st" ]
str " and 15" str " and 15"
sup [] [ str "th" ] sup [] [ str "th" ]
str " are preserved for 3 months. These backups are stored in a private cloud data repository." str " are preserved for 3 months. These backups are stored in a private cloud data "
str "repository."
] ]
li [] [ li [] [
str "The data collected and stored is the absolute minimum necessary for the functionality of the service. " str "The data collected and stored is the absolute minimum necessary for the functionality "
rawText "There are no plans to &ldquo;monetize&rdquo; this service, and storing the minimum amount of " rawText "of the service. There are no plans to &ldquo;monetize&rdquo; this service, and "
str "information means that the data we have is not interesting to purchasers (or those who may have more " str "storing the minimum amount of information means that the data we have is not "
str "nefarious purposes)." str "interesting to purchasers (or those who may have more nefarious purposes)."
] ]
li [] [ li [] [
str "Access to servers and backups is strictly controlled and monitored for unauthorized access attempts." str "Access to servers and backups is strictly controlled and monitored for unauthorized "
str "access attempts."
] ]
] ]
] ]
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "Removing Your Data" ] h3 [] [ str "Removing Your Data" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google provide ways " str "At any time, you may choose to discontinue using this service. Both Microsoft and Google "
str "to revoke access from this application. However, if you want your data removed from the database, " str "provide ways to revoke access from this application. However, if you want your data "
str "please contact daniel at bitbadger.solutions (via e-mail, replacing at with @) prior to doing so, to " str "removed from the database, please contact daniel at bitbadger.solutions (via e-mail, "
str "ensure we can determine which subscriber ID belongs to you." str "replacing at with @) prior to doing so, to ensure we can determine which subscriber ID "
str "belongs to you."
] ]
] ]
] ]
@ -90,7 +97,8 @@ let privacyPolicy = article [ _class "container mt-3" ] [
] ]
/// View for the "Terms of Service" page /// View for the "Terms of Service" page
let termsOfService = article [ _class "container mt-3" ] [ let termsOfService =
article [ _class "container mt-3" ] [
h2 [ _class "mb-2" ] [ str "Terms of Service" ] h2 [ _class "mb-2" ] [ str "Terms of Service" ]
h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ] h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ]
div [ _class "card" ] [ div [ _class "card" ] [
@ -98,17 +106,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "1. Acceptance of Terms" ] h3 [] [ str "1. Acceptance of Terms" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you " str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, "
str "are responsible to ensure that your use of this site complies with all applicable laws. Your continued " str "and that you are responsible to ensure that your use of this site complies with all "
str "use of this site implies your acceptance of these terms." str "applicable laws. Your continued use of this site implies your acceptance of these terms."
] ]
] ]
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "2. Description of Service and Registration" ] h3 [] [ str "2. Description of Service and Registration" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer requests. It " str "myPrayerJournal is a service that allows individuals to enter and amend their prayer "
str "requires no registration by itself, but access is granted based on a successful login with an external " str "requests. It requires no registration by itself, but access is granted based on a "
str "identity provider. See " str "successful login with an external identity provider. See "
pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ] pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
str " for details on how that information is accessed and stored." str " for details on how that information is accessed and stored."
] ]
@ -116,11 +124,13 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "3. Third Party Services" ] h3 [] [ str "3. Third Party Services" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "This service utilizes a third-party service provider for identity management. Review the terms of " str "This service utilizes a third-party service provider for identity management. Review the "
str "service for " str "terms of service for "
a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"] a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"]
str ", as well as those for the selected authorization provider (" str ", as well as those for the selected authorization provider ("
a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [ str "Microsoft"] a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [
str "Microsoft"
]
str " or " str " or "
a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ] a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ]
str ")." str ")."
@ -129,17 +139,17 @@ let termsOfService = article [ _class "container mt-3" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "4. Liability" ] h3 [] [ str "4. Liability" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) exists. The " rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) "
str "service and its developers may not be held liable for any damages that may arise through the use of " str "exists. The service and its developers may not be held liable for any damages that may "
str "this service." str "arise through the use of this service."
] ]
] ]
div [ _class "list-group-item" ] [ div [ _class "list-group-item" ] [
h3 [] [ str "5. Updates to Terms" ] h3 [] [ str "5. Updates to Terms" ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
str "These terms and conditions may be updated at any time, and this service does not have the capability to " str "These terms and conditions may be updated at any time, and this service does not have the "
str "notify users when these change. The date at the top of the page will be updated when any of the text of " str "capability to notify users when these change. The date at the top of the page will be "
str "these terms is updated." str "updated when any of the text of these terms is updated."
] ]
] ]
] ]
@ -150,4 +160,3 @@ let termsOfService = article [ _class "container mt-3" ] [
str " to learn how we handle your data." str " to learn how we handle your data."
] ]
] ]

View File

@ -15,28 +15,23 @@ let reqListItem now req =
let btnClass = _class "btn btn-light mx-2" let btnClass = _class "btn btn-light mx-2"
let restoreBtn (link : string) title = let restoreBtn (link : string) title =
button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ] button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [ div [ _class "list-group-item px-0 d-flex flex-row align-items-start"
_hxTarget "this"
_hxSwap HxSwap.OuterHtml ] [
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
| true -> () if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze"
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ] elif isPending then restoreBtn "show" "Show Now"
match true with
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isPending -> restoreBtn "show" "Show Now"
| _ -> ()
p [ _class "request-text mb-0" ] [ p [ _class "request-text mb-0" ] [
str req.text str req.text
match isSnoozed || isPending || isAnswered with if isSnoozed || isPending || isAnswered then
| true ->
br [] br []
small [ _class "text-muted" ] [ small [ _class "text-muted" ] [
match () with if isSnoozed then [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ] elif isPending then [ str "Request appears next "; relativeDate req.showAfter now ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ] else (* isAnswered *) [ str "Answered "; relativeDate req.asOf now ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em [] |> em []
] ]
| false -> ()
] ]
] ]
@ -47,29 +42,30 @@ let reqList now reqs =
|> div [ _class "list-group" ] |> div [ _class "list-group" ]
/// View for Active Requests page /// View for Active Requests page
let active now reqs = article [ _class "container mt-3" ] [ let active now reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Active Requests" ] h2 [ _class "pb-3" ] [ str "Active Requests" ]
match reqs |> List.isEmpty with if List.isEmpty reqs then
| true ->
noResults "No Active Requests" "/journal" "Return to your journal" noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ] [ str "Your prayer journal has no active requests" ]
| false -> reqList now reqs else reqList now reqs
] ]
/// View for Answered Requests page /// View for Answered Requests page
let answered now reqs = article [ _class "container mt-3" ] [ let answered now reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Answered Requests" ] h2 [ _class "pb-3" ] [ str "Answered Requests" ]
match reqs |> List.isEmpty with if List.isEmpty reqs then
| true ->
noResults "No Active Requests" "/journal" "Return to your journal" [ noResults "No Active Requests" "/journal" "Return to your journal" [
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, " str "Your prayer journal has no answered requests; once you have marked one as "
str "it will appear here" rawText "&ldquo;Answered&rdquo;, it will appear here"
] ]
| false -> reqList now reqs else reqList now reqs
] ]
/// View for Snoozed Requests page /// View for Snoozed Requests page
let snoozed now reqs = article [ _class "container mt-3" ] [ let snoozed now reqs =
article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Snoozed Requests" ] h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
reqList now reqs reqList now reqs
] ]
@ -120,7 +116,8 @@ let full (clock : IClock) (req : Request) =
p [ _class "card-text" ] [ str lastText ] p [ _class "card-text" ] [ str lastText ]
] ]
log log
|> List.map (fun it -> li [ _class "list-group-item" ] [ |> List.map (fun it ->
li [ _class "list-group-item" ] [
p [ _class "m-0" ] [ p [ _class "m-0" ] [
str it.status str it.status
rawText "&nbsp; " rawText "&nbsp; "
@ -151,38 +148,35 @@ let edit (req : JournalRequest) returnTo isNew =
|> Option.defaultValue "" |> Option.defaultValue ""
article [ _class "container" ] [ article [ _class "container" ] [
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ] h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
form [ form [ _hxBoost
_hxBoost
_hxTarget "#top" _hxTarget "#top"
_hxPushUrl _hxPushUrl
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch "/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
] [ input [ _type "hidden"
input [
_type "hidden"
_name "requestId" _name "requestId"
_value (match isNew with true -> "new" | false -> RequestId.toString req.requestId) _value (match isNew with true -> "new" | false -> RequestId.toString req.requestId) ]
]
input [ _type "hidden"; _name "returnTo"; _value returnTo ] input [ _type "hidden"; _name "returnTo"; _value returnTo ]
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
textarea [ textarea [ _id "requestText"
_id "requestText"
_name "requestText" _name "requestText"
_class "form-control" _class "form-control"
_style "min-height: 8rem;" _style "min-height: 8rem;"
_placeholder "Enter the text of the request" _placeholder "Enter the text of the request"
_autofocus; _required _autofocus; _required ] [ str req.text ]
] [ str req.text ]
label [ _for "requestText" ] [ str "Prayer Request" ] label [ _for "requestText" ] [ str "Prayer Request" ]
] ]
br [] br []
match isNew with if not isNew then
| true -> ()
| false ->
div [ _class "pb-3" ] [ div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ] label [] [ str "Also Mark As" ]
br [] br []
div [ _class "form-check form-check-inline" ] [ div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sU"; _name "status"; _value "Updated"; _checked ] input [ _type "radio"
_class "form-check-input"
_id "sU"
_name "status"
_value "Updated"
_checked ]
label [ _for "sU" ] [ str "Updated" ] label [ _for "sU" ] [ str "Updated" ]
] ]
div [ _class "form-check form-check-inline" ] [ div [ _class "form-check form-check-inline" ] [
@ -202,32 +196,27 @@ let edit (req : JournalRequest) returnTo isNew =
] ]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [ div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [ div [ _class "form-check mx-2" ] [
input [ input [ _type "radio"
_type "radio"
_class "form-check-input" _class "form-check-input"
_id "rI" _id "rI"
_name "recurType" _name "recurType"
_value "Immediate" _value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)" _onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> _checked | _ -> () match req.recurrence with Immediate -> _checked | _ -> () ]
]
label [ _for "rI" ] [ str "Immediately" ] label [ _for "rI" ] [ str "Immediately" ]
] ]
div [ _class "form-check mx-2"] [ div [ _class "form-check mx-2"] [
input [ input [ _type "radio"
_type "radio"
_class "form-check-input" _class "form-check-input"
_id "rO" _id "rO"
_name "recurType" _name "recurType"
_value "Other" _value "Other"
_onclick "mpj.edit.toggleRecurrence(event)" _onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> () | _ -> _checked match req.recurrence with Immediate -> () | _ -> _checked ]
]
label [ _for "rO" ] [ rawText "Every&hellip;" ] label [ _for "rO" ] [ rawText "Every&hellip;" ]
] ]
div [ _class "form-floating mx-2"] [ div [ _class "form-floating mx-2"] [
input [ input [ _type "number"
_type "number"
_class "form-control" _class "form-control"
_id "recurCount" _id "recurCount"
_name "recurCount" _name "recurCount"
@ -235,22 +224,25 @@ let edit (req : JournalRequest) returnTo isNew =
_value recurCount _value recurCount
_style "width:6rem;" _style "width:6rem;"
_required _required
match req.recurrence with Immediate -> _disabled | _ -> () match req.recurrence with Immediate -> _disabled | _ -> () ]
]
label [ _for "recurCount" ] [ str "Count" ] label [ _for "recurCount" ] [ str "Count" ]
] ]
div [ _class "form-floating mx-2" ] [ div [ _class "form-floating mx-2" ] [
select [ select [ _class "form-control"
_class "form-control"
_id "recurInterval" _id "recurInterval"
_name "recurInterval" _name "recurInterval"
_style "width:6rem;" _style "width:6rem;"
_required _required
match req.recurrence with Immediate -> _disabled | _ -> () match req.recurrence with Immediate -> _disabled | _ -> () ] [
] [ option [ _value "Hours"; match req.recurrence with Hours _ -> _selected | _ -> () ] [
option [ _value "Hours"; match req.recurrence with Hours _ -> _selected | _ -> () ] [ str "hours" ] str "hours"
option [ _value "Days"; match req.recurrence with Days _ -> _selected | _ -> () ] [ str "days" ] ]
option [ _value "Weeks"; match req.recurrence with Weeks _ -> _selected | _ -> () ] [ str "weeks" ] option [ _value "Days"; match req.recurrence with Days _ -> _selected | _ -> () ] [
str "days"
]
option [ _value "Weeks"; match req.recurrence with Weeks _ -> _selected | _ -> () ] [
str "weeks"
]
] ]
label [ _form "recurInterval" ] [ str "Interval" ] label [ _form "recurInterval" ] [ str "Interval" ]
] ]