7 Commits

Author SHA1 Message Date
733a730591 Add order by field via library 2025-05-26 09:58:37 -04:00
0c1285eaa7 Format Dockerfile 2025-02-03 07:55:37 -05:00
c9ccfe8b68 Fix request search (#55); WIP on full htmx (#56)
- Removed fixi library (not a good fit)
2025-02-01 15:52:31 -05:00
2e5a1426f6 Migration runs successfully 2025-01-31 22:19:35 -05:00
05394b4461 Finish first cut of doc access (#55)
- Update paths for build.fs
- Remove unused/unneeded deps
2025-01-31 21:57:39 -05:00
14b0a58d98 WIP on doc queries (#55) 2025-01-31 17:24:12 -05:00
bade89dd37 Removed PrayerTracker from Test project path 2025-01-31 07:22:58 -05:00
26 changed files with 353 additions and 575 deletions

View File

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

View File

@@ -1,9 +1,5 @@
namespace PrayerTracker.Data namespace PrayerTracker.Data
open System
open NodaTime
open PrayerTracker.Entities
/// Table names /// Table names
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Table = module Table =
@@ -29,6 +25,10 @@ module Table =
let User = "pt_user" let User = "pt_user"
open System
open NodaTime
open PrayerTracker.Entities
/// JSON serialization customizations /// JSON serialization customizations
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Json = module Json =
@@ -36,12 +36,10 @@ module Json =
open System.Text.Json.Serialization open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation /// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) = type WrappedJsonConverter<'T>(wrap: string -> 'T, unwrap: 'T -> string) =
inherit JsonConverter<'T>() inherit JsonConverter<'T>()
override _.Read(reader, _, _) = override _.Read(reader, _, _) = wrap (reader.GetString())
wrap (reader.GetString()) override _.Write(writer, value, _) = writer.WriteStringValue(unwrap value)
override _.Write(writer, value, _) =
writer.WriteStringValue(unwrap value)
open System.Text.Json open System.Text.Json
open NodaTime.Serialization.SystemTextJson open NodaTime.Serialization.SystemTextJson
@@ -49,6 +47,7 @@ module Json =
/// JSON serializer options to support the target domain /// JSON serializer options to support the target domain
let options = let options =
let opts = JsonSerializerOptions() let opts = JsonSerializerOptions()
[ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter [ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter
WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string) WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string)
WrappedJsonConverter<Expiration>(Expiration.Parse, string) WrappedJsonConverter<Expiration>(Expiration.Parse, string)
@@ -62,11 +61,17 @@ module Json =
WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string) WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string)
JsonFSharpConverter() ] JsonFSharpConverter() ]
|> List.iter opts.Converters.Add |> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
opts opts
module private Helpers =
let instant (it: Instant) =
it.ToString()
open BitBadger.Documents open BitBadger.Documents
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
@@ -77,106 +82,172 @@ module Connection =
open System.Text.Json open System.Text.Json
/// Ensure tables and indexes are defined /// Ensure tables and indexes are defined
let setUp () = backgroundTask { let setUp () =
Configuration.useIdField "id" backgroundTask {
Configuration.useSerializer Configuration.useIdField "id"
{ new IDocumentSerializer with
member _.Serialize<'T>(it : 'T) = JsonSerializer.Serialize(it, Json.options)
member _.Deserialize<'T>(it : string) = JsonSerializer.Deserialize<'T>(it, Json.options)
}
let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0) Configuration.useSerializer
if not (List.contains Table.Church tables) then { new IDocumentSerializer with
do! Definition.ensureTable Table.Church member _.Serialize<'T>(it: 'T) =
if not (List.contains Table.Group tables) then JsonSerializer.Serialize(it, Json.options)
do! Definition.ensureTable Table.Group
do! Definition.ensureFieldIndex Table.Group "church" [ "churchId" ]
if not (List.contains Table.Member tables) then
do! Definition.ensureTable Table.Member
do! Definition.ensureFieldIndex Table.Member "group" [ "smallGroupId" ]
if not (List.contains Table.Request tables) then
do! Definition.ensureTable Table.Request
do! Definition.ensureFieldIndex Table.Request "group" [ "smallGroupId" ]
if not (List.contains Table.User tables) then
do! Definition.ensureTable Table.User
do! Definition.ensureFieldIndex Table.User "email" [ "email" ]
}
member _.Deserialize<'T>(it: string) =
JsonSerializer.Deserialize<'T>(it, Json.options) }
/// Helper functions for the PostgreSQL data implementation let! tables = Custom.list<string> "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
[<AutoOpen>]
module private Helpers =
/// Map a row to a Prayer Request instance if not (List.contains Table.Church tables) then
let mapToPrayerRequest (row : RowReader) = do! Definition.ensureTable Table.Church
{ Id = PrayerRequestId (row.uuid "id")
UserId = UserId (row.uuid "user_id") if not (List.contains Table.Group tables) then
SmallGroupId = SmallGroupId (row.uuid "small_group_id") do! Definition.ensureTable Table.Group
EnteredDate = row.fieldValue<Instant> "entered_date" do! Definition.ensureFieldIndex Table.Group "church" [ "churchId" ]
UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor" if not (List.contains Table.Member tables) then
Text = row.string "request_text" do! Definition.ensureTable Table.Member
NotifyChaplain = row.bool "notify_chaplain" do! Definition.ensureFieldIndex Table.Member "group" [ "smallGroupId" ]
RequestType = PrayerRequestType.Parse (row.string "request_type")
Expiration = Expiration.Parse (row.string "expiration") if not (List.contains Table.Request tables) then
do! Definition.ensureTable Table.Request
do! Definition.ensureFieldIndex Table.Request "group" [ "smallGroupId" ]
if not (List.contains Table.User tables) then
do! Definition.ensureTable Table.User
do! Definition.ensureFieldIndex Table.User "email" [ "email" ]
} }
/// Map a row to a Small Group information set
let mapToSmallGroupInfo (row : RowReader) = open Microsoft.Data.Sqlite
{ Id = Giraffe.ShortGuid.fromGuid (row.uuid "id")
Name = row.string "group_name" /// Functions to retrieve small group information
ChurchName = row.string "church_name" module SmallGroups =
TimeZoneId = TimeZoneId (row.string "time_zone_id")
IsPublic = row.bool "is_public" /// Query to retrieve data for a small group info instance
} let private infoQuery =
$"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->>'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 =
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 /// Map a row to a Small Group list item
let mapToSmallGroupItem (row : RowReader) = let private toSmallGroupItem (rdr: SqliteDataReader) =
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}""" (rdr.GetOrdinal >> rdr.GetString >> Guid.Parse >> Giraffe.ShortGuid.fromGuid) "id",
$"""{(rdr.GetOrdinal >> rdr.GetString) "churchName"} | {(rdr.GetOrdinal >> rdr.GetString) "groupName"}"""
/// Map a row to a User instance /// Get the group IDs for the given church
let mapToUser (row : RowReader) = let internal groupIdsByChurch (churchId: ChurchId) =
{ Id = UserId (row.uuid "id") backgroundTask {
FirstName = row.string "first_name" let! groups = Find.byFields<SmallGroup> Table.Group All [ Field.Equal "churchId" (string churchId) ]
LastName = row.string "last_name" return groups |> List.map _.Id
Email = row.string "email"
IsAdmin = row.bool "is_admin"
PasswordHash = row.string "password_hash"
LastSeen = row.fieldValueOrNone<Instant> "last_seen"
SmallGroups = []
} }
/// Count the number of small groups for a church
let countByChurch (churchId: ChurchId) =
Count.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
/// Delete a small group by its ID
let deleteById (groupId: SmallGroupId) =
backgroundTask {
use conn = Configuration.dbConn ()
use! txn = conn.BeginTransactionAsync()
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" (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->>'name'" [] SmallGroupInfo.FromReader
/// Get a list of small group IDs along with a description that includes the church name
let listAll () =
Custom.list $"{itemQuery} {itemOrderBy}" [] toSmallGroupItem
/// Get a list of small group IDs and descriptions for groups with a group password
let listProtected () =
Custom.list
$"{itemQuery} WHERE COALESCE(g.data->'preferences'->>'groupPassword', '') <> '' {itemOrderBy}"
[]
toSmallGroupItem
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
let listPublicAndProtected () =
Custom.list
$"{infoQuery}
WHERE g.data->'preferences'->>'isPublic' = TRUE
OR COALESCE(g.data->'preferences'->>'groupPassword', '') <> ''
{itemOrderBy}"
[]
SmallGroupInfo.FromReader
/// Log on for a small group (includes list preferences)
let logOn (groupId: SmallGroupId) (password: string) =
Find.firstByFields<SmallGroup>
Table.Group
All
[ 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 (string groupId) {| Preferences = pref |}
/// Get a small group by its ID (including list preferences)
let tryById groupId =
Find.byId<SmallGroupId, SmallGroup> Table.Group groupId
open BitBadger.Documents
open Npgsql
open Npgsql.FSharp
/// Functions to manipulate churches /// Functions to manipulate churches
module Churches = module Churches =
/// Get a list of all churches /// Get a list of all churches
let all () = let all () = Find.all<Church> Table.Church
Find.all<Church> Table.Church
/// Delete a church by its ID /// Delete a church by its ID
let deleteById (churchId: ChurchId) = backgroundTask { let deleteById churchId =
let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ] backgroundTask {
let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)" use conn = Configuration.dbConn ()
let! _ = use! txn = conn.BeginTransactionAsync()
BitBadger.Documents.Postgres.Configuration.dataSource ()
|> Sql.fromDataSource let! groupIds = SmallGroups.groupIdsByChurch churchId
|> Sql.executeTransactionAsync let gIdStrings = groupIds |> List.map string
[ $"DELETE FROM pt.prayer_request {where}", idParam
$"DELETE FROM pt.user_small_group {where}", idParam do! Delete.byFields Table.Request All [ Field.In "smallGroupId" gIdStrings ]
$"DELETE FROM pt.list_preference {where}", idParam
"DELETE FROM pt.small_group WHERE church_id = @churchId", idParam let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User gIdStrings ]
"DELETE FROM pt.church WHERE id = @churchId", idParam ]
() for user in users do
} do! Patch.byId Table.User (string user.Id) {| SmallGroups = user.SmallGroups |> List.except groupIds |}
do! Delete.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
do! Delete.byId Table.Church (string churchId)
do! txn.CommitAsync()
}
/// Save a church's information /// Save a church's information
let save church = let save church = save<Church> Table.Church church
save<Church> Table.Church church
/// Find a church by its ID /// Find a church by its ID
let tryById churchId = let tryById churchId =
@@ -188,20 +259,21 @@ module Members =
/// Count members for the given small group /// Count members for the given small group
let countByGroup (groupId: SmallGroupId) = 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 /// Delete a small group member by its ID
let deleteById (memberId: MemberId) = let deleteById (memberId: MemberId) = Delete.byId Table.Member (string memberId)
Delete.byId Table.Member memberId
/// Retrieve all members for a given small group /// Retrieve all members for a given small group
let forGroup (groupId : SmallGroupId) = let forGroup (groupId: SmallGroupId) =
Find.byFieldsOrdered<Member> Find.byFieldsOrdered<Member>
Table.Member All [ Field.Equal "smallGroupId" groupId ] [ Field.Named "memberName" ] Table.Member
All
[ Field.Equal "smallGroupId" (string groupId) ]
[ Field.Named "memberName" ]
/// Save a small group member /// Save a small group member
let save mbr = let save mbr = save<Member> Table.Member mbr
save<Member> Table.Member mbr
/// Retrieve a small group member by its ID /// Retrieve a small group member by its ID
let tryById memberId = let tryById memberId =
@@ -210,20 +282,21 @@ module Members =
/// Options to retrieve a list of requests /// Options to retrieve a list of requests
type PrayerRequestOptions = type PrayerRequestOptions =
{ /// The small group for which requests should be retrieved {
SmallGroup : SmallGroup /// The small group for which requests should be retrieved
SmallGroup: SmallGroup
/// The clock instance to use for date/time manipulation /// The clock instance to use for date/time manipulation
Clock : IClock Clock: IClock
/// The date for which the list is being retrieved /// The date for which the list is being retrieved
ListDate : LocalDate option ListDate: LocalDate option
/// Whether only active requests should be retrieved /// Whether only active requests should be retrieved
ActiveOnly : bool ActiveOnly: bool
/// The page number, for paged lists /// The page number, for paged lists
PageNumber : int PageNumber: int
} }
@@ -233,71 +306,82 @@ module PrayerRequests =
/// Central place to append sort criteria for prayer request queries /// Central place to append sort criteria for prayer request queries
let private orderBy sort = let private orderBy sort =
match sort with 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 /// Paginate a prayer request query
let private paginate (pageNbr : int) pageSize = let private paginate (pageNbr: int) pageSize =
if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else "" if pageNbr > 0 then
$"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}"
else
""
/// Count the number of prayer requests for a church /// 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" (List.map string 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 /// Count the number of prayer requests for a small group
let countByGroup (groupId: SmallGroupId) = 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 /// Delete a prayer request by its ID
let deleteById (reqId: PrayerRequestId) = let deleteById (reqId: PrayerRequestId) = Delete.byId Table.Request (string reqId)
Delete.byId Table.Request reqId
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
let forGroup (opts : PrayerRequestOptions) = let forGroup (opts: PrayerRequestOptions) =
let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock) let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock)
let where, parameters =
let sql, parameters =
if opts.ActiveOnly then if opts.ActiveOnly then
let asOf = NpgsqlParameter ( let expDate =
"@asOf",
(theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone) (theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire) - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ()) .ToInstant()
" AND ( updated_date > @asOf $"""AND ( date(data->>'updatedDate') > date(:updatedDate)
OR expiration = @manual OR data->>'expiration' = :expManual
OR request_type = @longTerm OR data->>'requestType' IN (:typLongTerm, :typExpecting))
OR request_type = @expecting) AND data->>'expiration' <> :expForced""",
AND expiration <> @forced", [ SqliteParameter(":updatedDate", string expDate)
[ "@asOf", Sql.parameter asOf SqliteParameter(":expManual", string Manual)
"@manual", Sql.string (string Manual) SqliteParameter(":typLongTerm", string LongTermRequest)
"@longTerm", Sql.string (string LongTermRequest) SqliteParameter(":typExpecting", string Expecting)
"@expecting", Sql.string (string Expecting) SqliteParameter(":expForced", string Forced) ]
"@forced", Sql.string (string Forced) ] else
else "", [] "", []
BitBadger.Documents.Postgres.Custom.list
$"SELECT * Custom.list
FROM pt.prayer_request $"SELECT data FROM {Table.Request}
WHERE small_group_id = @groupId {where} WHERE data->>'smallGroupId' = :groupId
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort} {sql}
{orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}" {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 /// Save a prayer request
let save req = let save req = save<PrayerRequest> Table.Request req
save<PrayerRequest> Table.Request req
/// Search prayer requests for the given term /// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr = let searchForGroup group searchTerm pageNbr =
BitBadger.Documents.Postgres.Custom.list let pct = "%"
$"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search Custom.list
UNION $"WITH results AS (
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search SELECT data FROM {Table.Request}
ORDER BY {orderBy group.Preferences.RequestSort} WHERE data->>'smallGroupId' = :groupId
AND data->>'text' LIKE :search
UNION
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}" {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 /// Retrieve a prayer request by its ID
let tryById reqId = let tryById reqId =
@@ -306,90 +390,13 @@ module PrayerRequests =
/// Update the expiration for the given prayer request /// Update the expiration for the given prayer request
let updateExpiration (req: PrayerRequest) withTime = let updateExpiration (req: PrayerRequest) withTime =
if withTime then if withTime then
Patch.byId Table.Request req.Id {| UpdatedDate = req.UpdatedDate; Expiration = req.Expiration |} Patch.byId
Table.Request
(string req.Id)
{| UpdatedDate = req.UpdatedDate
Expiration = req.Expiration |}
else else
Patch.byId Table.Request req.Id {| Expiration = req.Expiration |} Patch.byId Table.Request (string req.Id) {| Expiration = req.Expiration |}
/// Functions to retrieve small group information
module SmallGroups =
/// Count the number of small groups for a church
let countByChurch (churchId: ChurchId) =
Count.byFields Table.Group All [ Field.Equal "churchId" churchId ]
/// Delete a small group by its ID
let deleteById (groupId: SmallGroupId) = backgroundTask {
use conn = Configuration.dbConn ()
use txn = conn.BeginTransaction()
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ 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! txn.CommitAsync()
}
/// Get information for all small groups
let infoForAll () =
BitBadger.Documents.Postgres.Custom.list
"SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group sg
INNER JOIN pt.church c ON c.id = sg.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
ORDER BY sg.group_name"
[] mapToSmallGroupInfo
/// Get a list of small group IDs along with a description that includes the church name
let listAll () =
BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
ORDER BY c.church_name, g.group_name"
[] mapToSmallGroupItem
/// Get a list of small group IDs and descriptions for groups with a group password
let listProtected () =
BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name, lp.is_public
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
WHERE COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name"
[] mapToSmallGroupItem
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
let listPublicAndProtected () =
BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
WHERE lp.is_public = TRUE
OR COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name"
[] mapToSmallGroupInfo
/// Log on for a small group (includes list preferences)
let logOn (groupId: SmallGroupId) (password: string) =
Find.firstByFields<SmallGroup>
Table.Group All [ Field.Equal "id" 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 (pref: ListPreferences) =
Patch.byId Table.Group pref.SmallGroupId {| Preferences = pref |}
/// Get a small group by its ID (including list preferences)
let tryById groupId =
Find.byId<SmallGroupId, SmallGroup> Table.Group groupId
/// Functions to manipulate users /// Functions to manipulate users
@@ -400,44 +407,37 @@ module Users =
Find.allOrdered<User> Table.User [ Field.Named "lastName"; Field.Named "firstName" ] Find.allOrdered<User> Table.User [ Field.Named "lastName"; Field.Named "firstName" ]
/// Count the number of users for a church /// Count the number of users for a church
let countByChurch (churchId : ChurchId) = let countByChurch churchId =
BitBadger.Documents.Postgres.Custom.scalar backgroundTask {
"SELECT COUNT(u.id) AS user_count let! groupIds = SmallGroups.groupIdsByChurch churchId
FROM pt.pt_user u return! Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User (List.map string groupIds) ]
WHERE EXISTS ( }
SELECT 1
FROM pt.user_small_group usg
INNER JOIN pt.small_group sg ON sg.id = usg.small_group_id
WHERE usg.user_id = u.id
AND sg.church_id = @churchId)"
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "user_count")
/// Count the number of users for a small group /// Count the number of users for a small group
let countByGroup (groupId: SmallGroupId) = 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 /// Delete a user by its database ID
let deleteById (userId: UserId) = let deleteById (userId: UserId) = Delete.byId Table.User (string userId)
Delete.byId Table.User userId
/// Get a list of users authorized to administer the given small group /// Get a list of users authorized to administer the given small group
let listByGroupId (groupId : SmallGroupId) = let listByGroupId (groupId: SmallGroupId) =
BitBadger.Documents.Postgres.Custom.list Find.byFieldsOrdered<User>
"SELECT u.* Table.User
FROM pt.pt_user u All
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
WHERE usg.small_group_id = @groupId [ Field.Named "lastName"; Field.Named "firstName" ]
ORDER BY u.last_name, u.first_name"
[ "@groupId", Sql.uuid groupId.Value ] mapToUser
/// Save a user's information /// Save a user's information
let save user = let save user = save<User> Table.User user
save<User> Table.User user
/// Find a user by its e-mail address and authorized small group /// Find a user by its e-mail address and authorized small group
let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) = let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) =
Find.firstByFields<User> Find.firstByFields<User>
Table.User All [ Field.Equal "email" email; Field.InArray "smallGroups" Table.User [ groupId ] ] Table.User
All
[ Field.Equal "email" email
Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
/// Find a user by their database ID /// Find a user by their database ID
let tryById userId = let tryById userId =
@@ -445,12 +445,12 @@ module Users =
/// Update a user's last seen date/time /// Update a user's last seen date/time
let updateLastSeen (userId: UserId) (now: Instant) = 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 /// Update a user's password hash
let updatePassword (user: User) = 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 /// Update a user's authorized small groups
let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) = let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) =
Patch.byId Table.User userId {| SmallGroups = groupIds |} Patch.byId Table.User (string userId) {| SmallGroups = groupIds |}

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

View File

@@ -209,6 +209,8 @@ type UserId =
(*-- SPECIFIC VIEW TYPES --*) (*-- SPECIFIC VIEW TYPES --*)
open Microsoft.Data.Sqlite
/// Statistics for churches /// Statistics for churches
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type ChurchStats = type ChurchStats =
@@ -225,7 +227,7 @@ type ChurchStats =
/// Information needed to display the public/protected request list and small group maintenance pages /// Information needed to display the public/protected request list and small group maintenance pages
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type SmallGroupInfo = type SmallGroupInfo =
{ {
/// The ID of the small group /// The ID of the small group
@@ -244,12 +246,21 @@ type SmallGroupInfo =
IsPublic: bool IsPublic: bool
} }
/// Map a row to a Small Group information set
static member FromReader (rdr: SqliteDataReader) =
{ Id = Giraffe.ShortGuid.fromGuid ((rdr.GetOrdinal >> rdr.GetString >> Guid.Parse) "id")
Name = (rdr.GetOrdinal >> rdr.GetString) "groupName"
ChurchName = (rdr.GetOrdinal >> rdr.GetString) "churchName"
TimeZoneId = (rdr.GetOrdinal >> rdr.GetString >> TimeZoneId) "timeZoneId"
IsPublic = (rdr.GetOrdinal >> rdr.GetBoolean) "isPublic" }
(*-- ENTITIES --*) (*-- ENTITIES --*)
open NodaTime open NodaTime
/// This represents a church /// This represents a church
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Church = type Church =
{ {
/// The ID of this church /// The ID of this church
@@ -286,9 +297,6 @@ type Church =
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type ListPreferences = type ListPreferences =
{ {
/// The Id of the small group to which these preferences belong
SmallGroupId: SmallGroupId
/// The days after which regular requests expire /// The days after which regular requests expire
DaysToExpire: int DaysToExpire: int
@@ -350,8 +358,7 @@ type ListPreferences =
/// A set of preferences with their default values /// A set of preferences with their default values
static member Empty = static member Empty =
{ SmallGroupId = SmallGroupId Guid.Empty { DaysToExpire = 14
DaysToExpire = 14
DaysToKeepNew = 7 DaysToKeepNew = 7
LongTermUpdateWeeks = 4 LongTermUpdateWeeks = 4
EmailFromName = "PrayerTracker" EmailFromName = "PrayerTracker"
@@ -371,7 +378,7 @@ type ListPreferences =
/// A member of a small group /// A member of a small group
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Member = type Member =
{ {
/// The ID of the small group member /// The ID of the small group member
@@ -400,7 +407,7 @@ type Member =
/// This represents a small group (Sunday School class, Bible study group, etc.) /// This represents a small group (Sunday School class, Bible study group, etc.)
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type SmallGroup = type SmallGroup =
{ {
/// The ID of this small group /// The ID of this small group
@@ -444,7 +451,7 @@ type SmallGroup =
/// This represents a single prayer request /// This represents a single prayer request
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type PrayerRequest = type PrayerRequest =
{ {
/// The ID of this request /// The ID of this request
@@ -515,7 +522,7 @@ type PrayerRequest =
/// This represents a user of PrayerTracker /// This represents a user of PrayerTracker
[<NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type User = type User =
{ {
/// The ID of this user /// The ID of this user
@@ -556,20 +563,3 @@ type User =
PasswordHash = "" PasswordHash = ""
LastSeen = None LastSeen = None
SmallGroups = [] } SmallGroups = [] }
/// Cross-reference between user and small group
[<NoComparison; NoEquality>]
type UserSmallGroup =
{
/// The Id of the user who has access to the small group
UserId: UserId
/// The Id of the small group to which the user has access
SmallGroupId: SmallGroupId
}
/// An empty user/small group xref
static member Empty =
{ UserId = UserId Guid.Empty
SmallGroupId = SmallGroupId Guid.Empty }

View File

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

View File

@@ -1,15 +1,15 @@
FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
WORKDIR /pt WORKDIR /pt
COPY ./PrayerTracker.sln ./ COPY ./PrayerTracker.sln ./
COPY ./Directory.Build.props ./ COPY ./Directory.Build.props ./
COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/ COPY ./Data/PrayerTracker.Data.fsproj ./Data/
COPY ./Data/PrayerTracker.Data.fsproj ./Data/ COPY ./UI/PrayerTracker.UI.fsproj ./UI/
COPY ./PrayerTracker.Tests/PrayerTracker.Tests.fsproj ./PrayerTracker.Tests/ COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/
COPY ./UI/PrayerTracker.UI.fsproj ./UI/ COPY ./Tests/PrayerTracker.Tests.fsproj ./Tests/
RUN dotnet restore RUN dotnet restore
COPY . ./ COPY . ./
WORKDIR /pt/PrayerTracker.Tests WORKDIR /pt/Tests
RUN dotnet run RUN dotnet run
WORKDIR /pt/PrayerTracker WORKDIR /pt/PrayerTracker

View File

@@ -15,6 +15,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" /> <PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" />
<PackageReference Include="Npgsql.NodaTime" Version="9.0.2" />
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@@ -39,8 +39,7 @@ module PgMappings =
ChurchId = ChurchId (row.uuid "church_id") ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name" Name = row.string "group_name"
Preferences = Preferences =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id") { DaysToKeepNew = row.int "days_to_keep_new"
DaysToKeepNew = row.int "days_to_keep_new"
DaysToExpire = row.int "days_to_expire" DaysToExpire = row.int "days_to_expire"
LongTermUpdateWeeks = row.int "long_term_update_weeks" LongTermUpdateWeeks = row.int "long_term_update_weeks"
EmailFromName = row.string "email_from_name" EmailFromName = row.string "email_from_name"
@@ -81,7 +80,9 @@ task {
Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN") Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN")
do! Connection.setUp () 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 = let! churches =
Sql.fromDataSource source Sql.fromDataSource source
@@ -123,8 +124,8 @@ task {
for user in users do for user in users do
let! groups = let! groups =
Sql.fromDataSource source Sql.fromDataSource source
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = :user_id" |> 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.parameters [ "@user_id", Sql.uuid user.Id.Value ]
|> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id") |> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id")
do! Users.save { user with SmallGroups = groups } do! Users.save { user with SmallGroups = groups }
printfn "Migrated %d users" users.Length printfn "Migrated %d users" users.Length

View File

@@ -7,7 +7,7 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTrac
EndProject EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}" Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}"
EndProject EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "PrayerTracker.Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}" Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}"
EndProject EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}" Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}"
EndProject EndProject

View File

@@ -40,10 +40,9 @@ module Configure =
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Localization open Microsoft.AspNetCore.Localization
open Microsoft.Extensions.Caching.Distributed
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open NeoSmart.Caching.Sqlite
open NodaTime open NodaTime
open Npgsql
open PrayerTracker.Data open PrayerTracker.Data
/// Configure ASP.NET Core's service collection (dependency injection container) /// Configure ASP.NET Core's service collection (dependency injection container)
@@ -85,8 +84,10 @@ module Configure =
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then
ConfigurationBinder.Bind(emailCfg, Email.smtpOptions) 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.AddSession()
let _ = svc.AddLogging()
let _ = svc.AddAntiforgery() let _ = svc.AddAntiforgery()
let _ = svc.AddRouting() let _ = svc.AddRouting()
let _ = svc.AddSingleton<IClock> SystemClock.Instance let _ = svc.AddSingleton<IClock> SystemClock.Instance
@@ -219,8 +220,8 @@ module Configure =
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
/// Configure the application /// Configure the application
let app (app: IApplicationBuilder) = let app (app: WebApplication) =
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>() let env = app.Services.GetRequiredService<IWebHostEnvironment>()
if env.IsDevelopment() then if env.IsDevelopment() then
app.UseDeveloperExceptionPage() app.UseDeveloperExceptionPage()
@@ -232,24 +233,20 @@ module Configure =
let _ = app.UseCanonicalDomains() let _ = app.UseCanonicalDomains()
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}" let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
let _ = app.UseStaticFiles() let _ = app.UseStaticFiles()
let _ = app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ =
app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<RequestStartMiddleware>() let _ = app.UseMiddleware<RequestStartMiddleware>()
let _ = app.UseRouting() let _ = app.UseRouting()
let _ = app.UseSession() let _ = app.UseSession()
let _ = app.UseRequestLocalization(app.Services.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ =
app.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseAuthentication() let _ = app.UseAuthentication()
let _ = app.UseAuthorization() let _ = app.UseAuthorization()
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes) let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>() app.Services.GetRequiredService<IStringLocalizerFactory>()
|> Views.I18N.setUpFactories |> Views.I18N.setUpFactories
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging
/// The web application /// The web application
module App = module App =
@@ -258,22 +255,32 @@ module App =
[<EntryPoint>] [<EntryPoint>]
let main args = let main args =
let contentRoot = Directory.GetCurrentDirectory()
let app = let contentRoot = Directory.GetCurrentDirectory()
WebHostBuilder() let builder =
.UseContentRoot(contentRoot) WebApplication.CreateBuilder(
WebApplicationOptions(
Args = args,
ApplicationName = "PrayerTracker",
ContentRootPath = contentRoot,
WebRootPath = Path.Combine(contentRoot, "wwwroot")))
let _ =
builder.WebHost
.ConfigureAppConfiguration(Configure.configuration) .ConfigureAppConfiguration(Configure.configuration)
.UseKestrel(Configure.kestrel) .ConfigureKestrel(Configure.kestrel)
.UseWebRoot(Path.Combine(contentRoot, "wwwroot"))
.ConfigureServices(Configure.services) .ConfigureServices(Configure.services)
.ConfigureLogging(Configure.logging) .ConfigureLogging(Configure.logging)
.Configure(System.Action<IApplicationBuilder> Configure.app)
.Build()
if args.Length > 0 then use app = builder.Build()
printfn $"Unrecognized option {args[0]}"
else Configure.app app
app.Run()
let fac = app.Services.GetRequiredService<ILoggerFactory>()
let log = fac.CreateLogger "PrayerTracker"
log.LogInformation "Application Started"
app.Run()
log.LogInformation "Application Shutting Down"
0 0

View File

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

View File

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

View File

@@ -27,7 +27,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" /> <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" /> <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" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>

View File

@@ -230,7 +230,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
match! SmallGroups.tryById group.Id with match! SmallGroups.tryById group.Id with
| Some group -> | Some group ->
let pref = model.PopulatePreferences group.Preferences let pref = model.PopulatePreferences group.Preferences
do! SmallGroups.savePreferences pref do! SmallGroups.savePreferences group.Id pref
// Refresh session instance // Refresh session instance
ctx.Session.CurrentGroup <- Some { group with Preferences = pref } ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
addInfo ctx ctx.Strings["Group preferences updated successfully"] addInfo ctx ctx.Strings["Group preferences updated successfully"]

View File

View File

@@ -121,7 +121,6 @@ let listPreferencesTests =
} }
test "Empty is as expected" { test "Empty is as expected" {
let mt = ListPreferences.Empty let mt = ListPreferences.Empty
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14" Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14"
Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7" Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7"
Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4" Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4"
@@ -367,13 +366,3 @@ let userTests =
Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space" Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space"
} }
] ]
[<Tests>]
let userSmallGroupTests =
testList "UserSmallGroup" [
test "Empty is as expected" {
let mt = UserSmallGroup.Empty
Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
}
]

View File

@@ -182,13 +182,6 @@ let toHtmlIds it =
let renderHtmlNode = RenderView.AsString.htmlNode 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 open Microsoft.AspNetCore.Html
/// Render an HTML node, then return the value as an HTML string /// Render an HTML node, then return the value as an HTML string
@@ -224,6 +217,10 @@ module TimeZones =
open Giraffe.ViewEngine.Htmx 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 /// Known htmx targets
module Target = module Target =

View File

@@ -274,11 +274,11 @@ let private partialHead pgTitle =
let private pageLayout viewInfo pgTitle content = let private pageLayout viewInfo pgTitle content =
body [] [ body [] [
Navigation.top viewInfo 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 match viewInfo.Layout with
| FullPage -> | FullPage ->
script [ _src "/js/ckeditor/ckeditor.js" ] [] script [ _src "/js/ckeditor/ckeditor.js" ] []
script [ _src "/_/fixi-0.5.7.js" ] [] Htmx.Script.minified
script [ _src "/_/app.js" ] [] script [ _src "/_/app.js" ] []
| _ -> () ] | _ -> () ]
@@ -348,4 +348,3 @@ let help pageTitle isHome content =
p [ _class "pt-center-text" ] [ p [ _class "pt-center-text" ] [
a [ _href "/help"; _title s["Help Index"].Value ] [ a [ _href "/help"; _title s["Help Index"].Value ] [
rawText "&#xab; "; locStr s["Back to Help Index"] ] ] ] ] ] ] ] rawText "&#xab; "; locStr s["Back to Help Index"] ] ] ] ] ] ] ]

View File

@@ -15,15 +15,9 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe.Fixi" Version="0.5.7" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="MailKit" Version="4.10.0" /> <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" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>