Finish first cut of doc access (#55)

- Update paths for build.fs
- Remove unused/unneeded deps

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
 

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<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"
+        | SortByDate -> [ Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC"; Field.Named "requestor" ]
-        | SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
+        | 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) =
+    let countByChurch churchId =
-        BitBadger.Documents.Postgres.Custom.scalar
+        backgroundTask {
-            "SELECT COUNT(id) AS req_count
+            let! groupIds = SmallGroups.groupIdsByChurch churchId
-               FROM pt.prayer_request
+            return! Count.byFields Table.Request All [ Field.In "smallGroupId" groupIds ]
-              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")
 
     /// 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 =
+                let expDate =
-                    NpgsqlParameter(
+                    (theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
-                        "@asOf",
-                        (theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
                          - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
-                            .ToInstant()
+                        .ToInstant()
-                    )
+                $"""AND (   data->>'updatedDate'  > :updatedDate
-
+                         OR data->>'expiration'   = :expManual
-                "   AND (   updated_date > @asOf
+                         OR data->>'requestType' IN (:typLongTerm, :typExpecting))
-                         OR expiration   = @manual
+                    AND data->>'expiration' <> :expForced""",
-                         OR request_type = @longTerm
+                [ SqliteParameter(":updatedDate", expDate)
-                         OR request_type = @expecting)
+                  SqliteParameter(":expManual", string Manual)
-                    AND expiration <> @forced",
+                  SqliteParameter(":typLongTerm", string LongTermRequest)
-                [ "@asOf", Sql.parameter asOf
+                  SqliteParameter(":typExpecting", string Expecting)
-                  "@manual", Sql.string (string Manual)
+                  SqliteParameter(":expForced", string Forced) ]
-                  "@longTerm", Sql.string (string LongTermRequest)
-                  "@expecting", Sql.string (string Expecting)
-                  "@forced", Sql.string (string Forced) ]
             else
                 "", []
 
-        BitBadger.Documents.Postgres.Custom.list
+        Custom.list
-            $"SELECT *
+            $"SELECT data FROM {Table.Request}
-                FROM pt.prayer_request
+               WHERE data->>'smallGroupId = :groupId {sql}
-               WHERE small_group_id = @groupId {where}
                ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
                {paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"
-            (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters)
+            (SqliteParameter(":groupId", string opts.SmallGroup.Id) :: parameters)
-            mapToPrayerRequest
+            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
+        Custom.list
-            $"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
+            $"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
+            [ SqliteParameter(":groupId", string group.Id)
-              "@search", Sql.string $"%%%s{searchTerm}%%" ]
+              SqliteParameter(":search", $"%%%s{searchTerm}%%") ]
-            mapToPrayerRequest
+            fromData<PrayerRequest>
 
     /// Retrieve a prayer request by its ID
     let tryById reqId =

src/Data/DistributedCache.fs

@@ -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
-

src/Data/PrayerTracker.Data.fsproj

@@ -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>
 

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<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()

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

src/PrayerTracker/Extensions.fs

@@ -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

src/PrayerTracker/PrayerTracker.fsproj

@@ -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>
 

src/UI/PrayerTracker.UI.fsproj

@@ -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>