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

Merge pull request 'Version 3.4' (#78) from 3.4 into main

Browse Source 
Reviewed-on: #78
This commit is contained in:
Daniel J. Summers 2024-06-07 23:37:08 +00:00
commit 24c503385e
11 changed files with 374 additions and 217 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Dockerfile
View File

@ -1,17 +1,17 @@
FROM mcr.microsoft.com/dotnet/sdk:7.0-alpine AS build
FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
WORKDIR /mpj
COPY ./MyPrayerJournal/MyPrayerJournal.fsproj ./
RUN dotnet restore
COPY ./MyPrayerJournal ./
RUN dotnet publish -c Release -r linux-x64
RUN rm bin/Release/net7.0/linux-x64/publish/appsettings.*.json
RUN rm bin/Release/net8.0/linux-x64/publish/appsettings.*.json || true
FROM mcr.microsoft.com/dotnet/aspnet:7.0-alpine as final
FROM mcr.microsoft.com/dotnet/aspnet:8.0-alpine as final
WORKDIR /app
RUN apk add --no-cache icu-libs
ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false
COPY --from=build /mpj/bin/Release/net7.0/linux-x64/publish/ ./
COPY --from=build /mpj/bin/Release/net8.0/linux-x64/publish/ ./
EXPOSE 80
CMD [ "dotnet", "/app/MyPrayerJournal.dll" ]

6
src/MyPrayerJournal.sln
View File

@ -5,8 +5,6 @@ VisualStudioVersion = 16.0.30114.105
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
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}.Release|Any CPU.ActiveCfg = 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
EndGlobal

77
src/MyPrayerJournal/Data.fs
View File

