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

Version 3.4 #78

Merged
danieljsummers merged 4 commits from 3.4 into main 2024-06-07 23:37:08 +00:00
Conversation 0 Commits 4 Files Changed 11 +77 -85
8 changed files with 77 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit b3f62c2586 - Show all commits

6
src/MyPrayerJournal.sln
View File

@ -5,8 +5,6 @@ VisualStudioVersion = 16.0.30114.105
MinimumVisualStudioVersion = 10.0.40219.1 MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}" Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
EndProject EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}"
EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU Debug|Any CPU = Debug|Any CPU
@ -24,9 +22,5 @@ Global
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.Build.0 = Debug|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.ActiveCfg = Release|Any CPU
{3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection EndGlobalSection
EndGlobal EndGlobal

47
src/MyPrayerJournal/Data.fs
View File

@ -15,24 +15,24 @@ module Json =
open System.Text.Json.Serialization open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation /// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T> () inherit JsonConverter<'T>()
override _.Read(reader, _, _) = override _.Read(reader, _, _) =
wrap (reader.GetString ()) wrap (reader.GetString())
override _.Write(writer, value, _) = override _.Write(writer, value, _) =
writer.WriteStringValue (unwrap value) writer.WriteStringValue(unwrap value)
open System.Text.Json open System.Text.Json
open NodaTime.Serialization.SystemTextJson open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain /// JSON serializer options to support the target domain
let options = let options =
let opts = JsonSerializerOptions () let opts = JsonSerializerOptions()
[ WrappedJsonConverter (Recurrence.ofString, Recurrence.toString) :> JsonConverter [ WrappedJsonConverter(Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter (RequestAction.ofString, RequestAction.toString) WrappedJsonConverter(RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter (RequestId.ofString, RequestId.toString) WrappedJsonConverter(RequestId.ofString, RequestId.toString)
WrappedJsonConverter (UserId, UserId.toString) WrappedJsonConverter(UserId, UserId.toString)
JsonFSharpConverter () JsonFSharpConverter()
] ]
|> List.iter opts.Converters.Add |> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
@ -62,12 +62,12 @@ module Connection =
/// Set up the data environment /// Set up the data environment
let setUp (cfg : IConfiguration) = backgroundTask { let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj") let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj")
let _ = builder.UseNodaTime () let _ = builder.UseNodaTime()
Configuration.useDataSource (builder.Build ()) Configuration.useDataSource (builder.Build())
Configuration.useSerializer Configuration.useSerializer
{ new IDocumentSerializer with { new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) = JsonSerializer.Serialize (it, Json.options) member _.Serialize<'T>(it : 'T) = JsonSerializer.Serialize(it, Json.options)
member _.Deserialize<'T> (it : string) = JsonSerializer.Deserialize<'T> (it, Json.options) member _.Deserialize<'T>(it : string) = JsonSerializer.Deserialize<'T>(it, Json.options)
} }
do! ensureDb () do! ensureDb ()
} }
@ -80,9 +80,8 @@ module Request =
open NodaTime open NodaTime
/// Add a request /// Add a request
let add req = backgroundTask { let add req =
do! insert Table.Request (RequestId.toString req.Id) req insert<Request> Table.Request req
}
/// Does a request exist for the given request ID and user ID? /// Does a request exist for the given request ID and user ID?
let existsById (reqId : RequestId) (userId : UserId) = let existsById (reqId : RequestId) (userId : UserId) =
@ -100,7 +99,7 @@ module Request =
let dbId = RequestId.toString reqId let dbId = RequestId.toString reqId
match! existsById reqId userId with match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |} | true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |}
| false -> invalidOp "Request ID {dbId} not found" | false -> invalidOp $"Request ID {dbId} not found"
} }
/// Update the show-after time for a request /// Update the show-after time for a request
@ -108,7 +107,7 @@ module Request =
let dbId = RequestId.toString reqId let dbId = RequestId.toString reqId
match! existsById reqId userId with match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |} | true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |}
| false -> invalidOp "Request ID {dbId} not found" | false -> invalidOp $"Request ID {dbId} not found"
} }
/// Update the snoozed and show-after values for a request /// Update the snoozed and show-after values for a request
@ -116,7 +115,7 @@ module Request =
let dbId = RequestId.toString reqId let dbId = RequestId.toString reqId
match! existsById reqId userId with match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |} | true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
| false -> invalidOp "Request ID {dbId} not found" | false -> invalidOp $"Request ID {dbId} not found"
} }
@ -130,7 +129,7 @@ module History =
match! Request.tryById reqId userId with match! Request.tryById reqId userId with
| Some req -> | Some req ->
do! Update.partialById Table.Request dbId do! Update.partialById Table.Request dbId
{| History = (hist :: req.History) |> List.sortByDescending (fun it -> it.AsOf) |} {| History = (hist :: req.History) |> List.sortByDescending (_.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found" | None -> invalidOp $"Request ID {dbId} not found"
} }
@ -152,7 +151,7 @@ module Journal =
|> Seq.ofList |> Seq.ofList
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus = Answered) |> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.AsOf) |> Seq.sortByDescending (_.AsOf)
|> List.ofSeq |> List.ofSeq
} }
@ -169,7 +168,7 @@ module Journal =
|> Seq.ofList |> Seq.ofList
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus <> Answered) |> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (fun it -> it.AsOf) |> Seq.sortBy (_.AsOf)
|> List.ofSeq |> List.ofSeq
} }
@ -195,7 +194,7 @@ module Note =
match! Request.tryById reqId userId with match! Request.tryById reqId userId with
| Some req -> | Some req ->
do! Update.partialById Table.Request dbId do! Update.partialById Table.Request dbId
{| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |} {| Notes = (note :: req.Notes) |> List.sortByDescending (_.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found" | None -> invalidOp $"Request ID {dbId} not found"
} }

