Version 3.1 #71

Merged
danieljsummers merged 9 commits from v3.1 into main 2022-07-30 21:02:58 +00:00
10 changed files with 1519 additions and 1490 deletions
Showing only changes of commit 0d86bad7c5 - Show all commits

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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