Compare commits
5 Commits
14b0a58d98
...
toward-v9
| Author | SHA1 | Date | |
|---|---|---|---|
| 733a730591 | |||
| 0c1285eaa7 | |||
| c9ccfe8b68 | |||
| 2e5a1426f6 | |||
| 05394b4461 |
6
build.fs
6
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
|
||||
|
||||
|
||||
@@ -68,6 +68,10 @@ module Json =
|
||||
opts
|
||||
|
||||
|
||||
module private Helpers =
|
||||
let instant (it: Instant) =
|
||||
it.ToString()
|
||||
|
||||
open BitBadger.Documents
|
||||
open BitBadger.Documents.Sqlite
|
||||
|
||||
@@ -90,7 +94,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,44 +119,27 @@ 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 =
|
||||
|
||||
/// Query to retrieve data for a small group info instance
|
||||
let private infoQuery =
|
||||
$"SELECT g.data->>'id' AS id, g.data->>'groupName' AS groupName, c.data->>'churchName' AS churchName,
|
||||
$"SELECT g.data->>'id' AS id, g.data->>'name' AS groupName, c.data->>'name' AS churchName,
|
||||
g.data->'preferences'->>'timeZoneId' AS timeZoneId, g.data->'preferences'->>'isPublic' AS isPublic
|
||||
FROM {Table.Group} g
|
||||
INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'"
|
||||
|
||||
/// Query to retrieve data for a small group select list item
|
||||
let private itemQuery =
|
||||
$"SELECT g.data->>'groupName' AS groupName, g.data->>'id' AS id, c.data->>'churchName' AS churchName
|
||||
$"SELECT g.data->>'name' AS groupName, g.data->>'id' AS id, c.data->>'name' AS churchName
|
||||
FROM {Table.Group} g
|
||||
INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'"
|
||||
|
||||
/// The ORDER BY clause for select list item queries
|
||||
let private itemOrderBy = "ORDER BY c.data->>'churchName', g.data->>'groupName'"
|
||||
let private itemOrderBy =
|
||||
Query.orderBy
|
||||
[ { Field.Named "name" with Qualifier = Some "c" }; { Field.Named "name" with Qualifier = Some "g" } ]
|
||||
SQLite
|
||||
|
||||
/// Map a row to a Small Group list item
|
||||
let private toSmallGroupItem (rdr: SqliteDataReader) =
|
||||
@@ -162,13 +149,13 @@ module SmallGroups =
|
||||
/// Get the group IDs for the given church
|
||||
let internal groupIdsByChurch (churchId: ChurchId) =
|
||||
backgroundTask {
|
||||
let! groups = Find.byFields<SmallGroup> Table.Group All [ Field.Equal "churchId" churchId ]
|
||||
let! groups = Find.byFields<SmallGroup> Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||
return groups |> List.map _.Id
|
||||
}
|
||||
|
||||
/// Count the number of small groups for a church
|
||||
let countByChurch (churchId: ChurchId) =
|
||||
Count.byFields Table.Group All [ Field.Equal "churchId" churchId ]
|
||||
Count.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||
|
||||
/// Delete a small group by its ID
|
||||
let deleteById (groupId: SmallGroupId) =
|
||||
@@ -176,20 +163,21 @@ module SmallGroups =
|
||||
use conn = Configuration.dbConn ()
|
||||
use! txn = conn.BeginTransactionAsync()
|
||||
|
||||
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
|
||||
let! users =
|
||||
Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||
|
||||
for user in users do
|
||||
do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except [ groupId ] |}
|
||||
|
||||
do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
|
||||
do! conn.deleteById Table.Group groupId
|
||||
do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||
do! conn.deleteById Table.Group (string groupId)
|
||||
|
||||
do! txn.CommitAsync()
|
||||
}
|
||||
|
||||
/// Get information for all small groups
|
||||
let infoForAll () =
|
||||
Custom.list $"{infoQuery} ORDER BY g.data->>'groupName'" [] SmallGroupInfo.FromReader
|
||||
Custom.list $"{infoQuery} ORDER BY g.data->>'name'" [] SmallGroupInfo.FromReader
|
||||
|
||||
/// Get a list of small group IDs along with a description that includes the church name
|
||||
let listAll () =
|
||||
@@ -208,7 +196,7 @@ module SmallGroups =
|
||||
$"{infoQuery}
|
||||
WHERE g.data->'preferences'->>'isPublic' = TRUE
|
||||
OR COALESCE(g.data->'preferences'->>'groupPassword', '') <> ''
|
||||
ORDER BY c.data->>'churchName', g.data->>'groupName'"
|
||||
{itemOrderBy}"
|
||||
[]
|
||||
SmallGroupInfo.FromReader
|
||||
|
||||
@@ -217,14 +205,14 @@ module SmallGroups =
|
||||
Find.firstByFields<SmallGroup>
|
||||
Table.Group
|
||||
All
|
||||
[ Field.Equal "id" groupId; Field.Equal "preferences.groupPassword" password ]
|
||||
[ Field.Equal "id" (string groupId); Field.Equal "preferences.groupPassword" password ]
|
||||
|
||||
/// Save a small group
|
||||
let save group = save<SmallGroup> Table.Group group
|
||||
|
||||
/// Save a small group's list preferences
|
||||
let savePreferences (groupId: SmallGroupId) (pref: ListPreferences) =
|
||||
Patch.byId Table.Group groupId {| Preferences = pref |}
|
||||
Patch.byId Table.Group (string groupId) {| Preferences = pref |}
|
||||
|
||||
/// Get a small group by its ID (including list preferences)
|
||||
let tryById groupId =
|
||||
@@ -244,16 +232,17 @@ module Churches =
|
||||
use! txn = conn.BeginTransactionAsync()
|
||||
|
||||
let! groupIds = SmallGroups.groupIdsByChurch churchId
|
||||
let gIdStrings = groupIds |> List.map string
|
||||
|
||||
do! Delete.byFields Table.Request All [ Field.In "smallGroupId" groupIds ]
|
||||
do! Delete.byFields Table.Request All [ Field.In "smallGroupId" gIdStrings ]
|
||||
|
||||
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User groupIds ]
|
||||
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User gIdStrings ]
|
||||
|
||||
for user in users do
|
||||
do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except groupIds |}
|
||||
do! Patch.byId Table.User (string user.Id) {| SmallGroups = user.SmallGroups |> List.except groupIds |}
|
||||
|
||||
do! Delete.byFields Table.Group All [ Field.Equal "churchId" churchId ]
|
||||
do! Delete.byId Table.Church churchId
|
||||
do! Delete.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||
do! Delete.byId Table.Church (string churchId)
|
||||
do! txn.CommitAsync()
|
||||
}
|
||||
|
||||
@@ -270,17 +259,17 @@ module Members =
|
||||
|
||||
/// Count members for the given small group
|
||||
let countByGroup (groupId: SmallGroupId) =
|
||||
Count.byFields Table.Member All [ Field.Equal "smallGroupId" groupId ]
|
||||
Count.byFields Table.Member All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||
|
||||
/// Delete a small group member by its ID
|
||||
let deleteById (memberId: MemberId) = Delete.byId Table.Member memberId
|
||||
let deleteById (memberId: MemberId) = Delete.byId Table.Member (string memberId)
|
||||
|
||||
/// Retrieve all members for a given small group
|
||||
let forGroup (groupId: SmallGroupId) =
|
||||
Find.byFieldsOrdered<Member>
|
||||
Table.Member
|
||||
All
|
||||
[ Field.Equal "smallGroupId" groupId ]
|
||||
[ Field.Equal "smallGroupId" (string groupId) ]
|
||||
[ Field.Named "memberName" ]
|
||||
|
||||
/// Save a small group member
|
||||
@@ -317,8 +306,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,71 +318,70 @@ 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" (List.map string groupIds) ]
|
||||
}
|
||||
|
||||
/// Count the number of prayer requests for a small group
|
||||
let countByGroup (groupId: SmallGroupId) =
|
||||
Count.byFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
|
||||
Count.byFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||
|
||||
/// Delete a prayer request by its ID
|
||||
let deleteById (reqId: PrayerRequestId) = Delete.byId Table.Request reqId
|
||||
let deleteById (reqId: PrayerRequestId) = Delete.byId Table.Request (string reqId)
|
||||
|
||||
/// Get all (or active) requests for a small group as of now or the specified date
|
||||
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",
|
||||
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) ]
|
||||
$"""AND ( date(data->>'updatedDate') > date(:updatedDate)
|
||||
OR data->>'expiration' = :expManual
|
||||
OR data->>'requestType' IN (:typLongTerm, :typExpecting))
|
||||
AND data->>'expiration' <> :expForced""",
|
||||
[ SqliteParameter(":updatedDate", string 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}
|
||||
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
|
||||
Custom.list
|
||||
$"SELECT data FROM {Table.Request}
|
||||
WHERE data->>'smallGroupId' = :groupId
|
||||
{sql}
|
||||
{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
|
||||
let pct = "%"
|
||||
Custom.list
|
||||
$"WITH results AS (
|
||||
SELECT data FROM {Table.Request}
|
||||
WHERE data->>'smallGroupId' = :groupId
|
||||
AND data->>'text' LIKE :search
|
||||
UNION
|
||||
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search
|
||||
ORDER BY {orderBy group.Preferences.RequestSort}
|
||||
SELECT data FROM {Table.Request}
|
||||
WHERE data->>'smallGroupId' = :groupId
|
||||
AND COALESCE(data->>'requestor', '') LIKE :search)
|
||||
SELECT data FROM results
|
||||
{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", $"{pct}%s{searchTerm}{pct}") ]
|
||||
fromData<PrayerRequest>
|
||||
|
||||
/// Retrieve a prayer request by its ID
|
||||
let tryById reqId =
|
||||
@@ -403,11 +392,11 @@ module PrayerRequests =
|
||||
if withTime then
|
||||
Patch.byId
|
||||
Table.Request
|
||||
req.Id
|
||||
(string req.Id)
|
||||
{| UpdatedDate = req.UpdatedDate
|
||||
Expiration = req.Expiration |}
|
||||
else
|
||||
Patch.byId Table.Request req.Id {| Expiration = req.Expiration |}
|
||||
Patch.byId Table.Request (string req.Id) {| Expiration = req.Expiration |}
|
||||
|
||||
|
||||
/// Functions to manipulate users
|
||||
@@ -421,22 +410,22 @@ module Users =
|
||||
let countByChurch churchId =
|
||||
backgroundTask {
|
||||
let! groupIds = SmallGroups.groupIdsByChurch churchId
|
||||
return! Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User groupIds ]
|
||||
return! Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User (List.map string groupIds) ]
|
||||
}
|
||||
|
||||
/// Count the number of users for a small group
|
||||
let countByGroup (groupId: SmallGroupId) =
|
||||
Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
|
||||
Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||
|
||||
/// Delete a user by its database ID
|
||||
let deleteById (userId: UserId) = Delete.byId Table.User userId
|
||||
let deleteById (userId: UserId) = Delete.byId Table.User (string userId)
|
||||
|
||||
/// Get a list of users authorized to administer the given small group
|
||||
let listByGroupId (groupId: SmallGroupId) =
|
||||
Find.byFieldsOrdered<User>
|
||||
Table.User
|
||||
All
|
||||
[ Field.InArray "smallGroups" Table.User [ groupId ] ]
|
||||
[ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||
[ Field.Named "lastName"; Field.Named "firstName" ]
|
||||
|
||||
/// Save a user's information
|
||||
@@ -448,7 +437,7 @@ module Users =
|
||||
Table.User
|
||||
All
|
||||
[ Field.Equal "email" email
|
||||
Field.InArray "smallGroups" Table.User [ groupId ] ]
|
||||
Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||
|
||||
/// Find a user by their database ID
|
||||
let tryById userId =
|
||||
@@ -456,12 +445,12 @@ module Users =
|
||||
|
||||
/// Update a user's last seen date/time
|
||||
let updateLastSeen (userId: UserId) (now: Instant) =
|
||||
Patch.byId Table.User userId {| LastSeen = now |}
|
||||
Patch.byId Table.User (string userId) {| LastSeen = now |}
|
||||
|
||||
/// Update a user's password hash
|
||||
let updatePassword (user: User) =
|
||||
Patch.byId Table.User user.Id {| PasswordHash = user.PasswordHash |}
|
||||
Patch.byId Table.User (string user.Id) {| PasswordHash = user.PasswordHash |}
|
||||
|
||||
/// Update a user's authorized small groups
|
||||
let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) =
|
||||
Patch.byId Table.User userId {| SmallGroups = groupIds |}
|
||||
Patch.byId Table.User (string userId) {| SmallGroups = groupIds |}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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>
|
||||
|
||||
|
||||
@@ -2,10 +2,10 @@ FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
|
||||
WORKDIR /pt
|
||||
COPY ./PrayerTracker.sln ./
|
||||
COPY ./Directory.Build.props ./
|
||||
COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/
|
||||
COPY ./Data/PrayerTracker.Data.fsproj ./Data/
|
||||
COPY ./Tests/PrayerTracker.Tests.fsproj ./Tests/
|
||||
COPY ./UI/PrayerTracker.UI.fsproj ./UI/
|
||||
COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/
|
||||
COPY ./Tests/PrayerTracker.Tests.fsproj ./Tests/
|
||||
RUN dotnet restore
|
||||
|
||||
COPY . ./
|
||||
|
||||
@@ -15,6 +15,7 @@
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" />
|
||||
<PackageReference Include="Npgsql.NodaTime" Version="9.0.2" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
||||
@@ -80,7 +80,9 @@ task {
|
||||
Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN")
|
||||
do! Connection.setUp ()
|
||||
|
||||
use source = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN").Build()
|
||||
let builder = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN")
|
||||
let _ = builder.UseNodaTime()
|
||||
use source = builder.Build()
|
||||
|
||||
let! churches =
|
||||
Sql.fromDataSource source
|
||||
@@ -122,8 +124,8 @@ task {
|
||||
for user in users do
|
||||
let! groups =
|
||||
Sql.fromDataSource source
|
||||
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = :user_id"
|
||||
|> Sql.parameters [ ":user_id", Sql.uuid user.Id.Value ]
|
||||
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @user_id"
|
||||
|> Sql.parameters [ "@user_id", Sql.uuid user.Id.Value ]
|
||||
|> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id")
|
||||
do! Users.save { user with SmallGroups = groups }
|
||||
printfn "Migrated %d users" users.Length
|
||||
|
||||
@@ -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,8 +84,10 @@ 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.AddLogging()
|
||||
let _ = svc.AddAntiforgery()
|
||||
let _ = svc.AddRouting()
|
||||
let _ = svc.AddSingleton<IClock> SystemClock.Instance
|
||||
@@ -219,8 +220,8 @@ module Configure =
|
||||
open Microsoft.Extensions.Options
|
||||
|
||||
/// Configure the application
|
||||
let app (app: IApplicationBuilder) =
|
||||
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
|
||||
let app (app: WebApplication) =
|
||||
let env = app.Services.GetRequiredService<IWebHostEnvironment>()
|
||||
|
||||
if env.IsDevelopment() then
|
||||
app.UseDeveloperExceptionPage()
|
||||
@@ -232,24 +233,20 @@ module Configure =
|
||||
let _ = app.UseCanonicalDomains()
|
||||
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
|
||||
let _ = app.UseStaticFiles()
|
||||
|
||||
let _ =
|
||||
app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
|
||||
|
||||
let _ = app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
|
||||
let _ = app.UseMiddleware<RequestStartMiddleware>()
|
||||
let _ = app.UseRouting()
|
||||
let _ = app.UseSession()
|
||||
|
||||
let _ =
|
||||
app.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
||||
|
||||
let _ = app.UseRequestLocalization(app.Services.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
||||
let _ = app.UseAuthentication()
|
||||
let _ = app.UseAuthorization()
|
||||
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
|
||||
|
||||
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>()
|
||||
app.Services.GetRequiredService<IStringLocalizerFactory>()
|
||||
|> Views.I18N.setUpFactories
|
||||
|
||||
open Microsoft.Extensions.DependencyInjection
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
/// The web application
|
||||
module App =
|
||||
@@ -258,22 +255,32 @@ module App =
|
||||
|
||||
[<EntryPoint>]
|
||||
let main args =
|
||||
let contentRoot = Directory.GetCurrentDirectory()
|
||||
|
||||
let app =
|
||||
WebHostBuilder()
|
||||
.UseContentRoot(contentRoot)
|
||||
let contentRoot = Directory.GetCurrentDirectory()
|
||||
let builder =
|
||||
WebApplication.CreateBuilder(
|
||||
WebApplicationOptions(
|
||||
Args = args,
|
||||
ApplicationName = "PrayerTracker",
|
||||
ContentRootPath = contentRoot,
|
||||
WebRootPath = Path.Combine(contentRoot, "wwwroot")))
|
||||
let _ =
|
||||
builder.WebHost
|
||||
.ConfigureAppConfiguration(Configure.configuration)
|
||||
.UseKestrel(Configure.kestrel)
|
||||
.UseWebRoot(Path.Combine(contentRoot, "wwwroot"))
|
||||
.ConfigureKestrel(Configure.kestrel)
|
||||
.ConfigureServices(Configure.services)
|
||||
.ConfigureLogging(Configure.logging)
|
||||
.Configure(System.Action<IApplicationBuilder> Configure.app)
|
||||
.Build()
|
||||
|
||||
if args.Length > 0 then
|
||||
printfn $"Unrecognized option {args[0]}"
|
||||
else
|
||||
use app = builder.Build()
|
||||
|
||||
Configure.app app
|
||||
|
||||
let fac = app.Services.GetRequiredService<ILoggerFactory>()
|
||||
let log = fac.CreateLogger "PrayerTracker"
|
||||
log.LogInformation "Application Started"
|
||||
|
||||
app.Run()
|
||||
|
||||
log.LogInformation "Application Shutting Down"
|
||||
|
||||
0
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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>
|
||||
|
||||
|
||||
0
src/PrayerTracker/data/.gitkeep
Normal file
0
src/PrayerTracker/data/.gitkeep
Normal file
@@ -182,13 +182,6 @@ let toHtmlIds it =
|
||||
let renderHtmlNode = RenderView.AsString.htmlNode
|
||||
|
||||
|
||||
open Giraffe.Fixi
|
||||
|
||||
/// Create a page link that will make the request with fixi
|
||||
let pageLink href attrs content =
|
||||
a (List.append [ _href href; _fxGet; _fxAction href; _fxTarget "#pt-body" ] attrs) content
|
||||
|
||||
|
||||
open Microsoft.AspNetCore.Html
|
||||
|
||||
/// Render an HTML node, then return the value as an HTML string
|
||||
@@ -224,6 +217,10 @@ module TimeZones =
|
||||
|
||||
open Giraffe.ViewEngine.Htmx
|
||||
|
||||
/// Create a page link that will make the request with fixi
|
||||
let pageLink href attrs content =
|
||||
a (List.append [ _href href; _hxGet href ] attrs) content
|
||||
|
||||
/// Known htmx targets
|
||||
module Target =
|
||||
|
||||
|
||||
@@ -274,11 +274,11 @@ let private partialHead pgTitle =
|
||||
let private pageLayout viewInfo pgTitle content =
|
||||
body [] [
|
||||
Navigation.top viewInfo
|
||||
div [ _id "pt-body" ] (contentSection viewInfo pgTitle content)
|
||||
div [ _id "pt-body"; Target.content ] (contentSection viewInfo pgTitle content)
|
||||
match viewInfo.Layout with
|
||||
| FullPage ->
|
||||
script [ _src "/js/ckeditor/ckeditor.js" ] []
|
||||
script [ _src "/_/fixi-0.5.7.js" ] []
|
||||
Htmx.Script.minified
|
||||
script [ _src "/_/app.js" ] []
|
||||
| _ -> () ]
|
||||
|
||||
@@ -348,4 +348,3 @@ let help pageTitle isHome content =
|
||||
p [ _class "pt-center-text" ] [
|
||||
a [ _href "/help"; _title s["Help Index"].Value ] [
|
||||
rawText "« "; locStr s["Back to Help Index"] ] ] ] ] ] ] ]
|
||||
|
||||
@@ -15,15 +15,9 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Giraffe.Fixi" Version="0.5.7" />
|
||||
<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>
|
||||
|
||||
|
||||
Reference in New Issue
Block a user