@ -15,25 +15,24 @@ module Json =
open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T> ()
type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T>()
override _.Read(reader, _, _) =
wrap (reader.GetString ())
wrap (reader.GetString())
override _.Write(writer, value, _) =
writer.WriteStringValue (unwrap value)
writer.WriteStringValue(unwrap value)
open System.Text.Json
open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain
let options =
let opts = JsonSerializerOptions ()
[ WrappedJsonConverter (Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter (RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter (RequestId.ofString, RequestId.toString)
WrappedJsonConverter (UserId, UserId.toString)
JsonFSharpConverter ()
]
let opts = JsonSerializerOptions()
[ WrappedJsonConverter(Recurrence.ofString, Recurrence.toString) :> JsonConverter
WrappedJsonConverter(RequestAction.ofString, RequestAction.toString)
WrappedJsonConverter(RequestId.ofString, RequestId.toString)
WrappedJsonConverter(UserId, UserId.toString)
JsonFSharpConverter() ]
|> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
@ -41,13 +40,13 @@ module Json =
opts
open BitBadger.Npgsql.FSharp.Documents
open BitBadger.Documents.Postgres
/// Connection
[<RequireQualifiedAccess>]
module Connection =
open BitBadger.Npgsql.Documents
open BitBadger.Documents
open Microsoft.Extensions.Configuration
open Npgsql
open System.Text.Json
@ -56,18 +55,19 @@ module Connection =
let private ensureDb () = backgroundTask {
do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS mpj" []
do! Definition.ensureTable Table.Request
do! Definition.ensureIndex Table.Request Optimized
do! Definition.ensureDocumentIndex Table.Request Optimized
}
/// Set up the data environment
let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj")
let _ = builder.UseNodaTime ()
Configuration.useDataSource (builder.Build ())
let _ = builder.UseNodaTime()
Configuration.useDataSource (builder.Build())
Configuration.useIdField "id"
Configuration.useSerializer
{ new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) = JsonSerializer.Serialize (it, Json.options)
member _.Deserialize<'T> (it : string) = JsonSerializer.Deserialize<'T> (it, Json.options)
member _.Serialize<'T>(it : 'T) = JsonSerializer.Serialize(it, Json.options)
member _.Deserialize<'T>(it : string) = JsonSerializer.Deserialize<'T>(it, Json.options)
}
do! ensureDb ()
}
@ -80,9 +80,8 @@ module Request =
open NodaTime
/// Add a request
let add req = backgroundTask {
do! insert Table.Request (RequestId.toString req.Id) req
}
let add req =
insert<Request> Table.Request req
/// Does a request exist for the given request ID and user ID?
let existsById (reqId : RequestId) (userId : UserId) =
@ -90,7 +89,7 @@ module Request =
/// Retrieve a request by its ID and user ID
let tryById reqId userId = backgroundTask {
match! Find.byId<Request> Table.Request (RequestId.toString reqId) with
match! Find.byId<string, Request> Table.Request (RequestId.toString reqId) with
| Some req when req.UserId = userId -> return Some req
| _ -> return None
}
@ -99,24 +98,24 @@ module Request =
let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |}
| false -> invalidOp "Request ID {dbId} not found"
| true -> do! Patch.byId Table.Request dbId {| Recurrence = recurType |}
| false -> invalidOp $"Request ID {dbId} not found"
}
/// Update the show-after time for a request
let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |}
| false -> invalidOp "Request ID {dbId} not found"
| true -> do! Patch.byId Table.Request dbId {| ShowAfter = showAfter |}
| false -> invalidOp $"Request ID {dbId} not found"
}
/// Update the snoozed and show-after values for a request
let updateSnoozed reqId userId (until : Instant option) = backgroundTask {
let dbId = RequestId.toString reqId
match! existsById reqId userId with
| true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
| false -> invalidOp "Request ID {dbId} not found"
| true -> do! Patch.byId Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |}
| false -> invalidOp $"Request ID {dbId} not found"
}
@ -129,8 +128,7 @@ module History =
let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Update.partialById Table.Request dbId
{| History = (hist :: req.History) |> List.sortByDescending (fun it -> it.AsOf) |}
do! Patch.byId Table.Request dbId {| History = (hist :: req.History) |> List.sortByDescending (_.AsOf) |}
| None -> invalidOp $"Request ID {dbId} not found"
}
@ -144,15 +142,15 @@ module Journal =
let! reqs =
Custom.list
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
[ "@criteria", Query.jsonbDocParam {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ == "Answered")"""
] fromData<Request>
[ jsonParam "@criteria" {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ == "Answered")""" ]
fromData<Request>
return
reqs
|> Seq.ofList
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.AsOf)
|> Seq.sortByDescending (_.AsOf)
|> List.ofSeq
}
@ -161,15 +159,15 @@ module Journal =
let! reqs =
Custom.list
$"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}"""
[ "@criteria", Query.jsonbDocParam {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ <> "Answered")"""
] fromData<Request>
[ jsonParam "@criteria" {| UserId = userId |}
"@stat", Sql.string """$.history[0].status ? (@ <> "Answered")""" ]
fromData<Request>
return
reqs
|> Seq.ofList
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.LastStatus <> Answered)
|> Seq.sortBy (fun it -> it.AsOf)
|> Seq.sortBy (_.AsOf)
|> List.ofSeq
}
@ -194,8 +192,7 @@ module Note =
let dbId = RequestId.toString reqId
match! Request.tryById reqId userId with
| Some req ->
do! Update.partialById Table.Request dbId
{| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |}
do! Patch.byId Table.Request dbId {| Notes = (note :: req.Notes) |> List.sortByDescending (_.AsOf) |}
| 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.
// - 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.
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 snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
let lastPrayed =
history
|> Seq.filter History.isPrayed
|> Seq.tryHead
|> Option.map (fun it -> it.AsOf)
|> Option.map (_.AsOf)
|> Option.defaultValue Instant.MinValue
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id

54
src/MyPrayerJournal/Handlers.fs
View File

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

23
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<Version>3.3</Version>
<TargetFramework>net8.0</TargetFramework>
<Version>3.4</Version>
<DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile>
<PublishSingleFile>false</PublishSingleFile>
@ -16,20 +16,21 @@
<Compile Include="Views/Layout.fs" />
<Compile Include="Views/Legal.fs" />
<Compile Include="Views/Request.fs" />
<Compile Include="Views\Docs.fs" />
<Compile Include="Handlers.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta3" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.2.42" />
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.3.13" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="6.2.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.6" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.11" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.6" />
<PackageReference Update="FSharp.Core" Version="7.0.400" />
<PackageReference Include="Giraffe" Version="6.4.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.12" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="8.0.6" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.2.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Update="FSharp.Core" Version="8.0.300" />
</ItemGroup>
<ItemGroup>
<Folder Include="wwwroot\" />

30
src/MyPrayerJournal/Program.fs
View File

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

184
src/MyPrayerJournal/Views/Docs.fs Normal file
View File

@ -0,0 +1,184 @@
module MyPrayerJournal.Views.Docs
open Giraffe.ViewEngine
/// The "About myPrayerJournal" section
let private about = [
h3 [ _class "mb-3 mt-4" ] [ rawText "About myPrayerJournal" ]
p [] [
rawText "Journaling has a long history; it helps people remember what happened, and the act of writing helps "
rawText "people think about what happened and process it. A prayer journal is not a new concept; it helps you "
rawText "keep track of the requests for which you've prayed, you can use it to pray over things repeatedly, "
rawText "and you can write the result when the answer comes "; em [] [ rawText "(or it was &ldquo;no&rdquo;)" ]
rawText "."
]
p [] [
rawText "myPrayerJournal was borne of out of a personal desire "
a [ _href "https://daniel.summershome.org"; _target "_blank"; _rel "noopener" ] [ rawText "Daniel" ]
rawText " had to have something that would help him with his prayer life. When it&rsquo;s time to pray, "
rawText "it&rsquo;s not really time to use an app, so the design goal here is to keep it simple and "
rawText "unobtrusive. It will also help eliminate some of the downsides to a paper prayer journal, like not "
rawText "remembering whether you&rsquo;ve prayed for a request, or running out of room to write another update "
rawText "on one."
]
]
/// The "Signing Up" section
let private signUp = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Signing Up" ]
p [] [
rawText "myPrayerJournal uses login services using Google or Microsoft accounts. The only information the "
rawText "application stores in its database is your user Id token it receives from these services, so there "
rawText "are no permissions you should have to accept from these provider other than establishing that you can "
rawText "log on with that account. Because of this, you&rsquo;ll want to pick the same one each time; the "
rawText "tokens between the two accounts are different, even if you use the same e-mail address to log on to "
rawText "both."
]
]
/// The "Your Prayer Journal" section
let private yourJournal = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Your Prayer Journal" ]
p [] [
rawText "Your current requests will be presented in columns (usually three, but it could be more or less, "
rawText "depending on the size of your screen or device). Each request is in its own card, and the buttons at "
rawText "the top of each card apply to that request. The last line of each request also tells you how long it "
rawText "has been since anything has been done on that request. Any time you see something like &ldquo;a few "
rawText "minutes ago,&rdquo; you can hover over that to see the actual date/time the action was taken."
]
]
/// The "Adding a Request" section
let private addRequest = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Adding a Request" ]
p [] [
rawText "To add a request, click the &ldquo;Add a New Request&rdquo; button at the top of your journal. Then, "
rawText "enter the text of the request as you see fit; there is no right or wrong way, and you are the only "
rawText "person who will see the text you enter. When you save the request, it will go to the bottom of the "
rawText "list of requests."
]
]
/// The "Setting Request Recurrence" section
let private setRecurrence = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Setting Request Recurrence" ]
p [] [
rawText "When you add or update a request, you can choose whether requests go to the bottom of the journal "
rawText "once they have been marked &ldquo;Prayed&rdquo; or whether they will reappear after a delay. You can "
rawText "set recurrence in terms of hours, days, or weeks, but it cannot be longer than 365 days. If you "
rawText "decide you want a request to reappear sooner, you can skip the current delay; click the "
rawText "&ldquo;Active&rdquo; menu link, find the request in the list (likely near the bottom), and click the "
rawText "&ldquo;Show Now&rdquo; button."
]
]
/// The "Praying for Requests" section
let private praying = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Praying for Requests" ]
p [] [
rawText "The first button for each request has a checkmark icon; clicking this button will mark the request as "
rawText "&ldquo;Prayed&rdquo; and move it to the bottom of the list (or off, if you&rsquo;ve set a recurrence "
rawText "period for the request). This allows you, if you&rsquo;re praying through your requests, to start at "
rawText "the top left (with the request that it&rsquo;s been the longest since you&rsquo;ve prayed) and click "
rawText "the button as you pray; when the request move below or away, the next-least-recently-prayed request "
rawText "will take the top spot."
]
]
/// The "Editing Requests" section
let private editing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Editing Requests" ]
p [] [
rawText "The second button for each request has a pencil icon. This allows you to edit the text of the "
rawText "request, pretty much the same way you entered it; it starts with the current text, and you can add to "
rawText "it, modify it, or completely replace it. By default, updates will go in with an &ldquo;Updated&rdquo; "
rawText "status; you have the option to also mark this update as &ldquo;Prayed&rdquo; or "
rawText "&ldquo;Answered&rdquo;. Answered requests will drop off the journal list."
]
]
/// The "Adding Notes" section
let private addNotes = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Adding Notes" ]
p [] [
rawText "The third button for each request has an icon that looks like a speech bubble with lines on it; this "
rawText "lets you record notes about the request. If there is something you want to record that doesn&rsquo;t "
rawText "change the text of the request, this is the place to do it. For example, you may be praying for a "
rawText "long-term health issue, and that person tells you that their status is the same; or, you may want to "
rawText "record something God said to you while you were praying for that request."
]
]
/// The "Snoozing Requests" section
let private snoozing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Snoozing Requests" ]
p [] [
rawText "There may be a time where a request does not need to appear. The fourth button, with the clock icon, "
rawText "allows you to snooze requests until the day you specify. Additionally, if you have any snoozed "
rawText "requests, a &ldquo;Snoozed&rdquo; menu item will appear next to the &ldquo;Journal&rdquo; one; this "
rawText "page allows you to see what requests are snoozed, and return them to your journal by canceling the "
rawText "snooze."
]
]
/// The "Viewing a Request and Its History" section
let private viewing = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Viewing a Request and Its History" ]
p [] [
rawText "myPrayerJournal tracks all of the actions related to a request; from the &ldquo;Active&rdquo; and "
rawText "&ldquo;Answered&rdquo; menu links (and &ldquo;Snoozed&rdquo;, if it&rsquo;s showing), there is a "
rawText "&ldquo;View Full Request&rdquo; button. That page will show the current text of the request; how many "
rawText "times it has been marked as prayed; how long it has been an active request; and a log of all updates, "
rawText "prayers, and notes you have recorded. That log is listed from most recent to least recent; if you "
rawText "want to read it chronologically, press the &ldquo;End&rdquo; key on your keyboard and read it from "
rawText "the bottom up."
]
p [] [
rawText "The &ldquo;Active&rdquo; link will show all requests that have not yet been marked answered, "
rawText "including snoozed and recurring requests. If requests are snoozed, or in a recurrence period off the "
rawText "journal, there will be a button where you can return the request to the list (either &ldquo;Cancel "
rawText "Snooze&rdquo; or &ldquo;Show Now&rdquo;). The &ldquo;Answered&rdquo; link shows all requests that "
rawText "have been marked answered. The &ldquo;Snoozed&rdquo; link only shows snoozed requests."
]
]
/// The "Final Notes" section
let private finalNotes = [
h3 [ _class "mb-3 mt-4" ] [ rawText "Final Notes" ]
ul [] [
li [] [
rawText "If you encounter errors, please "
a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal/issues"; _target "_blank" ] [
rawText "file an issue"
]; rawText " (or "
a [ _href "mailto:daniel@bitbadger.solutions?subject=myPrayerJournal+Issue" ] [ rawText "e-mail Daniel" ]
rawText " if you do not have an account on that server) with as much detail as possible. You can also "
rawText "provide suggestions, or browse the list of currently open issues."
]
li [] [
rawText "Prayer requests and their history are securely backed up nightly along with other Bit Badger "
rawText "Solutions data."
]
li [] [
rawText "Prayer changes things - most of all, the one doing the praying. I pray that this tool enables you "
rawText "to deepen and strengthen your prayer life."
]
]
]
/// The documentation page
let index =
article [ _class "container mt-3" ] [
h2 [ _class "mb-3" ] [ rawText "Documentation" ]
yield! about
yield! signUp
yield! yourJournal
yield! addRequest
yield! setRecurrence
yield! praying
yield! editing
yield! addNotes
yield! snoozing
yield! viewing
yield! finalNotes
]

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
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
let version =

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

@ -7,46 +7,42 @@ open Giraffe.ViewEngine.Accessibility
/// The data needed to render a page-level view
type PageRenderContext =
{ /// Whether the user is authenticated
IsAuthenticated : bool
IsAuthenticated: bool
/// Whether the user has snoozed requests
HasSnoozed : bool
HasSnoozed: bool
/// The current URL
CurrentUrl : string
CurrentUrl: string
/// The title for the page to be rendered
PageTitle : string
PageTitle: string
/// The content of the page
Content : XmlNode
}
Content: XmlNode }
/// The home page
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 "
article [ _class "container mt-3" ]
[ p [] [ rawText "&nbsp;" ]
p []
[ 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 "
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 "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
]
]
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above." ] ]
/// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs
let private navBar ctx =
nav [ _class "navbar navbar-dark"; _roleNavigation ] [
div [ _class "container-fluid" ] [
pageLink "/" [ _class "navbar-brand" ] [
span [ _class "m" ] [ str "my" ]
nav [ _class "navbar navbar-dark"; _roleNavigation ]
[ div [ _class "container-fluid" ]
[ pageLink
"/" [ _class "navbar-brand" ]
[ span [ _class "m" ] [ str "my" ]
span [ _class "p" ] [ str "Prayer" ]
span [ _class "j" ] [ str "Journal" ]
]
span [ _class "j" ] [ str "Journal" ] ]
seq {
let navLink (matchUrl : string) =
match ctx.CurrentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
@ -58,23 +54,19 @@ let private navBar ctx =
li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ]
li [ _class "nav-item" ] [
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
]
li [ _class "nav-item" ] [ navLink "/docs" [ str "Docs" ] ]
}
|> List.ofSeq
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ]
]
]
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ] ]
/// The title tag with the application name appended
let titleTag ctx =
title [] [ str ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
title [] [ rawText ctx.PageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element
let htmlHead ctx =
head [ _lang "en" ] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
head [ _lang "en" ]
[ 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.3.2/dist/css/bootstrap.min.css"
@ -82,67 +74,52 @@ let htmlHead ctx =
_integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN"
_crossorigin "anonymous" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ]
]
link [ _href "/style/style.css"; _rel "stylesheet" ] ]
/// Element used to display toasts
let toaster =
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [
div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] []
]
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ]
[ div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] ]
/// The page's `footer` element
let htmlFoot =
footer [ _class "container-fluid" ] [
p [ _class "text-muted text-end" ] [
str $"myPrayerJournal {version}"
footer [ _class "container-fluid" ]
[ p [ _class "text-muted text-end" ]
[ str $"myPrayerJournal {version}"
br []
em [] [
small [] [
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
em []
[ small []
[ pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
rawText " &bull; "
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
rawText " &bull; "
a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [
str "Developed"
]
a [ _href "https://git.bitbadger.solutions/bit-badger/myPrayerJournal"
_target "_blank"
_rel "noopener" ] [ 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" ] ] ] ]
Htmx.Script.minified
script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
]
script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')" ]
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-C6RzsynM9kWDrMNeT87bh95OGNyZPhcTNXj1NW7RuBCsyN/o0jlpcV8Qyq46cDfL"
_crossorigin "anonymous" ] []
script [] [
rawText "setTimeout(function () { "
script []
[ rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
rawText "}, 2000)"
]
script [ _src "/script/mpj.js" ] []
]
rawText "}, 2000)" ]
script [ _src "/script/mpj.js" ] [] ]
/// Create the full view of the page
let view ctx =
html [ _lang "en" ] [
htmlHead ctx
body [] [
section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
html [ _lang "en" ]
[ htmlHead ctx
body []
[ section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
toaster
htmlFoot
]
]
htmlFoot ] ]
/// Create a partial view
let partial ctx =
html [ _lang "en" ] [
head [] [ titleTag ctx ]
body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ]
]
html [ _lang "en" ] [ head [] [ titleTag ctx ]; body [] [ navBar ctx; main [ _roleMain ] [ ctx.Content ] ] ]

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

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