diff --git a/build.fs b/build.fs index 256f669..c816377 100644 --- a/build.fs +++ b/build.fs @@ -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 diff --git a/src/Data/Access.fs b/src/Data/Access.fs index 043ab09..363be2e 100644 --- a/src/Data/Access.fs +++ b/src/Data/Access.fs @@ -90,7 +90,7 @@ module Connection = member _.Deserialize<'T>(it: string) = JsonSerializer.Deserialize<'T>(it, Json.options) } - let! tables = Custom.list "SELECT table_name FROM sqlite_master" [] _.GetString(0) + let! tables = Custom.list "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 -[] -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 "entered_date" - UpdatedDate = row.fieldValue "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 /// Save a prayer request let save req = save 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 /// Retrieve a prayer request by its ID let tryById reqId = diff --git a/src/Data/DistributedCache.fs b/src/Data/DistributedCache.fs deleted file mode 100644 index 5bcc84d..0000000 --- a/src/Data/DistributedCache.fs +++ /dev/null @@ -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 -[] -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 "expire_at" - SlidingExpiration = row.fieldValueOrNone "sliding_expiration" - AbsoluteExpiration = row.fieldValueOrNone "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 - diff --git a/src/Data/PrayerTracker.Data.fsproj b/src/Data/PrayerTracker.Data.fsproj index 7b3baa8..16884a4 100644 --- a/src/Data/PrayerTracker.Data.fsproj +++ b/src/Data/PrayerTracker.Data.fsproj @@ -3,17 +3,13 @@ - - - - diff --git a/src/PrayerTracker/App.fs b/src/PrayerTracker/App.fs index 3d8aef1..47b7738 100644 --- a/src/PrayerTracker/App.fs +++ b/src/PrayerTracker/App.fs @@ -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() + 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() diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index 296c536..eab8f6d 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -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 diff --git a/src/PrayerTracker/Extensions.fs b/src/PrayerTracker/Extensions.fs index 2f7cce6..87ab409 100644 --- a/src/PrayerTracker/Extensions.fs +++ b/src/PrayerTracker/Extensions.fs @@ -1,29 +1,25 @@ [] 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 diff --git a/src/PrayerTracker/PrayerTracker.fsproj b/src/PrayerTracker/PrayerTracker.fsproj index 4eba37a..de4dc9c 100644 --- a/src/PrayerTracker/PrayerTracker.fsproj +++ b/src/PrayerTracker/PrayerTracker.fsproj @@ -27,7 +27,7 @@ - + diff --git a/src/UI/PrayerTracker.UI.fsproj b/src/UI/PrayerTracker.UI.fsproj index d2b6d14..ff2cf99 100644 --- a/src/UI/PrayerTracker.UI.fsproj +++ b/src/UI/PrayerTracker.UI.fsproj @@ -19,11 +19,6 @@ - - - - -