4
src/MyPrayerJournal/Domain.fs
View File

@ -244,14 +244,14 @@ module JournalRequest =
// them at the bottom of the list. // them at the bottom of the list.
// - Snoozed requests will reappear at the bottom of the list when they return. // - Snoozed requests will reappear at the bottom of the list when they return.
// - New requests will go to the bottom of the list, but will rise as others are marked as prayed. // - New requests will go to the bottom of the list, but will rise as others are marked as prayed.
let lastActivity = lastHistory |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue let lastActivity = lastHistory |> Option.map (_.AsOf) |> Option.defaultValue Instant.MinValue
let showAfter = defaultArg req.ShowAfter Instant.MinValue let showAfter = defaultArg req.ShowAfter Instant.MinValue
let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
let lastPrayed = let lastPrayed =
history history
|> Seq.filter History.isPrayed |> Seq.filter History.isPrayed
|> Seq.tryHead |> Seq.tryHead
|> Option.map (fun it -> it.AsOf) |> Option.map (_.AsOf)
|> Option.defaultValue Instant.MinValue |> Option.defaultValue Instant.MinValue
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ] let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id { RequestId = req.Id

46
src/MyPrayerJournal/Handlers.fs
View File

@ -16,7 +16,7 @@ module private LogOnHelpers =
let logOn url : HttpHandler = fun next ctx -> task { let logOn url : HttpHandler = fun next ctx -> task {
match url with match url with
| Some it -> | Some it ->
do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) do! ctx.ChallengeAsync("Auth0", AuthenticationProperties(RedirectUri = it))
return! next ctx return! next ctx
| None -> return! challenge "Auth0" next ctx | None -> return! challenge "Auth0" next ctx
} }
@ -57,14 +57,14 @@ type HttpContext with
|> Option.ofObj |> Option.ofObj
|> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)) |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier))
|> Option.flatten |> Option.flatten
|> Option.map (fun claim -> claim.Value) |> Option.map (_.Value)
/// The current user's ID /// The current user's ID
// NOTE: this may raise if you don't run the request through the requireUser handler first // NOTE: this may raise if you don't run the request through the requireUser handler first
member this.UserId = UserId this.CurrentUser.Value member this.UserId = UserId this.CurrentUser.Value
/// The system clock /// The system clock
member this.Clock = this.GetService<IClock> () member this.Clock = this.GetService<IClock>()
/// Get the current instant from the system clock /// Get the current instant from the system clock
member this.Now = this.Clock.GetCurrentInstant member this.Now = this.Clock.GetCurrentInstant
@ -94,7 +94,7 @@ module private Helpers =
/// Debug logger /// Debug logger
let debug (ctx : HttpContext) message = let debug (ctx : HttpContext) message =
let fac = ctx.GetService<ILoggerFactory> () let fac = ctx.GetService<ILoggerFactory>()
let log = fac.CreateLogger "Debug" let log = fac.CreateLogger "Debug"
log.LogInformation message log.LogInformation message
@ -115,7 +115,7 @@ module private Helpers =
let renderComponent nodes : HttpHandler = let renderComponent nodes : HttpHandler =
noResponseCaching noResponseCaching
>=> fun _ ctx -> backgroundTask { >=> fun _ ctx -> backgroundTask {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes) return! ctx.WriteHtmlStringAsync(ViewEngine.RenderView.AsString.htmlNodes nodes)
} }
open Views.Layout open Views.Layout
@ -125,7 +125,7 @@ module private Helpers =
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed = let! hasSnoozed =
match ctx.CurrentUser with match ctx.CurrentUser with
| Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now ()) | Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now())
| None -> Task.FromResult false | None -> Task.FromResult false
return return
{ IsAuthenticated = Option.isSome ctx.CurrentUser { IsAuthenticated = Option.isSome ctx.CurrentUser
@ -153,7 +153,7 @@ module private Helpers =
/// Push a new message into the list /// Push a new message into the list
let push (ctx : HttpContext) message url = lock upd8 (fun () -> let push (ctx : HttpContext) message url = lock upd8 (fun () ->
messages <- messages.Add (ctx.UserId, (message, url))) messages <- messages.Add(ctx.UserId, (message, url)))
/// Add a success message header to the response /// Add a success message header to the response
let pushSuccess ctx message url = let pushSuccess ctx message url =
@ -259,7 +259,7 @@ module Components =
// GET /components/request-item/[req-id] // GET /components/request-item/[req-id]
let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task { let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with
| Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx | Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now()) ctx.TimeZone req ] next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
@ -270,7 +270,7 @@ module Components =
// GET /components/request/[req-id]/notes // GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task { let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task {
let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId
return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone notes) next ctx return! renderComponent (Views.Request.notes (ctx.Now()) ctx.TimeZone notes) next ctx
} }
// GET /components/request/[req-id]/snooze // GET /components/request/[req-id]/snooze
@ -294,7 +294,7 @@ module Journal =
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)
|> Option.map (fun c -> c.Value) |> Option.map (_.Value)
|> Option.defaultValue "Your" |> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's" let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
@ -362,8 +362,8 @@ module Request =
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Request.existsById reqId userId with match! Request.existsById reqId userId with
| true -> | true ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> () let! notes = ctx.BindFormAsync<Models.NoteEntry>()
do! Note.add reqId userId { AsOf = ctx.Now (); Notes = notes.notes } do! Note.add reqId userId { AsOf = ctx.Now(); Notes = notes.notes }
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| false -> return! Error.notFound next ctx | false -> return! Error.notFound next ctx
} }
@ -371,13 +371,13 @@ module Request =
// GET /requests/active // GET /requests/active
let active : HttpHandler = requireUser >=> fun next ctx -> task { let active : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Journal.forUser ctx.UserId let! reqs = Journal.forUser ctx.UserId
return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx return! partial "Active Requests" (Views.Request.active (ctx.Now()) ctx.TimeZone reqs) next ctx
} }
// GET /requests/snoozed // GET /requests/snoozed
let snoozed : HttpHandler = requireUser >=> fun next ctx -> task { let snoozed : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Journal.forUser ctx.UserId let! reqs = Journal.forUser ctx.UserId
let now = ctx.Now () let now = ctx.Now()
let snoozed = reqs let snoozed = reqs
|> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false) |> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false)
return! partial "Snoozed Requests" (Views.Request.snoozed now ctx.TimeZone snoozed) next ctx return! partial "Snoozed Requests" (Views.Request.snoozed now ctx.TimeZone snoozed) next ctx
@ -386,7 +386,7 @@ module Request =
// GET /requests/answered // GET /requests/answered
let answered : HttpHandler = requireUser >=> fun next ctx -> task { let answered : HttpHandler = requireUser >=> fun next ctx -> task {
let! reqs = Journal.answered ctx.UserId let! reqs = Journal.answered ctx.UserId
return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx return! partial "Answered Requests" (Views.Request.answered (ctx.Now()) ctx.TimeZone reqs) next ctx
} }
// GET /request/[req-id]/full // GET /request/[req-id]/full
@ -413,11 +413,11 @@ module Request =
let reqId = RequestId.ofString requestId let reqId = RequestId.ofString requestId
match! Request.existsById reqId userId with match! Request.existsById reqId userId with
| true -> | true ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> () let! until = ctx.BindFormAsync<Models.SnoozeUntil>()
let date = let date =
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc) .AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant () .ToInstant()
do! Request.updateSnoozed reqId userId (Some date) do! Request.updateSnoozed reqId userId (Some date)
return! return!
(withSuccessMessage $"Request snoozed until {until.until}" (withSuccessMessage $"Request snoozed until {until.until}"
@ -444,9 +444,9 @@ module Request =
// POST /request // POST /request
let add : HttpHandler = requireUser >=> fun next ctx -> task { let add : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request>()
let userId = ctx.UserId let userId = ctx.UserId
let now = ctx.Now () let now = ctx.Now()
let req = let req =
{ Request.empty with { Request.empty with
Id = Cuid.generate () |> RequestId Id = Cuid.generate () |> RequestId
@ -468,7 +468,7 @@ module Request =
// PATCH /request // PATCH /request
let update : HttpHandler = requireUser >=> fun next ctx -> task { let update : HttpHandler = requireUser >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request>()
let userId = ctx.UserId let userId = ctx.UserId
// TODO: update the instance and save rather than all these little updates // TODO: update the instance and save rather than all these little updates
match! Journal.tryById (RequestId.ofString form.requestId) userId with match! Journal.tryById (RequestId.ofString form.requestId) userId with
@ -483,10 +483,10 @@ module Request =
| Immediate -> do! Request.updateShowAfter req.RequestId userId None | Immediate -> do! Request.updateShowAfter req.RequestId userId None
| _ -> () | _ -> ()
// append history // append history
let upd8Text = form.requestText.Trim () let upd8Text = form.requestText.Trim()
let text = if upd8Text = req.Text then None else Some upd8Text let text = if upd8Text = req.Text then None else Some upd8Text
do! History.add req.RequestId userId do! History.add req.RequestId userId
{ AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } { AsOf = ctx.Now(); Status = (Option.get >> RequestAction.ofString) form.status; Text = text }
let nextUrl = let nextUrl =
match form.returnTo with match form.returnTo with
| "active" -> "/requests/active" | "active" -> "/requests/active"
@ -510,7 +510,7 @@ module User =
// GET /user/log-off // GET /user/log-off
let logOff : HttpHandler = requireUser >=> fun next ctx -> task { let logOff : HttpHandler = requireUser >=> 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
} }

15
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net7.0</TargetFramework> <TargetFramework>net8.0</TargetFramework>
<Version>3.3</Version> <Version>3.4</Version>
<DebugType>embedded</DebugType> <DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile> <GenerateDocumentationFile>false</GenerateDocumentationFile>
<PublishSingleFile>false</PublishSingleFile> <PublishSingleFile>false</PublishSingleFile>
@ -20,16 +20,15 @@
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta3" /> <PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="2.0.0" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.2.42" /> <PackageReference Include="FSharp.SystemTextJson" Version="1.2.42" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" /> <PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="6.2.0" /> <PackageReference Include="Giraffe" Version="6.2.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.6" /> <PackageReference Include="Giraffe.Htmx" Version="1.9.8" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.8" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.11" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.0" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" /> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.6" /> <PackageReference Include="Npgsql.NodaTime" Version="8.0.1" />
<PackageReference Update="FSharp.Core" Version="7.0.400" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />

30
src/MyPrayerJournal/Program.fs
View File

@ -31,10 +31,10 @@ let main args =
let builder = WebApplication.CreateBuilder args let builder = WebApplication.CreateBuilder args
let _ = builder.Configuration.AddEnvironmentVariables "MPJ_" let _ = builder.Configuration.AddEnvironmentVariables "MPJ_"
let svc = builder.Services let svc = builder.Services
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> () let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let _ = svc.AddRouting () let _ = svc.AddRouting()
let _ = svc.AddGiraffe () let _ = svc.AddGiraffe()
let _ = svc.AddSingleton<IClock> SystemClock.Instance let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ = svc.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb let _ = svc.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) -> let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
@ -59,7 +59,7 @@ let main args =
opts.ClientSecret <- auth0["Secret"] opts.ClientSecret <- auth0["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear () opts.Scope.Clear()
opts.Scope.Add "openid" opts.Scope.Add "openid"
opts.Scope.Add "profile" opts.Scope.Add "profile"
@ -67,7 +67,7 @@ let main args =
opts.ClaimsIssuer <- "Auth0" opts.ClaimsIssuer <- "Auth0"
opts.SaveTokens <- true opts.SaveTokens <- true
opts.Events <- OpenIdConnectEvents () opts.Events <- OpenIdConnectEvents()
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
let returnTo = let returnTo =
match ctx.Properties.RedirectUri with match ctx.Properties.RedirectUri with
@ -82,7 +82,7 @@ let main args =
| false -> redirUri | false -> redirUri
Uri.EscapeDataString $"&returnTo={finalRedirUri}" Uri.EscapeDataString $"&returnTo={finalRedirUri}"
ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}""" ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}"""
ctx.HandleResponse () ctx.HandleResponse()
Task.CompletedTask Task.CompletedTask
opts.Events.OnRedirectToIdentityProvider <- fun ctx -> opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let uri = UriBuilder ctx.ProtocolMessage.RedirectUri let uri = UriBuilder ctx.ProtocolMessage.RedirectUri
@ -92,20 +92,20 @@ let main args =
Task.CompletedTask) Task.CompletedTask)
let _ = svc.AddSingleton<JsonSerializerOptions> Json.options let _ = svc.AddSingleton<JsonSerializerOptions> Json.options
let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options) let _ = svc.AddSingleton<Json.ISerializer>(SystemTextJson.Serializer Json.options)
let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
if builder.Environment.IsDevelopment () then builder.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore if builder.Environment.IsDevelopment() then builder.Logging.AddFilter(fun l -> l > LogLevel.Information) |> ignore
let _ = builder.Logging.AddConsole().AddDebug() |> ignore let _ = builder.Logging.AddConsole().AddDebug() |> ignore
use app = builder.Build () use app = builder.Build()
let _ = app.UseStaticFiles () let _ = app.UseStaticFiles()
let _ = app.UseCookiePolicy () let _ = app.UseCookiePolicy()
let _ = app.UseRouting () let _ = app.UseRouting()
let _ = app.UseAuthentication () let _ = app.UseAuthentication()
let _ = app.UseGiraffeErrorHandler Handlers.Error.error let _ = app.UseGiraffeErrorHandler Handlers.Error.error
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints Handlers.routes)
app.Run () app.Run()
0 0

