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

Being migrating application to doc lib (#55)

Browse Source
This commit is contained in:
Daniel J. Summers 2025-01-30 23:01:49 -05:00
parent 194cd2b5cc
commit d86249c18e
8 changed files with 177 additions and 329 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

445
src/PrayerTracker.Data/Access.fs
View File

@ -1,8 +1,7 @@
namespace PrayerTracker.Data namespace PrayerTracker.Data
open System
open NodaTime open NodaTime
open Npgsql
open Npgsql.FSharp
open PrayerTracker.Entities open PrayerTracker.Entities
/// Table names /// Table names
@ -30,51 +29,75 @@ module Table =
let User = "pt_user" let User = "pt_user"
/// JSON serialization customizations
[<RequireQualifiedAccess>]
module Json =
open System.Text.Json.Serialization
/// Convert a wrapped DU to/from its string representation
type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<'T>()
override _.Read(reader, _, _) =
wrap (reader.GetString())
override _.Write(writer, value, _) =
writer.WriteStringValue(unwrap value)
open System.Text.Json
open NodaTime.Serialization.SystemTextJson
/// JSON serializer options to support the target domain
let options =
let opts = JsonSerializerOptions()
[ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter
WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string)
WrappedJsonConverter<Expiration>(Expiration.Parse, string)
WrappedJsonConverter<PrayerRequestType>(PrayerRequestType.Parse, string)
WrappedJsonConverter<RequestSort>(RequestSort.Parse, string)
WrappedJsonConverter<TimeZoneId>(TimeZoneId, string)
WrappedJsonConverter<ChurchId>(Guid.Parse >> ChurchId, string)
WrappedJsonConverter<MemberId>(Guid.Parse >> MemberId, string)
WrappedJsonConverter<PrayerRequestId>(Guid.Parse >> PrayerRequestId, string)
WrappedJsonConverter<SmallGroupId>(Guid.Parse >> SmallGroupId, string)
WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string)
JsonFSharpConverter() ]
|> List.iter opts.Converters.Add
let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
opts
open BitBadger.Documents.Sqlite
/// Establish the required data environment
[<RequireQualifiedAccess>]
module Environment =
/// Ensure tables and indexes are defined
let setUp () = backgroundTask {
let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0)
if not (List.contains Table.Church tables) then
do! Definition.ensureTable Table.Church
if not (List.contains Table.Group tables) then
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" ]
}
/// Helper functions for the PostgreSQL data implementation /// Helper functions for the PostgreSQL data implementation
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
/// Map a row to a Church instance
let mapToChurch (row : RowReader) =
{ Id = ChurchId (row.uuid "id")
Name = row.string "church_name"
City = row.string "city"
State = row.string "state"
HasVpsInterface = row.bool "has_vps_interface"
InterfaceAddress = row.stringOrNone "interface_address"
}
/// Map a row to a ListPreferences instance
let mapToListPreferences (row : RowReader) =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id")
DaysToKeepNew = row.int "days_to_keep_new"
DaysToExpire = row.int "days_to_expire"
LongTermUpdateWeeks = row.int "long_term_update_weeks"
EmailFromName = row.string "email_from_name"
EmailFromAddress = row.string "email_from_address"
Fonts = row.string "fonts"
HeadingColor = row.string "heading_color"
LineColor = row.string "line_color"
HeadingFontSize = row.int "heading_font_size"
TextFontSize = row.int "text_font_size"
GroupPassword = row.string "group_password"
IsPublic = row.bool "is_public"
PageSize = row.int "page_size"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
RequestSort = RequestSort.Parse (row.string "request_sort")
DefaultEmailType = EmailFormat.Parse (row.string "default_email_type")
AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display")
}
/// Map a row to a Member instance
let mapToMember (row : RowReader) =
{ Id = MemberId (row.uuid "id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
Name = row.string "member_name"
Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse
}
/// Map a row to a Prayer Request instance /// Map a row to a Prayer Request instance
let mapToPrayerRequest (row : RowReader) = let mapToPrayerRequest (row : RowReader) =
{ Id = PrayerRequestId (row.uuid "id") { Id = PrayerRequestId (row.uuid "id")
@ -89,14 +112,6 @@ module private Helpers =
Expiration = Expiration.Parse (row.string "expiration") Expiration = Expiration.Parse (row.string "expiration")
} }
/// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) =
{ Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name"
Preferences = ListPreferences.Empty
}
/// Map a row to a Small Group information set /// Map a row to a Small Group information set
let mapToSmallGroupInfo (row : RowReader) = let mapToSmallGroupInfo (row : RowReader) =
{ Id = Giraffe.ShortGuid.fromGuid (row.uuid "id") { Id = Giraffe.ShortGuid.fromGuid (row.uuid "id")
@ -110,12 +125,6 @@ module private Helpers =
let mapToSmallGroupItem (row : RowReader) = let mapToSmallGroupItem (row : RowReader) =
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}""" Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}"""
/// Map a row to a Small Group instance with populated list preferences
let mapToSmallGroupWithPreferences (row : RowReader) =
{ mapToSmallGroup row with
Preferences = mapToListPreferences row
}
/// Map a row to a User instance /// Map a row to a User instance
let mapToUser (row : RowReader) = let mapToUser (row : RowReader) =
{ Id = UserId (row.uuid "id") { Id = UserId (row.uuid "id")
@ -129,21 +138,23 @@ module private Helpers =
} }
open BitBadger.Documents.Postgres 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 () =
Custom.list "SELECT * FROM pt.church ORDER BY church_name" [] mapToChurch 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: ChurchId) = backgroundTask {
let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ] let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ]
let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)" let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
let! _ = let! _ =
Configuration.dataSource () BitBadger.Documents.Postgres.Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
[ $"DELETE FROM pt.prayer_request {where}", idParam [ $"DELETE FROM pt.prayer_request {where}", idParam
@ -155,67 +166,37 @@ module Churches =
} }
/// Save a church's information /// Save a church's information
let save (church : Church) = let save church =
Custom.nonQuery save<Church> Table.Church church
"INSERT INTO pt.church (
id, church_name, city, state, has_vps_interface, interface_address
) VALUES (
@id, @name, @city, @state, @hasVpsInterface, @interfaceAddress
) ON CONFLICT (id) DO UPDATE
SET church_name = EXCLUDED.church_name,
city = EXCLUDED.city,
state = EXCLUDED.state,
has_vps_interface = EXCLUDED.has_vps_interface,
interface_address = EXCLUDED.interface_address"
[ "@id", Sql.uuid church.Id.Value
"@name", Sql.string church.Name
"@city", Sql.string church.City
"@state", Sql.string church.State
"@hasVpsInterface", Sql.bool church.HasVpsInterface
"@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ]
/// Find a church by its ID /// Find a church by its ID
let tryById (churchId : ChurchId) = let tryById churchId =
Custom.single "SELECT * FROM pt.church WHERE id = @id" [ "@id", Sql.uuid churchId.Value ] mapToChurch Find.byId<ChurchId, Church> Table.Church churchId
/// Functions to manipulate small group members /// Functions to manipulate small group members
module Members = module Members =
/// Count members for the given small group /// Count members for the given small group
let countByGroup (groupId : SmallGroupId) = let countByGroup (groupId: SmallGroupId) =
Custom.scalar "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId" Count.byFields Table.Member All [ Field.Equal "smallGroupId" groupId ]
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "mbr_count")
/// Delete a small group member by its ID /// Delete a small group member by its ID
let deleteById (memberId : MemberId) = let deleteById (memberId: MemberId) =
Custom.nonQuery "DELETE FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] 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) =
Custom.list "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name" Find.byFieldsOrdered<Member>
[ "@groupId", Sql.uuid groupId.Value ] mapToMember Table.Member All [ Field.Equal "smallGroupId" groupId ] [ Field.Named "memberName" ]
/// Save a small group member /// Save a small group member
let save (mbr : Member) = let save mbr =
Custom.nonQuery save<Member> Table.Member mbr
"INSERT INTO pt.member (
id, small_group_id, member_name, email, email_format
) VALUES (
@id, @groupId, @name, @email, @format
) ON CONFLICT (id) DO UPDATE
SET member_name = EXCLUDED.member_name,
email = EXCLUDED.email,
email_format = EXCLUDED.email_format"
[ "@id", Sql.uuid mbr.Id.Value
"@groupId", Sql.uuid mbr.SmallGroupId.Value
"@name", Sql.string mbr.Name
"@email", Sql.string mbr.Email
"@format", Sql.stringOrNone (mbr.Format |> Option.map string) ]
/// Retrieve a small group member by its ID /// Retrieve a small group member by its ID
let tryById (memberId : MemberId) = let tryById memberId =
Custom.single "SELECT * FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] mapToMember Find.byId<MemberId, Member> Table.Member memberId
/// Options to retrieve a list of requests /// Options to retrieve a list of requests
@ -252,20 +233,19 @@ module PrayerRequests =
/// 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 : ChurchId) =
Custom.scalar BitBadger.Documents.Postgres.Custom.scalar
"SELECT COUNT(id) AS req_count "SELECT COUNT(id) AS req_count
FROM pt.prayer_request FROM pt.prayer_request
WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)" 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") [ "@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) =
Custom.scalar "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId" Count.byFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "req_count")
/// Delete a prayer request by its ID /// Delete a prayer request by its ID
let deleteById (reqId : PrayerRequestId) = let deleteById (reqId: PrayerRequestId) =
Custom.nonQuery "DELETE FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] 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) =
@ -288,7 +268,7 @@ module PrayerRequests =
"@expecting", Sql.string (string Expecting) "@expecting", Sql.string (string Expecting)
"@forced", Sql.string (string Forced) ] "@forced", Sql.string (string Forced) ]
else "", [] else "", []
Custom.list BitBadger.Documents.Postgres.Custom.list
$"SELECT * $"SELECT *
FROM pt.prayer_request FROM pt.prayer_request
WHERE small_group_id = @groupId {where} WHERE small_group_id = @groupId {where}
@ -297,35 +277,12 @@ module PrayerRequests =
(("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) mapToPrayerRequest (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) mapToPrayerRequest
/// Save a prayer request /// Save a prayer request
let save (req : PrayerRequest) = let save req =
Custom.nonQuery save<PrayerRequest> Table.Request req
"INSERT into pt.prayer_request (
id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text,
notify_chaplain, expiration
) VALUES (
@id, @type, @userId, @groupId, @entered, @updated, @requestor, @text,
@notifyChaplain, @expiration
) ON CONFLICT (id) DO UPDATE
SET request_type = EXCLUDED.request_type,
updated_date = EXCLUDED.updated_date,
requestor = EXCLUDED.requestor,
request_text = EXCLUDED.request_text,
notify_chaplain = EXCLUDED.notify_chaplain,
expiration = EXCLUDED.expiration"
[ "@id", Sql.uuid req.Id.Value
"@type", Sql.string (string req.RequestType)
"@userId", Sql.uuid req.UserId.Value
"@groupId", Sql.uuid req.SmallGroupId.Value
"@entered", Sql.parameter (NpgsqlParameter("@entered", req.EnteredDate))
"@updated", Sql.parameter (NpgsqlParameter("@updated", req.UpdatedDate))
"@requestor", Sql.stringOrNone req.Requestor
"@text", Sql.string req.Text
"@notifyChaplain", Sql.bool req.NotifyChaplain
"@expiration", Sql.string (string req.Expiration) ]
/// Search prayer requests for the given term /// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr = let searchForGroup group searchTerm pageNbr =
Custom.list BitBadger.Documents.Postgres.Custom.list
$"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search $"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
UNION UNION
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search
@ -334,35 +291,29 @@ module PrayerRequests =
[ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] mapToPrayerRequest [ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] mapToPrayerRequest
/// Retrieve a prayer request by its ID /// Retrieve a prayer request by its ID
let tryById (reqId : PrayerRequestId) = let tryById reqId =
Custom.single "SELECT * FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] Find.byId<PrayerRequestId, PrayerRequest> Table.Request reqId
mapToPrayerRequest
/// 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 =
let sql, parameters = if withTime then
if withTime then Patch.byId Table.Request req.Id {| UpdatedDate = req.UpdatedDate; Expiration = req.Expiration |}
", updated_date = @updated", else
[ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ] Patch.byId Table.Request req.Id {| Expiration = req.Expiration |}
else "", []
Custom.nonQuery $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id"
([ "@expiration", Sql.string (string req.Expiration); "@id", Sql.uuid req.Id.Value ]
|> List.append parameters)
/// Functions to retrieve small group information /// Functions to retrieve small group information
module SmallGroups = module SmallGroups =
/// Count the number of small groups for a church /// Count the number of small groups for a church
let countByChurch (churchId : ChurchId) = let countByChurch (churchId: ChurchId) =
Custom.scalar "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId" Count.byFields Table.Group All [ Field.Equal "churchId" churchId ]
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "group_count")
/// Delete a small group by its ID /// Delete a small group by its ID
let deleteById (groupId : SmallGroupId) = backgroundTask { let deleteById (groupId : SmallGroupId) = backgroundTask {
let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ] let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ]
let! _ = let! _ =
Configuration.dataSource () BitBadger.Documents.Postgres.Configuration.dataSource ()
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
[ "DELETE FROM pt.prayer_request WHERE small_group_id = @groupId", idParam [ "DELETE FROM pt.prayer_request WHERE small_group_id = @groupId", idParam
@ -374,7 +325,7 @@ module SmallGroups =
/// Get information for all small groups /// Get information for all small groups
let infoForAll () = let infoForAll () =
Custom.list BitBadger.Documents.Postgres.Custom.list
"SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public "SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group sg FROM pt.small_group sg
INNER JOIN pt.church c ON c.id = sg.church_id INNER JOIN pt.church c ON c.id = sg.church_id
@ -384,7 +335,7 @@ module SmallGroups =
/// Get a list of small group IDs along with a description that includes the church name /// Get a list of small group IDs along with a description that includes the church name
let listAll () = let listAll () =
Custom.list BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name "SELECT g.group_name, g.id, c.church_name
FROM pt.small_group g FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id INNER JOIN pt.church c ON c.id = g.church_id
@ -393,7 +344,7 @@ module SmallGroups =
/// Get a list of small group IDs and descriptions for groups with a group password /// Get a list of small group IDs and descriptions for groups with a group password
let listProtected () = let listProtected () =
Custom.list BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name, lp.is_public "SELECT g.group_name, g.id, c.church_name, lp.is_public
FROM pt.small_group g FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id INNER JOIN pt.church c ON c.id = g.church_id
@ -404,7 +355,7 @@ module SmallGroups =
/// Get a list of small group IDs and descriptions for groups that are public or have a group password /// Get a list of small group IDs and descriptions for groups that are public or have a group password
let listPublicAndProtected () = let listPublicAndProtected () =
Custom.list BitBadger.Documents.Postgres.Custom.list
"SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public "SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group g FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id INNER JOIN pt.church c ON c.id = g.church_id
@ -415,91 +366,21 @@ module SmallGroups =
[] mapToSmallGroupInfo [] mapToSmallGroupInfo
/// Log on for a small group (includes list preferences) /// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password = let logOn (groupId: SmallGroupId) (password: string) =
Custom.single Find.firstByFields<SmallGroup>
"SELECT sg.*, lp.* Table.Group All [ Field.Equal "id" groupId; Field.Equal "preferences.groupPassword" password ]
FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id
AND lp.group_password = @password"
[ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ] mapToSmallGroupWithPreferences
/// Save a small group /// Save a small group
let save (group : SmallGroup) isNew = backgroundTask { let save group =
let! _ = save<SmallGroup> Table.Group group
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
"INSERT INTO pt.small_group (
id, church_id, group_name
) VALUES (
@id, @churchId, @name
) ON CONFLICT (id) DO UPDATE
SET church_id = EXCLUDED.church_id,
group_name = EXCLUDED.group_name",
[ [ "@id", Sql.uuid group.Id.Value
"@churchId", Sql.uuid group.ChurchId.Value
"@name", Sql.string group.Name ] ]
if isNew then
"INSERT INTO pt.list_preference (small_group_id) VALUES (@id)",
[ [ "@id", Sql.uuid group.Id.Value ] ]
]
()
}
/// Save a small group's list preferences /// Save a small group's list preferences
let savePreferences (pref : ListPreferences) = let savePreferences (pref: ListPreferences) =
Custom.nonQuery Patch.byId Table.Group pref.SmallGroupId {| Preferences = pref |}
"UPDATE pt.list_preference
SET days_to_keep_new = @daysToKeepNew,
days_to_expire = @daysToExpire,
long_term_update_weeks = @longTermUpdateWeeks,
email_from_name = @emailFromName,
email_from_address = @emailFromAddress,
fonts = @fonts,
heading_color = @headingColor,
line_color = @lineColor,
heading_font_size = @headingFontSize,
text_font_size = @textFontSize,
request_sort = @requestSort,
group_password = @groupPassword,
default_email_type = @defaultEmailType,
is_public = @isPublic,
time_zone_id = @timeZoneId,
page_size = @pageSize,
as_of_date_display = @asOfDateDisplay
WHERE small_group_id = @groupId"
[ "@groupId", Sql.uuid pref.SmallGroupId.Value
"@daysToKeepNew", Sql.int pref.DaysToKeepNew
"@daysToExpire", Sql.int pref.DaysToExpire
"@longTermUpdateWeeks", Sql.int pref.LongTermUpdateWeeks
"@emailFromName", Sql.string pref.EmailFromName
"@emailFromAddress", Sql.string pref.EmailFromAddress
"@fonts", Sql.string pref.Fonts
"@headingColor", Sql.string pref.HeadingColor
"@lineColor", Sql.string pref.LineColor
"@headingFontSize", Sql.int pref.HeadingFontSize
"@textFontSize", Sql.int pref.TextFontSize
"@requestSort", Sql.string (string pref.RequestSort)
"@groupPassword", Sql.string pref.GroupPassword
"@defaultEmailType", Sql.string (string pref.DefaultEmailType)
"@isPublic", Sql.bool pref.IsPublic
"@timeZoneId", Sql.string (string pref.TimeZoneId)
"@pageSize", Sql.int pref.PageSize
"@asOfDateDisplay", Sql.string (string pref.AsOfDateDisplay) ]
/// Get a small group by its ID /// Get a small group by its ID (including list preferences)
let tryById (groupId : SmallGroupId) = let tryById groupId =
Custom.single "SELECT * FROM pt.small_group WHERE id = @id" [ "@id", Sql.uuid groupId.Value ] mapToSmallGroup Find.byId<SmallGroupId, SmallGroup> Table.Group groupId
/// Get a small group by its ID with its list preferences populated
let tryByIdWithPreferences (groupId : SmallGroupId) =
Custom.single
"SELECT sg.*, lp.*
FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id"
[ "@id", Sql.uuid groupId.Value ] mapToSmallGroupWithPreferences
/// Functions to manipulate users /// Functions to manipulate users
@ -507,11 +388,11 @@ module Users =
/// Retrieve all PrayerTracker users /// Retrieve all PrayerTracker users
let all () = let all () =
Custom.list "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" [] mapToUser 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 : ChurchId) =
Custom.scalar BitBadger.Documents.Postgres.Custom.scalar
"SELECT COUNT(u.id) AS user_count "SELECT COUNT(u.id) AS user_count
FROM pt.pt_user u FROM pt.pt_user u
WHERE EXISTS ( WHERE EXISTS (
@ -523,22 +404,16 @@ module Users =
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "user_count") [ "@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) =
Custom.scalar "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId" Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "user_count")
/// Delete a user by its database ID /// Delete a user by its database ID
let deleteById (userId : UserId) = let deleteById (userId: UserId) =
Custom.nonQuery "DELETE FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] Delete.byId Table.User userId
/// Get the IDs of the small groups for which the given user is authorized
let groupIdsByUserId (userId : UserId) =
Custom.list "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id"
[ "@id", Sql.uuid userId.Value ] (fun row -> SmallGroupId (row.uuid "small_group_id"))
/// 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) =
Custom.list BitBadger.Documents.Postgres.Custom.list
"SELECT u.* "SELECT u.*
FROM pt.pt_user u FROM pt.pt_user u
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id INNER JOIN pt.user_small_group usg ON usg.user_id = u.id
@ -547,68 +422,26 @@ module Users =
[ "@groupId", Sql.uuid groupId.Value ] mapToUser [ "@groupId", Sql.uuid groupId.Value ] mapToUser
/// Save a user's information /// Save a user's information
let save (user : User) = let save user =
Custom.nonQuery save<User> Table.User user
"INSERT INTO pt.pt_user (
id, first_name, last_name, email, is_admin, password_hash
) VALUES (
@id, @firstName, @lastName, @email, @isAdmin, @passwordHash
) ON CONFLICT (id) DO UPDATE
SET first_name = EXCLUDED.first_name,
last_name = EXCLUDED.last_name,
email = EXCLUDED.email,
is_admin = EXCLUDED.is_admin,
password_hash = EXCLUDED.password_hash"
[ "@id", Sql.uuid user.Id.Value
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@email", Sql.string user.Email
"@isAdmin", Sql.bool user.IsAdmin
"@passwordHash", Sql.string user.PasswordHash ]
/// 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 (groupId : SmallGroupId) = let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) =
Custom.single Find.firstByFields<User>
"SELECT u.* Table.User All [ Field.Equal "email" email; Field.InArray "smallGroups" Table.User [ groupId ] ]
FROM pt.pt_user u
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId
WHERE u.email = @email"
[ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ] mapToUser
/// Find a user by their database ID /// Find a user by their database ID
let tryById (userId : UserId) = let tryById userId =
Custom.single "SELECT * FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] mapToUser Find.byId<UserId, User> Table.User userId
/// 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) =
Custom.nonQuery "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id" Patch.byId Table.User userId {| LastSeen = now |}
[ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
/// Update a user's password hash /// Update a user's password hash
let updatePassword (user : User) = let updatePassword (user: User) =
Custom.nonQuery "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id" Patch.byId Table.User user.Id {| PasswordHash = user.PasswordHash |}
[ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
/// Update a user's authorized small groups /// Update a user's authorized small groups
let updateSmallGroups (userId : UserId) groupIds = backgroundTask { let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) =
let! existingGroupIds = groupIdsByUserId userId Patch.byId Table.User userId {| SmallGroups = groupIds |}
let toAdd =
groupIds |> List.filter (fun it -> existingGroupIds |> List.exists (fun grpId -> grpId = it) |> not)
let toDelete =
existingGroupIds |> List.filter (fun it -> groupIds |> List.exists (fun grpId -> grpId = it) |> not)
let queries = seq {
if not (List.isEmpty toAdd) then
"INSERT INTO pt.user_small_group VALUES (@userId, @smallGroupId)",
toAdd |> List.map (fun it -> [ "@userId", Sql.uuid userId.Value; "@smallGroupId", Sql.uuid it.Value ])
if not (List.isEmpty toDelete) then
"DELETE FROM pt.user_small_group WHERE user_id = @userId AND small_group_id = @smallGroupId",
toDelete
|> List.map (fun it -> [ "@userId", Sql.uuid userId.Value; "@smallGroupId", Sql.uuid it.Value ])
}
if not (Seq.isEmpty queries) then
let! _ =
Configuration.dataSource ()
|> Sql.fromDataSource
|> Sql.executeTransactionAsync (List.ofSeq queries)
()
}

15
src/PrayerTracker.Data/Entities.fs
View File

@ -148,6 +148,9 @@ type ChurchId =
|> function |> function
| ChurchId guid -> guid | ChurchId guid -> guid
override this.ToString() =
this.Value.ToString "N"
/// PK type for the Member entity /// PK type for the Member entity
type MemberId = type MemberId =
@ -159,6 +162,9 @@ type MemberId =
|> function |> function
| MemberId guid -> guid | MemberId guid -> guid
override this.ToString() =
this.Value.ToString "N"
/// PK type for the PrayerRequest entity /// PK type for the PrayerRequest entity
type PrayerRequestId = type PrayerRequestId =
@ -170,6 +176,9 @@ type PrayerRequestId =
|> function |> function
| PrayerRequestId guid -> guid | PrayerRequestId guid -> guid
override this.ToString() =
this.Value.ToString "N"
/// PK type for the SmallGroup entity /// PK type for the SmallGroup entity
type SmallGroupId = type SmallGroupId =
@ -181,6 +190,9 @@ type SmallGroupId =
|> function |> function
| SmallGroupId guid -> guid | SmallGroupId guid -> guid
override this.ToString() =
this.Value.ToString "N"
/// PK type for the User entity /// PK type for the User entity
type UserId = type UserId =
@ -192,6 +204,9 @@ type UserId =
|> function |> function
| UserId guid -> guid | UserId guid -> guid
override this.ToString() =
this.Value.ToString "N"
(*-- SPECIFIC VIEW TYPES --*) (*-- SPECIFIC VIEW TYPES --*)
/// Statistics for churches /// Statistics for churches

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

@ -10,7 +10,8 @@
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" /> <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.0" /> <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.FSharp" Version="5.7.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" /> <PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Update="FSharp.Core" Version="9.0.100" /> <PackageReference Update="FSharp.Core" Version="9.0.100" />

2
src/PrayerTracker/Church.fs
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 = groups; PrayerRequests = requests; Users = users } return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = requests; Users = users }
} }
// POST /church/[church-id]/delete // POST /church/[church-id]/delete

