bit-badger/PrayerTracker
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 16 Activity

Finish first cut of doc access (#55)

Browse Source 
- Update paths for build.fs
- Remove unused/unneeded deps
This commit is contained in:
Daniel J. Summers 2025-01-31 21:57:39 -05:00
parent 14b0a58d98
commit 05394b4461
9 changed files with 48 additions and 276 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
build.fs
View File

@ -7,7 +7,7 @@ let execContext = Context.FakeExecutionContext.Create false "build.fsx" []
Context.setExecutionContext (Context.RuntimeContext.Fake execContext)
/// The root path to the projects within this solution
let projPath = "src/PrayerTracker"
let projPath = "src"
Target.create "Clean" (fun _ ->
!! "src/**/bin"
@ -16,7 +16,7 @@ Target.create "Clean" (fun _ ->
)
Target.create "Test" (fun _ ->
let testPath = $"{projPath}.Tests"
let testPath = $"{projPath}/Tests"
DotNet.build (fun opts -> { opts with NoLogo = true }) $"{testPath}/PrayerTracker.Tests.fsproj"
Testing.Expecto.run
(fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net9.0" })
@ -25,7 +25,7 @@ Target.create "Test" (fun _ ->
Target.create "Publish" (fun _ ->
DotNet.publish
(fun opts -> { opts with Runtime = Some "linux-x64"; SelfContained = Some false; NoLogo = true })
$"{projPath}/PrayerTracker.fsproj")
$"{projPath}/PrayerTracker/PrayerTracker.fsproj")
Target.create "All" ignore

97
src/Data/Access.fs
View File

@ -90,7 +90,7 @@ module Connection =
member _.Deserialize<'T>(it: string) =
JsonSerializer.Deserialize<'T>(it, Json.options) }
let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0)
let! tables = Custom.list<string> "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
if not (List.contains Table.Church tables) then
do! Definition.ensureTable Table.Church
@ -115,26 +115,6 @@ module Connection =
open Microsoft.Data.Sqlite
/// Helper functions for the PostgreSQL data implementation
[<AutoOpen>]
module private Helpers =
/// Map a row to a Prayer Request instance
let mapToPrayerRequest (row: RowReader) =
{ Id = PrayerRequestId(row.uuid "id")
UserId = UserId(row.uuid "user_id")
SmallGroupId = SmallGroupId(row.uuid "small_group_id")
EnteredDate = row.fieldValue<Instant> "entered_date"
UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor"
Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.Parse(row.string "request_type")
Expiration = Expiration.Parse(row.string "expiration") }
open Npgsql
/// Functions to retrieve small group information
module SmallGroups =
@ -317,8 +297,9 @@ module PrayerRequests =
/// Central place to append sort criteria for prayer request queries
let private orderBy sort =
match sort with
| SortByDate -> "updated_date DESC, entered_date DESC, requestor"
| SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
| SortByDate -> [ Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC"; Field.Named "requestor" ]
| SortByRequestor -> [ Field.Named "requestor"; Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC" ]
|> fun fields -> Query.orderBy fields SQLite
/// Paginate a prayer request query
let private paginate (pageNbr: int) pageSize =
@ -328,13 +309,11 @@ module PrayerRequests =
""
/// Count the number of prayer requests for a church
let countByChurch (churchId: ChurchId) =
BitBadger.Documents.Postgres.Custom.scalar
"SELECT COUNT(id) AS req_count
FROM pt.prayer_request
WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
[ "@churchId", Sql.uuid churchId.Value ]
(fun row -> row.int "req_count")
let countByChurch churchId =
backgroundTask {
let! groupIds = SmallGroups.groupIdsByChurch churchId
return! Count.byFields Table.Request All [ Field.In "smallGroupId" groupIds ]
}
/// Count the number of prayer requests for a small group
let countByGroup (groupId: SmallGroupId) =
@ -347,52 +326,50 @@ module PrayerRequests =
let forGroup (opts: PrayerRequestOptions) =
let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock)
let where, parameters =
let sql, parameters =
if opts.ActiveOnly then
let asOf =
NpgsqlParameter(
"@asOf",
(theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
let expDate =
(theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant()
)
" AND ( updated_date > @asOf
OR expiration = @manual
OR request_type = @longTerm
OR request_type = @expecting)
AND expiration <> @forced",
[ "@asOf", Sql.parameter asOf
"@manual", Sql.string (string Manual)
"@longTerm", Sql.string (string LongTermRequest)
"@expecting", Sql.string (string Expecting)
"@forced", Sql.string (string Forced) ]
.ToInstant()
$"""AND ( data->>'updatedDate' > :updatedDate
OR data->>'expiration' = :expManual
OR data->>'requestType' IN (:typLongTerm, :typExpecting))
AND data->>'expiration' <> :expForced""",
[ SqliteParameter(":updatedDate", expDate)
SqliteParameter(":expManual", string Manual)
SqliteParameter(":typLongTerm", string LongTermRequest)
SqliteParameter(":typExpecting", string Expecting)
SqliteParameter(":expForced", string Forced) ]
else
"", []
BitBadger.Documents.Postgres.Custom.list
$"SELECT *
FROM pt.prayer_request
WHERE small_group_id = @groupId {where}
Custom.list
$"SELECT data FROM {Table.Request}
WHERE data->>'smallGroupId = :groupId {sql}
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"
(("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters)
mapToPrayerRequest
(SqliteParameter(":groupId", string opts.SmallGroup.Id) :: parameters)
fromData<PrayerRequest>
/// Save a prayer request
let save req = save<PrayerRequest> Table.Request req
/// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr =
BitBadger.Documents.Postgres.Custom.list
$"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
Custom.list
$"SELECT data FROM {Table.Request}
WHERE data->>'smallGroupId' = :groupId
AND data->>'requestText' LIKE :search
UNION
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search
SELECT data FROM {Table.Request}
WHERE data->>'smallGroupId' = :groupId
AND COALESCE(data->>'requestor', '') LIKE :search
ORDER BY {orderBy group.Preferences.RequestSort}
{paginate pageNbr group.Preferences.PageSize}"
[ "@groupId", Sql.uuid group.Id.Value
"@search", Sql.string $"%%%s{searchTerm}%%" ]
mapToPrayerRequest
[ SqliteParameter(":groupId", string group.Id)
SqliteParameter(":search", $"%%%s{searchTerm}%%") ]
fromData<PrayerRequest>
/// Retrieve a prayer request by its ID
let tryById reqId =

192
src/Data/DistributedCache.fs
View File

@ -1,192 +0,0 @@
namespace PrayerTracker.Data
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql
/// Helper types and functions for the cache
[<AutoOpen>]
module private CacheHelpers =
open System
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Create a parameter for the expire-at time
let expireParam (it : Instant) =
"@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it))
/// Create a parameter for a possibly-missing NodaTime type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
open BitBadger.Documents.Postgres
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache () =
// ~~~ INITIALIZATION ~~~
do
task {
let! exists =
Custom.scalar
$"SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS does_exist"
[] (fun row -> row.bool "does_exist")
if not exists then
do! Custom.nonQuery
"CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)" []
} |> sync
// ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask {
let idParam = "@id", Sql.string key
let! tryEntry =
Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
(fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
match tryEntry with
| Some entry ->
let now = getNow ()
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
let needsRefresh, item =
if entry.ExpireAt = absExp then false, entry
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id"
[ expireParam item.ExpireAt; idParam ]
return if item.ExpireAt > now then Some entry else None
| None -> return None
}
/// The last time expired entries were purged (runs every 30 minutes)
let mutable lastPurge = Instant.MinValue
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key =
Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload =
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
now.Plus slide, Some slide, None
elif opts.AbsoluteExpiration.HasValue then
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 2 hour sliding expiration
let slide = Duration.FromHours 2
now.Plus slide, Some slide, None
Custom.nonQuery
"INSERT INTO session (
id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES (
@id, @payload, @expireAt, @slideExp, @absExp
) ON CONFLICT (id) DO UPDATE
SET payload = EXCLUDED.payload,
expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration"
[ "@id", Sql.string key
"@payload", Sql.bytea payload
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
return entry.Payload
| None -> return null
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member this.Get key = get key CancellationToken.None |> sync
member this.GetAsync (key, token) = get key token
member this.Refresh key = refresh key CancellationToken.None |> sync
member this.RefreshAsync (key, token) = refresh key token
member this.Remove key = remove key CancellationToken.None |> sync
member this.RemoveAsync (key, token) = remove key token
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync
member this.SetAsync (key, value, options, token) = set key value options token

4
src/Data/PrayerTracker.Data.fsproj
View File

@ -3,17 +3,13 @@
<ItemGroup>
<Compile Include="Entities.fs" />
<Compile Include="Access.fs" />
<Compile Include="DistributedCache.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.1" />
<PackageReference Include="Giraffe" Version="7.0.2" />
<PackageReference Include="NodaTime" Version="3.2.1" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.7.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>

6
src/PrayerTracker/App.fs
View File

@ -40,10 +40,9 @@ module Configure =
open BitBadger.Documents.Sqlite
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Localization
open Microsoft.Extensions.Caching.Distributed
open Microsoft.Extensions.DependencyInjection
open NeoSmart.Caching.Sqlite
open NodaTime
open Npgsql
open PrayerTracker.Data
/// Configure ASP.NET Core's service collection (dependency injection container)
@ -85,7 +84,8 @@ module Configure =
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then
ConfigurationBinder.Bind(emailCfg, Email.smtpOptions)
let _ = svc.AddSingleton<IDistributedCache, DistributedCache>()
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SessionDB")) "./data/session.db"
let _ = svc.AddSqliteCache(fun o -> o.CachePath <- cachePath)
let _ = svc.AddSession()
let _ = svc.AddAntiforgery()
let _ = svc.AddRouting()

2
src/PrayerTracker/Church.fs
View File

@ -12,7 +12,7 @@ let private findStats churchId = task {
let! groups = SmallGroups.countByChurch churchId
let! requests = PrayerRequests.countByChurch churchId
let! users = Users.countByChurch churchId
return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = requests; Users = int users }
return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = int requests; Users = int users }
}
// POST /church/[church-id]/delete

10
src/PrayerTracker/Extensions.fs
View File

@ -1,29 +1,25 @@
[<AutoOpen>]
module PrayerTracker.Extensions
open BitBadger.Documents
open Microsoft.AspNetCore.Http
open Newtonsoft.Json
open NodaTime
open NodaTime.Serialization.JsonNet
open PrayerTracker.Data
open PrayerTracker.Entities
open PrayerTracker.ViewModels
/// JSON.NET serializer settings for NodaTime
let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTimeZoneProviders.Tzdb
/// Extensions on the .NET session object
type ISession with
/// Set an object in the session
member this.SetObject<'T> key (value: 'T) =
this.SetString(key, JsonConvert.SerializeObject(value, jsonSettings))
this.SetString(key, (Configuration.serializer ()).Serialize value)
/// Get an object from the session
member this.TryGetObject<'T> key =
match this.GetString key with
| null -> None
| v -> Some (JsonConvert.DeserializeObject<'T>(v, jsonSettings))
| v -> Some ((Configuration.serializer ()).Deserialize<'T> v)
/// The currently logged on small group
member this.CurrentGroup

2
src/PrayerTracker/PrayerTracker.fsproj
View File

@ -27,7 +27,7 @@
<ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.0" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>

5
src/UI/PrayerTracker.UI.fsproj
View File

@ -19,11 +19,6 @@
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="MailKit" Version="4.10.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.3.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup>