bit-badger/myPrayerJournal
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 36 Activity

Finish recurrent model change

Browse Source 
Also fix IDE warnings, update to htmx 1.6.1
This commit is contained in:
Daniel J. Summers 2022-01-08 12:05:10 -05:00
parent d153a29b7e
commit ed4bb64ca5
9 changed files with 68 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/MyPrayerJournal/Data.fs
View File

@ -1,8 +1,8 @@
module MyPrayerJournal.Data
open LiteDB
open MyPrayerJournal
open NodaTime
open System
open System.Threading.Tasks
// fsharplint:disable MemberNames
@ -36,7 +36,12 @@ module Mapping =
module Option =
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
/// Mapping for Recurrence
module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction
module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
@ -52,65 +57,10 @@ module Mapping =
let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value
/// Map a history entry to BSON
let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
/// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
/// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds ()
doc["notes"] <- note.notes
upcast doc
/// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
notes = doc["notes"].AsString
}
/// Map a request to its BSON representation
let requestToBson req : BsonValue =
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList)
upcast doc
/// Map a BSON document to a request
let requestFromBson (doc : BsonValue) =
{ id = RequestId.ofString doc["_id"].AsString
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc["recurCount"].AsInt32
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq
}
/// Set up the mapping
let register () =
BsonMapper.Global.RegisterType<Request>(requestToBson, requestFromBson)
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
@ -217,9 +167,9 @@ let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
}
/// Update the recurrence for a request
let updateRecurrence reqId userId recurType recurCount db = backgroundTask {
let updateRecurrence reqId userId recurType db = backgroundTask {
match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
| Some req -> do! doUpdate db { req with recurrence = recurType }
| None -> invalidOp $"{RequestId.toString reqId} not found"
}

24
src/MyPrayerJournal/Domain.fs
View File

@ -1,5 +1,5 @@
[<AutoOpen>]
/// The data model for myPrayerJournal
/// The data model for myPrayerJournal
[<AutoOpen>]
module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames
@ -34,7 +34,7 @@ module UserId =
type Recurrence =
| Immediate
| Hours of int16
| Days of int16
| Days of int16
| Weeks of int16
/// Functions to manipulate recurrences
@ -111,10 +111,8 @@ type Request = {
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 : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// The recurrence for this request
recurrence : Recurrence
/// The history entries for this request
history : History list
/// The notes for this request
@ -128,8 +126,7 @@ with
userId = UserId ""
snoozedUntil = Instant.MinValue
showAfter = Instant.MinValue
recurType = Immediate
recurCount = 0s
recurrence = Immediate
history = []
notes = []
}
@ -152,10 +149,8 @@ type JournalRequest = {
snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence
showAfter : Instant
/// The type of recurrence for this request
recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
recurCount : int16
/// The recurrence for this request
recurrence : Recurrence
/// History entries for the request
history : History list
/// Note entries for the request
@ -180,8 +175,7 @@ module JournalRequest =
lastStatus = match hist with Some h -> h.status | None -> Created
snoozedUntil = req.snoozedUntil
showAfter = req.showAfter
recurType = req.recurType
recurCount = req.recurCount
recurrence = req.recurrence
history = []
notes = []
}

44
src/MyPrayerJournal/Handlers.fs
View File

@ -37,10 +37,10 @@ module Error =
log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse
>=> setStatusCode 500
>=> setHttpHeader "X-Toast" (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message)
>=> setHttpHeader "X-Toast" $"error|||{ex.GetType().Name}: {ex.Message}"
>=> text ex.Message
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized reponse
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler =
fun next ctx ->
(next, ctx)
@ -97,7 +97,7 @@ module private Helpers =
/// Return a 201 CREATED response with the location header set for the created resource
let createdAt url : HttpHandler =
fun next ctx ->
(sprintf "%s://%s%s" ctx.Request.Scheme ctx.Request.Host.Value url |> setHttpHeader HeaderNames.Location
($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location
>=> created) next ctx
/// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
@ -107,7 +107,7 @@ module private Helpers =
/// Render a component result
let renderComponent nodes : HttpHandler =
noResponseCaching
>=> fun next ctx -> backgroundTask {
>=> fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
}
@ -131,7 +131,7 @@ module private Helpers =
/// Composable handler to write a view to the output
let writeView view : HttpHandler =
fun next ctx -> backgroundTask {
fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlViewAsync view
}
@ -139,7 +139,7 @@ module private Helpers =
module Messages =
/// The messages being held
let mutable private messages : Map<string, (string * string)> = Map.empty
let mutable private messages : Map<string, string * string> = Map.empty
/// Locked update to prevent updates by multiple threads
let private upd8 = obj ()
@ -150,7 +150,7 @@ module private Helpers =
/// Add a success message header to the response
let pushSuccess ctx message url =
push ctx (sprintf "success|||%s" message) url
push ctx $"success|||{message}" url
/// Pop the messages for the given user
let pop userId = lock upd8 (fun () ->
@ -289,7 +289,7 @@ module Journal =
|> Option.map (fun c -> c.Value)
|> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
return! partial (sprintf "%s Prayer Journal" title) (Views.Journal.journal usr) next ctx
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
}
@ -343,9 +343,9 @@ module Request =
let now = now ctx
do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db
let nextShow =
match Recurrence.duration req.recurType with
match Recurrence.duration req.recurrence with
| 0L -> Instant.MinValue
| duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount))
| duration -> now.Plus (Duration.FromSeconds duration)
do! Data.updateShowAfter reqId usrId nextShow db
do! db.saveChanges ()
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
@ -465,27 +465,25 @@ module Request =
| None -> return! Error.notFound next ctx
}
/// Derive a recurrence and interval from its primitive representation in the form
/// Derive a recurrence from its representation in the form
let private parseRecurrence (form : Models.Request) =
(Recurrence.ofString (match form.recurInterval with Some x -> x | _ -> "Immediate"),
defaultArg form.recurCount (int16 0))
match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate"
|> Recurrence.ofString
// POST /request
let add : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx
let usrId = userId ctx
let now = now ctx
let (recur, interval) = parseRecurrence form
let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx
let usrId = userId ctx
let now = now ctx
let req =
{ Request.empty with
userId = usrId
enteredOn = now
showAfter = Instant.MinValue
recurType = recur
recurCount = interval
recurrence = parseRecurrence form
history = [
{ asOf = now
status = Created
@ -509,11 +507,11 @@ module Request =
match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with
| Some req ->
// update recurrence if changed
let (recur, interval) = parseRecurrence form
match recur = req.recurType && interval = req.recurCount with
let recur = parseRecurrence form
match recur = req.recurrence with
| true -> ()
| false ->
do! Data.updateRecurrence req.requestId usrId recur interval db
do! Data.updateRecurrence req.requestId usrId recur db
match recur with
| Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db
| _ -> ()

5
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -2,6 +2,7 @@
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<Version>3.0.0.0</Version>
<NoWarn>3391</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
@ -19,8 +20,8 @@
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="0.9.2" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="0.9.2" />
<PackageReference Include="Giraffe.Htmx" Version="1.6.1" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.6.1" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
<PackageReference Include="NodaTime" Version="3.0.9" />

15
src/MyPrayerJournal/Program.fs
View File

@ -84,17 +84,17 @@ module Configure =
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
.AddAuthentication(
/// Use HTTP "Bearer" authentication with JWTs
// Use HTTP "Bearer" authentication with JWTs
fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie()
.AddOpenIdConnect("Auth0",
/// Configure OIDC with Auth0 options from configuration
// Configure OIDC with Auth0 options from configuration
fun opts ->
let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg["Domain"]
opts.Authority <- $"""https://{cfg["Domain"]}/"""
opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
@ -118,11 +118,10 @@ module Configure =
| true ->
// transform to absolute
let request = ctx.Request
sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
$"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
| false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
|> ctx.Response.Redirect
Uri.EscapeDataString $"&returnTo={finalRedirUri}"
ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
ctx.HandleResponse ()
Task.CompletedTask
@ -159,7 +158,7 @@ module Configure =
.UseRouting()
.UseAuthentication()
.UseGiraffeErrorHandler(Handlers.Error.error)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
|> ignore
app

6
src/MyPrayerJournal/Views/Layout.fs
View File

@ -110,11 +110,7 @@ let htmlFoot =
]
]
]
script [
_src "https://unpkg.com/htmx.org@1.5.0"
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
_crossorigin "anonymous"
] []
Htmx.Script.minified
script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
]

25
src/MyPrayerJournal/Views/Request.fs
View File

@ -5,7 +5,6 @@ open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
open NodaTime
open System
/// Create a request within the list
let reqListItem now req =
@ -142,6 +141,14 @@ let edit (req : JournalRequest) returnTo isNew =
| "active" -> "/requests/active"
| "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal"
let recurCount =
match req.recurrence with
| Immediate -> None
| Hours h -> Some h
| Days d -> Some d
| Weeks w -> Some w
|> Option.map string
|> Option.defaultValue ""
article [ _class "container" ] [
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
form [
@ -202,7 +209,7 @@ let edit (req : JournalRequest) returnTo isNew =
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> _checked | _ -> ()
match req.recurrence with Immediate -> _checked | _ -> ()
]
label [ _for "rI" ] [ str "Immediately" ]
]
@ -214,7 +221,7 @@ let edit (req : JournalRequest) returnTo isNew =
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurType with Immediate -> () | _ -> _checked
match req.recurrence with Immediate -> () | _ -> _checked
]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
@ -225,10 +232,10 @@ let edit (req : JournalRequest) returnTo isNew =
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value (string req.recurCount)
_value recurCount
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
match req.recurrence with Immediate -> _disabled | _ -> ()
]
label [ _for "recurCount" ] [ str "Count" ]
]
@ -239,11 +246,11 @@ let edit (req : JournalRequest) returnTo isNew =
_name "recurInterval"
_style "width:6rem;"
_required
match req.recurType with Immediate -> _disabled | _ -> ()
match req.recurrence with Immediate -> _disabled | _ -> ()
] [
option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ]
option [ _value "Days"; match req.recurType with Days -> _selected | _ -> () ] [ str "days" ]
option [ _value "Weeks"; match req.recurType with Weeks -> _selected | _ -> () ] [ str "weeks" ]
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" ]
]

1
src/MyPrayerJournal/wwwroot/script/htmx-1.5.0.min.js vendored
View File

File diff suppressed because one or more lines are too long

1
src/MyPrayerJournal/wwwroot/script/htmx-1.6.1.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long