26
src/PrayerTracker/Extensions.fs
View File

@ -14,11 +14,11 @@ let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTim
/// 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, JsonConvert.SerializeObject(value, jsonSettings))
/// 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
@ -28,7 +28,7 @@ type ISession with
/// The currently logged on small group /// The currently logged on small group
member this.CurrentGroup member this.CurrentGroup
with get () = this.TryGetObject<SmallGroup> Key.Session.currentGroup with get () = this.TryGetObject<SmallGroup> Key.Session.currentGroup
and set (v: SmallGroup option) = and set (v: SmallGroup option) =
match v with match v with
| Some group -> this.SetObject Key.Session.currentGroup group | Some group -> this.SetObject Key.Session.currentGroup group
| None -> this.Remove Key.Session.currentGroup | None -> this.Remove Key.Session.currentGroup
@ -40,7 +40,7 @@ type ISession with
match v with match v with
| Some user -> this.SetObject Key.Session.currentUser { user with PasswordHash = "" } | Some user -> this.SetObject Key.Session.currentUser { user with PasswordHash = "" }
| None -> this.Remove Key.Session.currentUser | None -> this.Remove Key.Session.currentUser
/// Current messages for the session /// Current messages for the session
member this.Messages member this.Messages
with get () = with get () =
@ -53,14 +53,14 @@ open System.Security.Claims
/// Extensions on the claims principal /// Extensions on the claims principal
type ClaimsPrincipal with type ClaimsPrincipal with
/// The ID of the currently logged on small group /// The ID of the currently logged on small group
member this.SmallGroupId = member this.SmallGroupId =
this.FindFirstValue ClaimTypes.GroupSid this.FindFirstValue ClaimTypes.GroupSid
|> Option.ofObj |> Option.ofObj
|> Option.map (idFromShort SmallGroupId) |> Option.map (idFromShort SmallGroupId)
/// The ID of the currently signed-in user /// The ID of the currently signed-in user
member this.UserId = member this.UserId =
this.FindFirstValue ClaimTypes.NameIdentifier this.FindFirstValue ClaimTypes.NameIdentifier
|> Option.ofObj |> Option.ofObj
@ -71,16 +71,16 @@ open Giraffe
/// Extensions on the ASP.NET Core HTTP context /// Extensions on the ASP.NET Core HTTP context
type HttpContext with type HttpContext with
/// The system clock (via DI) /// The system clock (via DI)
member this.Clock = this.GetService<IClock>() member this.Clock = this.GetService<IClock>()
/// The current instant /// The current instant
member this.Now = this.Clock.GetCurrentInstant() member this.Now = this.Clock.GetCurrentInstant()
/// The common string localizer /// The common string localizer
member _.Strings = Views.I18N.localizer.Force() member _.Strings = Views.I18N.localizer.Force()
/// The currently logged on small group (sets the value in the session if it is missing) /// The currently logged on small group (sets the value in the session if it is missing)
member this.CurrentGroup() = task { member this.CurrentGroup() = task {
match this.Session.CurrentGroup with match this.Session.CurrentGroup with
@ -88,7 +88,7 @@ type HttpContext with
| None -> | None ->
match this.User.SmallGroupId with match this.User.SmallGroupId with
| Some groupId -> | Some groupId ->
match! SmallGroups.tryByIdWithPreferences groupId with match! SmallGroups.tryById groupId with
| Some group -> | Some group ->
this.Session.CurrentGroup <- Some group this.Session.CurrentGroup <- Some group
return Some group return Some group

2
src/PrayerTracker/PrayerRequest.fs
View File

@ -126,7 +126,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
// GET /prayer-requests/[group-id]/list // GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
match! SmallGroups.tryByIdWithPreferences (SmallGroupId groupId) with match! SmallGroups.tryById (SmallGroupId groupId) with
| Some group when group.Preferences.IsPublic -> | Some group when group.Preferences.IsPublic ->
let! reqs = let! reqs =
PrayerRequests.forGroup PrayerRequests.forGroup

9
src/PrayerTracker/SmallGroup.fs
View File

@ -152,8 +152,8 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let! admins = Users.listByGroupId group.Id let! admins = Users.listByGroupId group.Id
let model = let model =
{ TotalActiveReqs = List.length reqs { TotalActiveReqs = List.length reqs
AllReqs = reqCount AllReqs = int reqCount
TotalMembers = mbrCount TotalMembers = int mbrCount
ActiveReqsByType = ( ActiveReqsByType = (
reqs reqs
|> Seq.ofList |> Seq.ofList
@ -187,7 +187,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId)
match tryGroup with match tryGroup with
| Some group -> | Some group ->
do! SmallGroups.save (model.populateGroup group) model.IsNew do! SmallGroups.save (model.populateGroup group)
let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower() let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower()
addHtmlInfo ctx ctx.Strings["Successfully {0} group “{1}”", act, model.Name] addHtmlInfo ctx ctx.Strings["Successfully {0} group “{1}”", act, model.Name]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/small-groups" next ctx
@ -227,7 +227,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
// we can repopulate the session instance. That way, if the update fails, the page should still show the // we can repopulate the session instance. That way, if the update fails, the page should still show the
// database values, not the then out-of-sync session ones. // database values, not the then out-of-sync session ones.
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
match! SmallGroups.tryByIdWithPreferences 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 pref
@ -241,7 +241,6 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
open Giraffe.ViewEngine open Giraffe.ViewEngine
open PrayerTracker.Views.CommonFunctions open PrayerTracker.Views.CommonFunctions
open Microsoft.Extensions.Configuration
// POST /small-group/announcement/send // POST /small-group/announcement/send
let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {

4
src/PrayerTracker/User.fs
View File

@ -129,7 +129,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
let s = ctx.Strings let s = ctx.Strings
match! findUserByPassword model with match! findUserByPassword model with
| Some user -> | Some user ->
match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) with match! SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) with
| Some group -> | Some group ->
ctx.Session.CurrentUser <- Some user ctx.Session.CurrentUser <- Some user
ctx.Session.CurrentGroup <- Some group ctx.Session.CurrentGroup <- Some group
@ -265,7 +265,7 @@ let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -
match! Users.tryById userId with match! Users.tryById userId with
| Some user -> | Some user ->
let! groups = SmallGroups.listAll () let! groups = SmallGroups.listAll ()
let! groupIds = Users.groupIdsByUserId userId let groupIds = user.SmallGroups
let curGroups = groupIds |> List.map (fun g -> shortGuid g.Value) let curGroups = groupIds |> List.map (fun g -> shortGuid g.Value)
return! return!
viewInfo ctx viewInfo ctx