2
src/MyPrayerJournal/Views/Helpers.fs
View File

@ -29,7 +29,7 @@ let noResults heading link buttonText text =
/// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate (date : Instant) now (tz : DateTimeZone) = let relativeDate (date : Instant) now (tz : DateTimeZone) =
span [ _title (date.InZone(tz).ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ] span [ _title (date.InZone(tz).ToDateTimeOffset().ToString("f", null)) ] [ Dates.formatDistance now date |> str ]
/// The version of myPrayerJournal /// The version of myPrayerJournal
let version = let version =

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

@ -74,13 +74,13 @@ let snoozed now tz reqs =
/// View for Full Request page /// View for Full Request page
let full (clock : IClock) tz (req : Request) = let full (clock : IClock) tz (req : Request) =
let now = clock.GetCurrentInstant () let now = clock.GetCurrentInstant()
let answered = let answered =
req.History req.History
|> Seq.ofList |> Seq.ofList
|> Seq.filter History.isAnswered |> Seq.filter History.isAnswered
|> Seq.tryHead |> Seq.tryHead
|> Option.map (fun x -> x.AsOf) |> Option.map (_.AsOf)
let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0" let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0"
let daysOpen = let daysOpen =
let asOf = defaultArg answered now let asOf = defaultArg answered now
@ -89,7 +89,7 @@ let full (clock : IClock) tz (req : Request) =
req.History req.History
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun h -> Option.isSome h.Text) |> Seq.filter (fun h -> Option.isSome h.Text)
|> Seq.sortByDescending (fun h -> h.AsOf) |> Seq.sortByDescending (_.AsOf)
|> Seq.map (fun h -> Option.get h.Text) |> Seq.map (fun h -> Option.get h.Text)
|> Seq.head |> Seq.head
// The history log including notes (and excluding the final entry for answered requests) // The history log including notes (and excluding the final entry for answered requests)
@ -100,7 +100,7 @@ let full (clock : IClock) tz (req : Request) =
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) |> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> Seq.append (req.History |> List.map toDisp) |> Seq.append (req.History |> List.map toDisp)
|> Seq.sortByDescending (fun it -> it.asOf) |> Seq.sortByDescending (_.asOf)
|> List.ofSeq |> List.ofSeq
// Skip the first entry for answered requests; that info is already displayed // Skip the first entry for answered requests; that info is already displayed
match answered with Some _ -> all.Tail | None -> all match answered with Some _ -> all.Tail | None -> all
@ -112,7 +112,7 @@ let full (clock : IClock) tz (req : Request) =
match answered with match answered with
| Some date -> | Some date ->
str "Answered " str "Answered "
date.ToDateTimeOffset().ToString ("D", null) |> str date.ToDateTimeOffset().ToString("D", null) |> str
str " (" str " ("
relativeDate date now tz relativeDate date now tz
rawText ") &bull; " rawText ") &bull; "
@ -127,7 +127,7 @@ let full (clock : IClock) tz (req : Request) =
p [ _class "m-0" ] [ p [ _class "m-0" ] [
str it.status str it.status
rawText "&nbsp; " rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ] small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString("D", null) |> str ] ]
] ]
match it.text with match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ] | Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]