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

Update public req list page (#38)

Browse Source 
- Tweak SQL / mappings
- Init connection in DI vs. HTTP context
- Add extension for string localizer
- Drop FK and time zone table
This commit is contained in:
Daniel J. Summers 2022-08-14 18:00:49 -04:00
parent 0c95078f69
commit ab3f8dcc43
13 changed files with 209 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -60,7 +60,7 @@ module private Helpers =
Requestor = row.stringOrNone "requestor" Requestor = row.stringOrNone "requestor"
Text = row.string "request_text" Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain" NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.fromCode (row.string "request_id") RequestType = PrayerRequestType.fromCode (row.string "request_type")
Expiration = Expiration.fromCode (row.string "expiration") Expiration = Expiration.fromCode (row.string "expiration")
} }
@ -108,8 +108,7 @@ module Churches =
/// Get a list of all churches /// Get a list of all churches
let all conn = let all conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.church ORDER BY church_name" |> Sql.query "SELECT * FROM pt.church ORDER BY church_name"
|> Sql.executeAsync mapToChurch |> Sql.executeAsync mapToChurch
@ -118,8 +117,7 @@ module Churches =
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! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.executeTransactionAsync |> Sql.executeTransactionAsync
[ $"DELETE FROM pt.prayer_request {where}", idParam [ $"DELETE FROM pt.prayer_request {where}", idParam
$"DELETE FROM pt.user_small_group {where}", idParam $"DELETE FROM pt.user_small_group {where}", idParam
@ -132,8 +130,7 @@ module Churches =
/// Save a church's information /// Save a church's information
let save (church : Church) conn = backgroundTask { let save (church : Church) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
INSERT INTO pt.church ( INSERT INTO pt.church (
id, church_name, city, state, has_vps_interface, interface_address id, church_name, city, state, has_vps_interface, interface_address
@ -159,8 +156,7 @@ module Churches =
/// Find a church by its ID /// Find a church by its ID
let tryById (churchId : ChurchId) conn = backgroundTask { let tryById (churchId : ChurchId) conn = backgroundTask {
let! church = let! church =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.church WHERE id = @id" |> Sql.query "SELECT * FROM pt.church WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid churchId.Value ] |> Sql.parameters [ "@id", Sql.uuid churchId.Value ]
|> Sql.executeAsync mapToChurch |> Sql.executeAsync mapToChurch
@ -173,8 +169,7 @@ module Members =
/// Count members for the given small group /// Count members for the given small group
let countByGroup (groupId : SmallGroupId) conn = let countByGroup (groupId : SmallGroupId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId" |> Sql.query "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "mbr_count") |> Sql.executeRowAsync (fun row -> row.int "mbr_count")
@ -182,8 +177,7 @@ module Members =
/// Delete a small group member by its ID /// Delete a small group member by its ID
let deleteById (memberId : MemberId) conn = backgroundTask { let deleteById (memberId : MemberId) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "DELETE FROM pt.member WHERE id = @id" |> Sql.query "DELETE FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ] |> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -192,8 +186,7 @@ module Members =
/// Retrieve all members for a given small group /// Retrieve all members for a given small group
let forGroup (groupId : SmallGroupId) conn = let forGroup (groupId : SmallGroupId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name" |> Sql.query "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToMember |> Sql.executeAsync mapToMember
@ -201,8 +194,7 @@ module Members =
/// Save a small group member /// Save a small group member
let save (mbr : Member) conn = backgroundTask { let save (mbr : Member) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
INSERT INTO pt.member ( INSERT INTO pt.member (
id, small_group_id, member_name, email, email_format id, small_group_id, member_name, email, email_format
@ -225,8 +217,7 @@ module Members =
/// Retrieve a small group member by its ID /// Retrieve a small group member by its ID
let tryById (memberId : MemberId) conn = backgroundTask { let tryById (memberId : MemberId) conn = backgroundTask {
let! mbr = let! mbr =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.member WHERE id = @id" |> Sql.query "SELECT * FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ] |> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeAsync mapToMember |> Sql.executeAsync mapToMember
@ -259,8 +250,8 @@ 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 -> "DESC updated_date, DESC entered_date, requestor" | SortByDate -> "updated_date DESC, entered_date DESC, requestor"
| SortByRequestor -> "requestor, DESC updated_date, DESC entered_date" | SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
/// Paginate a prayer request query /// Paginate a prayer request query
let private paginate (pageNbr : int) pageSize = let private paginate (pageNbr : int) pageSize =
@ -268,8 +259,7 @@ module PrayerRequests =
/// Count the number of prayer requests for a church /// Count the number of prayer requests for a church
let countByChurch (churchId : ChurchId) conn = let countByChurch (churchId : ChurchId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT COUNT(id) AS req_count SELECT COUNT(id) AS req_count
FROM pt.prayer_request FROM pt.prayer_request
@ -279,8 +269,7 @@ module PrayerRequests =
/// Count the number of prayer requests for a small group /// Count the number of prayer requests for a small group
let countByGroup (groupId : SmallGroupId) conn = let countByGroup (groupId : SmallGroupId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId" |> Sql.query "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count") |> Sql.executeRowAsync (fun row -> row.int "req_count")
@ -288,8 +277,7 @@ module PrayerRequests =
/// Delete a prayer request by its ID /// Delete a prayer request by its ID
let deleteById (reqId : PrayerRequestId) conn = backgroundTask { let deleteById (reqId : PrayerRequestId) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id" |> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ] |> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -306,7 +294,7 @@ module PrayerRequests =
(theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup) (theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire) - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ()) .ToInstant ())
""" AND ( updatedDate > @asOf """ AND ( updated_date > @asOf
OR expiration = @manual OR expiration = @manual
OR request_type = @longTerm OR request_type = @longTerm
OR request_type = @expecting) OR request_type = @expecting)
@ -317,11 +305,10 @@ module PrayerRequests =
"@expecting", Sql.string (PrayerRequestType.toCode Expecting) "@expecting", Sql.string (PrayerRequestType.toCode Expecting)
"@forced", Sql.string (Expiration.toCode Forced) ] "@forced", Sql.string (Expiration.toCode Forced) ]
else "", [] else "", []
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query $""" |> Sql.query $"""
SELECT * SELECT *
FROM prayer_request FROM pt.prayer_request
WHERE small_group_id = @groupId {where} WHERE small_group_id = @groupId {where}
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort} ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}""" {paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"""
@ -331,8 +318,7 @@ module PrayerRequests =
/// Save a prayer request /// Save a prayer request
let save (req : PrayerRequest) conn = backgroundTask { let save (req : PrayerRequest) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
INSERT into pt.prayer_request ( INSERT into pt.prayer_request (
id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text, id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text,
@ -365,8 +351,7 @@ module PrayerRequests =
/// Search prayer requests for the given term /// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr conn = let searchForGroup group searchTerm pageNbr conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query $""" |> Sql.query $"""
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
@ -379,8 +364,7 @@ module PrayerRequests =
/// Retrieve a prayer request by its ID /// Retrieve a prayer request by its ID
let tryById (reqId : PrayerRequestId) conn = backgroundTask { let tryById (reqId : PrayerRequestId) conn = backgroundTask {
let! req = let! req =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id" |> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ] |> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeAsync mapToPrayerRequest |> Sql.executeAsync mapToPrayerRequest
@ -395,8 +379,7 @@ module PrayerRequests =
[ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ] [ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ]
else "", [] else "", []
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id" |> Sql.query $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id"
|> Sql.parameters |> Sql.parameters
([ "@expiration", Sql.string (Expiration.toCode req.Expiration) ([ "@expiration", Sql.string (Expiration.toCode req.Expiration)
@ -412,8 +395,7 @@ module SmallGroups =
/// Count the number of small groups for a church /// Count the number of small groups for a church
let countByChurch (churchId : ChurchId) conn = let countByChurch (churchId : ChurchId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId" |> Sql.query "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId"
|> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ] |> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "group_count") |> Sql.executeRowAsync (fun row -> row.int "group_count")
@ -422,8 +404,7 @@ module SmallGroups =
let deleteById (groupId : SmallGroupId) conn = backgroundTask { let deleteById (groupId : SmallGroupId) conn = backgroundTask {
let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ] let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ]
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> 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
"DELETE FROM pt.user_small_group WHERE small_group_id = @groupId", idParam "DELETE FROM pt.user_small_group WHERE small_group_id = @groupId", idParam
@ -434,10 +415,9 @@ module SmallGroups =
/// Get information for all small groups /// Get information for all small groups
let infoForAll conn = let infoForAll conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT sg.id, c.church_name, lp.time_zone_id 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
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
@ -446,8 +426,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 conn = let listAll conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
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
@ -457,8 +436,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 conn = let listProtected conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
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
@ -470,10 +448,9 @@ 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 conn = let listPublicAndProtected conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT g.group_name, g.id, c.church_name, 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
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
@ -485,8 +462,7 @@ module SmallGroups =
/// Log on for a small group (includes list preferences) /// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password conn = backgroundTask { let logOn (groupId : SmallGroupId) password conn = backgroundTask {
let! group = let! group =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT sg.*, lp.* SELECT sg.*, lp.*
FROM pt.small_group sg FROM pt.small_group sg
@ -501,8 +477,7 @@ module SmallGroups =
/// Save a small group /// Save a small group
let save (group : SmallGroup) isNew conn = backgroundTask { let save (group : SmallGroup) isNew conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
""" INSERT INTO pt.small_group ( """ INSERT INTO pt.small_group (
id, church_id, group_name id, church_id, group_name
@ -524,8 +499,7 @@ module SmallGroups =
/// Save a small group's list preferences /// Save a small group's list preferences
let savePreferences (pref : ListPreferences) conn = backgroundTask { let savePreferences (pref : ListPreferences) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
UPDATE pt.list_preference UPDATE pt.list_preference
SET days_to_keep_new = @daysToKeepNew, SET days_to_keep_new = @daysToKeepNew,
@ -573,8 +547,7 @@ module SmallGroups =
/// Get a small group by its ID /// Get a small group by its ID
let tryById (groupId : SmallGroupId) conn = backgroundTask { let tryById (groupId : SmallGroupId) conn = backgroundTask {
let! group = let! group =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.small_group WHERE id = @id" |> Sql.query "SELECT * FROM pt.small_group WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid groupId.Value ] |> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToSmallGroup |> Sql.executeAsync mapToSmallGroup
@ -584,8 +557,7 @@ module SmallGroups =
/// Get a small group by its ID with its list preferences populated /// Get a small group by its ID with its list preferences populated
let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask { let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask {
let! group = let! group =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT sg.*, lp.* SELECT sg.*, lp.*
FROM pt.small_group sg FROM pt.small_group sg
@ -602,15 +574,13 @@ module Users =
/// Retrieve all PrayerTracker users /// Retrieve all PrayerTracker users
let all conn = let all conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" |> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name"
|> Sql.executeAsync mapToUser |> Sql.executeAsync mapToUser
/// Count the number of users for a church /// Count the number of users for a church
let countByChurch (churchId : ChurchId) conn = let countByChurch (churchId : ChurchId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT COUNT(u.id) AS user_count SELECT COUNT(u.id) AS user_count
FROM pt.pt_user u FROM pt.pt_user u
@ -625,8 +595,7 @@ module Users =
/// Count the number of users for a small group /// Count the number of users for a small group
let countByGroup (groupId : SmallGroupId) conn = let countByGroup (groupId : SmallGroupId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId" |> Sql.query "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "user_count") |> Sql.executeRowAsync (fun row -> row.int "user_count")
@ -634,8 +603,7 @@ module Users =
/// Delete a user by its database ID /// Delete a user by its database ID
let deleteById (userId : UserId) conn = backgroundTask { let deleteById (userId : UserId) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "DELETE FROM pt.pt_user WHERE id = @id" |> Sql.query "DELETE FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ] |> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -644,16 +612,14 @@ module Users =
/// Get the IDs of the small groups for which the given user is authorized /// Get the IDs of the small groups for which the given user is authorized
let groupIdsByUserId (userId : UserId) conn = let groupIdsByUserId (userId : UserId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id" |> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ] |> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync (fun row -> SmallGroupId (row.uuid "small_group_id")) |> Sql.executeAsync (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) conn = let listByGroupId (groupId : SmallGroupId) conn =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT u.* SELECT u.*
FROM pt.pt_user u FROM pt.pt_user u
@ -666,8 +632,7 @@ module Users =
/// Save a user's information /// Save a user's information
let save (user : User) conn = backgroundTask { let save (user : User) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
INSERT INTO pt.pt_user ( INSERT INTO pt.pt_user (
id, first_name, last_name, email, is_admin, password_hash id, first_name, last_name, email, is_admin, password_hash
@ -694,8 +659,7 @@ module Users =
/// 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) conn = backgroundTask { let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask {
let! user = let! user =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT u.* SELECT u.*
FROM pt.pt_user u FROM pt.pt_user u
@ -709,8 +673,7 @@ module Users =
/// Find a user by their database ID /// Find a user by their database ID
let tryById (userId : UserId) conn = backgroundTask { let tryById (userId : UserId) conn = backgroundTask {
let! user = let! user =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id" |> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ] |> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync mapToUser |> Sql.executeAsync mapToUser
@ -720,8 +683,7 @@ module Users =
/// Update a user's last seen date/time /// Update a user's last seen date/time
let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask { let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id" |> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ] |> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -731,8 +693,7 @@ module Users =
/// Update a user's password hash /// Update a user's password hash
let updatePassword (user : User) conn = backgroundTask { let updatePassword (user : User) conn = backgroundTask {
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id" |> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ] |> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
@ -757,8 +718,7 @@ module Users =
} }
if not (Seq.isEmpty queries) then if not (Seq.isEmpty queries) then
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.executeTransactionAsync (List.ofSeq queries) |> Sql.executeTransactionAsync (List.ofSeq queries)
() ()
} }

41
src/PrayerTracker.UI/PrayerRequest.fs
View File

@ -111,6 +111,7 @@ let lists (groups : SmallGroupInfo list) viewInfo =
let l = I18N.forView "Requests/Lists" let l = I18N.forView "Requests/Lists"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let vi = AppViewInfo.withScopedStyles [ "#groupList { grid-template-columns: repeat(3, auto); }" ] viewInfo
[ p [] [ [ p [] [
raw l["The groups listed below have either public or password-protected request lists."] raw l["The groups listed below have either public or password-protected request lists."]
space space
@ -122,27 +123,31 @@ let lists (groups : SmallGroupInfo list) viewInfo =
| 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ] | 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ]
| count -> | count ->
tableSummary count s tableSummary count s
table [ _class "pt-table pt-action-table" ] [ section [ _id "groupList"; _class "pt-table"; _ariaLabel "Small group list" ] [
tableHeadings s [ "Actions"; "Church"; "Group" ] div [ _class "row head" ] [
groups header [ _class "cell" ] [ locStr s["Actions"] ]
|> List.map (fun grp -> header [ _class "cell" ] [ locStr s["Church"] ]
tr [] [ header [ _class "cell" ] [ locStr s["Group"] ]
if grp.IsPublic then ]
a [ _href $"/prayer-requests/{grp.Id}/list"; _title s["View"].Value ] [ icon "list" ] for group in groups do
else div [ _class "row" ] [
a [ _href $"/small-group/log-on/{grp.Id}"; _title s["Log On"].Value ] [ div [ _class "cell actions" ] [
icon "verified_user" if group.IsPublic then
a [ _href $"/prayer-requests/{group.Id}/list"; _title s["View"].Value ] [
iconSized 18 "list"
]
else
a [ _href $"/small-group/log-on/{group.Id}"; _title s["Log On"].Value ] [
iconSized 18 "verified_user"
]
]
div [ _class "cell" ] [ str group.ChurchName ]
div [ _class "cell" ] [ str group.Name ]
] ]
|> List.singleton
|> td []
td [] [ str grp.ChurchName ]
td [] [ str grp.Name ]
])
|> tbody []
] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard viewInfo "Request Lists" |> Layout.standard vi "Request Lists"
/// View for the prayer request maintenance page /// View for the prayer request maintenance page
@ -256,7 +261,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
br [] br []
a [ _href "/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ] a [ _href "/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ]
| _ -> | _ ->
if defaultArg model.OnlyActive false then if Option.isSome model.OnlyActive then
raw l["Inactive requests are currently shown"] raw l["Inactive requests are currently shown"]
br [] br []
a [ _href "/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ] a [ _href "/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ]

2
src/PrayerTracker.UI/SmallGroup.fs
View File

@ -203,7 +203,7 @@ let maintain (groups : SmallGroupInfo list) ctx viewInfo =
] ]
a [ _href delAction a [ _href delAction
_title s["Delete This Group"].Value _title s["Delete This Group"].Value
_hxDelete delAction _hxPost delAction
_hxConfirm delPrompt ] [ _hxConfirm delPrompt ] [
iconSized 18 "delete_forever" iconSized 18 "delete_forever"
] ]

33
src/PrayerTracker/App.fs
View File

@ -41,6 +41,7 @@ module Configure =
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open NeoSmart.Caching.Sqlite open NeoSmart.Caching.Sqlite
open NodaTime open NodaTime
open Npgsql
/// Configure ASP.NET Core's service collection (dependency injection container) /// Configure ASP.NET Core's service collection (dependency injection container)
let services (svc : IServiceCollection) = let services (svc : IServiceCollection) =
@ -67,6 +68,13 @@ module Configure =
let _ = svc.AddAntiforgery () let _ = svc.AddAntiforgery ()
let _ = svc.AddRouting () let _ = svc.AddRouting ()
let _ = svc.AddSingleton<IClock> SystemClock.Instance let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ =
svc.AddScoped<NpgsqlConnection>(fun sp ->
let cfg = sp.GetService<IConfiguration> ()
let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker")
conn.OpenAsync () |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
() ()
open Giraffe open Giraffe
@ -215,39 +223,28 @@ module App =
use conn = new NpgsqlConnection (config.GetConnectionString "PrayerTracker") use conn = new NpgsqlConnection (config.GetConnectionString "PrayerTracker")
do! conn.OpenAsync () do! conn.OpenAsync ()
let! v1Users = let! v1Users =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT id, password_hash FROM pt.pt_user WHERE salt IS NULL" |> Sql.query "SELECT id, password_hash FROM pt.pt_user WHERE salt IS NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash") |> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash")
for userId, oldHash in v1Users do for userId, oldHash in v1Users do
let pw = let pw = Convert.ToBase64String [| 254uy; yield! (Encoding.UTF8.GetBytes oldHash) |]
[| 254uy
yield! (Encoding.UTF8.GetBytes oldHash)
|]
|> Convert.ToBase64String
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id" |> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ] |> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync
() ()
printfn $"Updated {v1Users.Length} users with version 1 password" printfn $"Updated {v1Users.Length} users with version 1 password"
let! v2Users = let! v2Users =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "SELECT id, password_hash, salt FROM pt.pt_user WHERE salt IS NOT NULL" |> Sql.query "SELECT id, password_hash, salt FROM pt.pt_user WHERE salt IS NOT NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash", row.uuid "salt") |> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash", row.uuid "salt")
for userId, oldHash, salt in v2Users do for userId, oldHash, salt in v2Users do
let pw = let pw =
[| 255uy Convert.ToBase64String
yield! (salt.ToByteArray ()) [| 255uy; yield! (salt.ToByteArray ()); yield! (Encoding.UTF8.GetBytes oldHash) |]
yield! (Encoding.UTF8.GetBytes oldHash)
|]
|> Convert.ToBase64String
let! _ = let! _ =
conn Sql.existingConnection conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id" |> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ] |> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync |> Sql.executeNonQueryAsync

20
src/PrayerTracker/Church.fs
View File

@ -18,14 +18,13 @@ let private findStats churchId conn = task {
/// POST /church/[church-id]/delete /// POST /church/[church-id]/delete
let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let churchId = ChurchId chId let churchId = ChurchId chId
use! conn = ctx.Conn let conn = ctx.Conn
match! Churches.tryById churchId conn with match! Churches.tryById churchId conn with
| Some church -> | Some church ->
let! _, stats = findStats churchId conn let! _, stats = findStats churchId conn
do! Churches.deleteById churchId conn do! Churches.deleteById churchId conn
let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", ctx.Strings["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users] church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users]
return! redirectTo false "/churches" next ctx return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
@ -41,8 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|> Views.Church.edit EditChurch.empty ctx |> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
use! conn = ctx.Conn match! Churches.tryById (ChurchId churchId) ctx.Conn with
match! Churches.tryById (ChurchId churchId) conn with
| Some church -> | Some church ->
return! return!
viewInfo ctx viewInfo ctx
@ -53,7 +51,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
/// GET /churches /// GET /churches
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn let conn = ctx.Conn
let! churches = Churches.all conn let! churches = Churches.all conn
let stats = churches |> List.map (fun c -> findStats c.Id conn |> Async.AwaitTask |> Async.RunSynchronously) let stats = churches |> List.map (fun c -> findStats c.Id conn |> Async.AwaitTask |> Async.RunSynchronously)
return! return!
@ -66,16 +64,14 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with match! ctx.TryBindFormAsync<EditChurch> () with
| Ok model -> | Ok model ->
let! conn = ctx.Conn
let! church = let! church =
if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () }) if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
else Churches.tryById (idFromShort ChurchId model.ChurchId) conn else Churches.tryById (idFromShort ChurchId model.ChurchId) ctx.Conn
match church with match church with
| Some ch -> | Some ch ->
do! Churches.save (model.PopulateChurch ch) conn do! Churches.save (model.PopulateChurch ch) ctx.Conn
let s = Views.I18N.localizer.Force () let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () addInfo ctx ctx.Strings["Successfully {0} church “{1}”", act, model.Name]
addInfo ctx s["Successfully {0} church “{1}”", act, model.Name]
return! redirectTo false "/churches" next ctx return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx

10
src/PrayerTracker/CommonFunctions.fs
View File

@ -6,11 +6,11 @@ open Microsoft.AspNetCore.Mvc.Rendering
/// Create a select list from an enumeration /// Create a select list from an enumeration
let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) = let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
match items with null -> nullArg "items" | _ -> () if isNull items then nullArg (nameof items)
[ match withDefault with [ match withDefault with
| true -> | true ->
let s = PrayerTracker.Views.I18N.localizer.Force () let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem ($"""&mdash; %A{s[emptyText]} &mdash;""", "") SelectListItem ($"""&mdash; %A{s[emptyText]} &mdash;""", "")
| _ -> () | _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x)) yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
] ]
@ -151,8 +151,7 @@ let requireAccess levels : HttpHandler = fun next ctx -> task {
| _, Some _ when List.contains Group levels -> return! next ctx | _, Some _ when List.contains Group levels -> return! next ctx
| Some u, _ when List.contains Admin levels && u.IsAdmin -> return! next ctx | Some u, _ when List.contains Admin levels && u.IsAdmin -> return! next ctx
| _, _ when List.contains Admin levels -> | _, _ when List.contains Admin levels ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["You are not authorized to view the requested page."]
addError ctx s["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/unauthorized" next ctx
| _, _ when List.contains User levels -> | _, _ when List.contains User levels ->
// Redirect to the user log on page // Redirect to the user log on page
@ -162,7 +161,6 @@ let requireAccess levels : HttpHandler = fun next ctx -> task {
// Redirect to the small group log on page // Redirect to the small group log on page
return! redirectTo false "/small-group/log-on" next ctx return! redirectTo false "/small-group/log-on" next ctx
| _, _ -> | _, _ ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["You are not authorized to view the requested page."]
addError ctx s["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/unauthorized" next ctx
} }

15
src/PrayerTracker/Extensions.fs
View File

@ -86,9 +86,7 @@ type HttpContext with
}) })
/// The PostgreSQL connection (configured via DI) /// The PostgreSQL connection (configured via DI)
member this.Conn = backgroundTask { member this.Conn = this.GetService<NpgsqlConnection> ()
return! this.LazyConn.Force ()
}
/// The system clock (via DI) /// The system clock (via DI)
member this.Clock = this.GetService<IClock> () member this.Clock = this.GetService<IClock> ()
@ -96,6 +94,9 @@ type HttpContext with
/// The current instant /// The current instant
member this.Now = this.Clock.GetCurrentInstant () member this.Now = this.Clock.GetCurrentInstant ()
/// The common string localizer
member this.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
@ -103,8 +104,7 @@ type HttpContext with
| None -> | None ->
match this.User.SmallGroupId with match this.User.SmallGroupId with
| Some groupId -> | Some groupId ->
let! conn = this.Conn match! SmallGroups.tryByIdWithPreferences groupId this.Conn with
match! SmallGroups.tryByIdWithPreferences groupId conn with
| Some group -> | Some group ->
this.Session.CurrentGroup <- Some group this.Session.CurrentGroup <- Some group
return Some group return Some group
@ -119,11 +119,10 @@ type HttpContext with
| None -> | None ->
match this.User.UserId with match this.User.UserId with
| Some userId -> | Some userId ->
let! conn = this.Conn match! Users.tryById userId this.Conn with
match! Users.tryById userId conn with
| Some user -> | Some user ->
// Set last seen for user // Set last seen for user
do! Users.updateLastSeen userId this.Now conn do! Users.updateLastSeen userId this.Now this.Conn
this.Session.CurrentUser <- Some user this.Session.CurrentUser <- Some user
return Some user return Some user
| None -> return None | None -> return None

3
src/PrayerTracker/Home.fs
View File

@ -61,8 +61,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
ctx.Session.Clear () ctx.Session.Clear ()
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
let s = Views.I18N.localizer.Force () addHtmlInfo ctx ctx.Strings["Log Off Successful • Have a nice day!"]
addHtmlInfo ctx s["Log Off Successful • Have a nice day!"]
return! redirectTo false "/" next ctx return! redirectTo false "/" next ctx
} }

60
src/PrayerTracker/PrayerRequest.fs
View File

@ -9,12 +9,10 @@ open PrayerTracker.ViewModels
/// Retrieve a prayer request, and ensure that it belongs to the current class /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = task { let private findRequest (ctx : HttpContext) reqId = task {
let! conn = ctx.Conn match! PrayerRequests.tryById reqId ctx.Conn with
match! PrayerRequests.tryById reqId conn with
| Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["The prayer request you tried to access is not assigned to your group"]
addError ctx s["The prayer request you tried to access is not assigned to your group"]
return Result.Error (redirectTo false "/unauthorized" earlyReturn ctx) return Result.Error (redirectTo false "/unauthorized" earlyReturn ctx)
| None -> return Result.Error (fourOhFour ctx) | None -> return Result.Error (fourOhFour ctx)
} }
@ -23,7 +21,6 @@ let private findRequest (ctx : HttpContext) reqId = task {
let private generateRequestList (ctx : HttpContext) date = task { let private generateRequestList (ctx : HttpContext) date = task {
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group
let! conn = ctx.Conn
let! reqs = let! reqs =
PrayerRequests.forGroup PrayerRequests.forGroup
{ SmallGroup = group { SmallGroup = group
@ -31,7 +28,7 @@ let private generateRequestList (ctx : HttpContext) date = task {
ListDate = Some listDate ListDate = Some listDate
ActiveOnly = true ActiveOnly = true
PageNumber = 0 PageNumber = 0
} conn } ctx.Conn
return return
{ Requests = reqs { Requests = reqs
Date = listDate Date = listDate
@ -65,7 +62,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
else else
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = ctx.Strings
if PrayerRequest.isExpired now group req then if PrayerRequest.isExpired now group req then
{ UserMessage.warning with { UserMessage.warning with
Text = htmlLocString s["This request is expired."] Text = htmlLocString s["This request is expired."]
@ -84,12 +81,11 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /prayer-requests/email/[date] /// GET /prayer-requests/email/[date]
let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = ctx.Strings
let listDate = parseListDate (Some date) let listDate = parseListDate (Some date)
let group = ctx.Session.CurrentGroup.Value
let! list = generateRequestList ctx listDate let! list = generateRequestList ctx listDate
let! conn = ctx.Conn let group = ctx.Session.CurrentGroup.Value
let! recipients = Members.forGroup group.Id conn let! recipients = Members.forGroup group.Id ctx.Conn
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails do! Email.sendEmails
{ Client = client { Client = client
@ -111,10 +107,8 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun
let requestId = PrayerRequestId reqId let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.deleteById req.Id ctx.Conn
let! conn = ctx.Conn addInfo ctx ctx.Strings["The prayer request was deleted successfully"]
do! PrayerRequests.deleteById req.Id conn
addInfo ctx s["The prayer request was deleted successfully"]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e | Result.Error e -> return! e
} }
@ -124,18 +118,15 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
let requestId = PrayerRequestId reqId let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.updateExpiration { req with Expiration = Forced } false ctx.Conn
let! conn = ctx.Conn addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Expired"].Value.ToLower ()]
do! PrayerRequests.updateExpiration { req with Expiration = Forced } false conn
addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e | Result.Error e -> return! e
} }
/// 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 {
let! conn = ctx.Conn match! SmallGroups.tryByIdWithPreferences groupId ctx.Conn with
match! SmallGroups.tryByIdWithPreferences groupId conn with
| Some group when group.Preferences.IsPublic -> | Some group when group.Preferences.IsPublic ->
let! reqs = let! reqs =
PrayerRequests.forGroup PrayerRequests.forGroup
@ -144,7 +135,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
ListDate = None ListDate = None
ActiveOnly = true ActiveOnly = true
PageNumber = 0 PageNumber = 0
} conn } ctx.Conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
@ -157,16 +148,14 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
} }
|> renderHtml next ctx |> renderHtml next ctx
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () addError ctx ctx.Strings["The request list for the group you tried to view is not public."]
addError ctx s["The request list for the group you tried to view is not public."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/unauthorized" next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
} }
/// GET /prayer-requests/lists /// GET /prayer-requests/lists
let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! conn = ctx.Conn let! groups = SmallGroups.listPublicAndProtected ctx.Conn
let! groups = SmallGroups.listPublicAndProtected conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.lists groups |> Views.PrayerRequest.lists groups
@ -183,10 +172,9 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1 | Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Result.Error _ -> 1 | Result.Error _ -> 1
let! model = backgroundTask { let! model = backgroundTask {
let! conn = ctx.Conn
match ctx.GetQueryStringValue "search" with match ctx.GetQueryStringValue "search" with
| Ok search -> | Ok search ->
let! reqs = PrayerRequests.searchForGroup group search pageNbr conn let! reqs = PrayerRequests.searchForGroup group search pageNbr ctx.Conn
return return
{ MaintainRequests.empty with { MaintainRequests.empty with
Requests = reqs Requests = reqs
@ -201,7 +189,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
ListDate = None ListDate = None
ActiveOnly = onlyActive ActiveOnly = onlyActive
PageNumber = pageNbr PageNumber = pageNbr
} conn } ctx.Conn
return return
{ MaintainRequests.empty with { MaintainRequests.empty with
Requests = reqs Requests = reqs
@ -228,10 +216,8 @@ let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> tas
let requestId = PrayerRequestId reqId let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true ctx.Conn
let! conn = ctx.Conn addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Restored"].Value.ToLower ()]
do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true conn
addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e | Result.Error e -> return! e
} }
@ -243,7 +229,6 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
match! ctx.TryBindFormAsync<EditRequest> () with match! ctx.TryBindFormAsync<EditRequest> () with
| Ok model -> | Ok model ->
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let! req = let! req =
if model.IsNew then if model.IsNew then
{ PrayerRequest.empty with { PrayerRequest.empty with
@ -252,7 +237,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
UserId = ctx.User.UserId.Value UserId = ctx.User.UserId.Value
} }
|> (Some >> Task.FromResult) |> (Some >> Task.FromResult)
else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) conn else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) ctx.Conn
match req with match req with
| Some pr when pr.SmallGroupId = group.Id -> | Some pr when pr.SmallGroupId = group.Id ->
let now = SmallGroup.localDateNow ctx.Clock group let now = SmallGroup.localDateNow ctx.Clock group
@ -272,10 +257,9 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
{ it with EnteredDate = dt; UpdatedDate = dt } { it with EnteredDate = dt; UpdatedDate = dt }
| it when defaultArg model.SkipDateUpdate false -> it | it when defaultArg model.SkipDateUpdate false -> it
| it -> { it with UpdatedDate = ctx.Now } | it -> { it with UpdatedDate = ctx.Now }
do! PrayerRequests.save updated conn do! PrayerRequests.save updated ctx.Conn
let s = Views.I18N.localizer.Force ()
let act = if model.IsNew then "Added" else "Updated" let act = if model.IsNew then "Added" else "Updated"
addInfo ctx s["Successfully {0} prayer request", s[act].Value.ToLower ()] addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Some _ | Some _
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx

89
src/PrayerTracker/SmallGroup.fs
View File

@ -15,16 +15,15 @@ let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
/// POST /small-group/[group-id]/delete /// POST /small-group/[group-id]/delete
let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let groupId = SmallGroupId grpId let groupId = SmallGroupId grpId
let! conn = ctx.Conn let conn = ctx.Conn
match! SmallGroups.tryById groupId conn with match! SmallGroups.tryById groupId conn with
| Some grp -> | Some grp ->
let! reqs = PrayerRequests.countByGroup groupId conn let! reqs = PrayerRequests.countByGroup groupId conn
let! users = Users.countByGroup groupId conn let! users = Users.countByGroup groupId conn
do! SmallGroups.deleteById groupId conn do! SmallGroups.deleteById groupId conn
addInfo ctx addInfo ctx
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", ctx.Strings["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.Name, reqs, users] grp.Name, reqs, users]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
@ -32,14 +31,12 @@ let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fu
/// POST /small-group/member/[member-id]/delete /// POST /small-group/member/[member-id]/delete
let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let memberId = MemberId mbrId let memberId = MemberId mbrId
let! conn = ctx.Conn match! Members.tryById memberId ctx.Conn with
match! Members.tryById memberId conn with
| Some mbr when mbr.SmallGroupId = group.Id -> | Some mbr when mbr.SmallGroupId = group.Id ->
do! Members.deleteById memberId conn do! Members.deleteById memberId ctx.Conn
addHtmlInfo ctx s["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name] addHtmlInfo ctx ctx.Strings["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
@ -47,8 +44,7 @@ let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >
/// GET /small-group/[group-id]/edit /// GET /small-group/[group-id]/edit
let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn let! churches = Churches.all ctx.Conn
let! churches = Churches.all conn
let groupId = SmallGroupId grpId let groupId = SmallGroupId grpId
if groupId.Value = Guid.Empty then if groupId.Value = Guid.Empty then
return! return!
@ -56,7 +52,7 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
match! SmallGroups.tryById groupId conn with match! SmallGroups.tryById groupId ctx.Conn with
| Some grp -> | Some grp ->
return! return!
viewInfo ctx viewInfo ctx
@ -67,9 +63,8 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
/// GET /small-group/member/[member-id]/edit /// GET /small-group/member/[member-id]/edit
let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings
let memberId = MemberId mbrId let memberId = MemberId mbrId
if memberId.Value = Guid.Empty then if memberId.Value = Guid.Empty then
return! return!
@ -77,8 +72,7 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|> Views.SmallGroup.editMember EditMember.empty types ctx |> Views.SmallGroup.editMember EditMember.empty types ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
let! conn = ctx.Conn match! Members.tryById memberId ctx.Conn with
match! Members.tryById memberId conn with
| Some mbr when mbr.SmallGroupId = group.Id -> | Some mbr when mbr.SmallGroupId = group.Id ->
return! return!
viewInfo ctx viewInfo ctx
@ -90,8 +84,7 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
/// GET /small-group/log-on/[group-id?] /// GET /small-group/log-on/[group-id?]
let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! conn = ctx.Conn let! groups = SmallGroups.listProtected ctx.Conn
let! groups = SmallGroups.listProtected conn
let groupId = match grpId with Some gid -> shortGuid gid | None -> "" let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
return! return!
{ viewInfo ctx with HelpLink = Some Help.logOn } { viewInfo ctx with HelpLink = Some Help.logOn }
@ -107,9 +100,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<GroupLogOn> () with match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force () match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password ctx.Conn with
let! conn = ctx.Conn
match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password conn with
| Some group -> | Some group ->
ctx.Session.CurrentGroup <- Some group ctx.Session.CurrentGroup <- Some group
let identity = ClaimsIdentity ( let identity = ClaimsIdentity (
@ -120,18 +111,17 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
AuthenticationProperties ( AuthenticationProperties (
IssuedUtc = DateTimeOffset.UtcNow, IssuedUtc = DateTimeOffset.UtcNow,
IsPersistent = defaultArg model.RememberMe false)) IsPersistent = defaultArg model.RememberMe false))
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] addInfo ctx ctx.Strings["Log On Successful • Welcome to {0}", ctx.Strings["PrayerTracker"]]
return! redirectTo false "/prayer-requests/view" next ctx return! redirectTo false "/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s["Password incorrect - login unsuccessful"] addError ctx ctx.Strings["Password incorrect - login unsuccessful"]
return! redirectTo false $"/small-group/log-on/{model.SmallGroupId}" next ctx return! redirectTo false $"/small-group/log-on/{model.SmallGroupId}" next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /small-groups /// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn let! groups = SmallGroups.infoForAll ctx.Conn
let! groups = SmallGroups.infoForAll conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.SmallGroup.maintain groups ctx |> Views.SmallGroup.maintain groups ctx
@ -141,10 +131,8 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
/// GET /small-group/members /// GET /small-group/members
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let s = Views.I18N.localizer.Force () let! members = Members.forGroup group.Id ctx.Conn
let! conn = ctx.Conn let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings |> Map.ofSeq
let! members = Members.forGroup group.Id conn
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s |> Map.ofSeq
return! return!
{ viewInfo ctx with HelpLink = Some Help.maintainGroupMembers } { viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members members types ctx |> Views.SmallGroup.members members types ctx
@ -154,7 +142,7 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /small-group /// GET /small-group
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn let conn = ctx.Conn
let! reqs = PrayerRequests.forGroup let! reqs = PrayerRequests.forGroup
{ SmallGroup = group { SmallGroup = group
Clock = ctx.Clock Clock = ctx.Clock
@ -199,16 +187,14 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditSmallGroup> () with match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
let! tryGroup = let! tryGroup =
if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () }) if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) conn else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn
match tryGroup with match tryGroup with
| Some group -> | Some group ->
do! SmallGroups.save (model.populateGroup group) model.IsNew conn do! SmallGroups.save (model.populateGroup group) model.IsNew ctx.Conn
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["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
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
@ -219,11 +205,10 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
match! ctx.TryBindFormAsync<EditMember> () with match! ctx.TryBindFormAsync<EditMember> () with
| Ok model -> | Ok model ->
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let! tryMbr = let! tryMbr =
if model.IsNew then if model.IsNew then
Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id }) Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id })
else Members.tryById (idFromShort MemberId model.MemberId) conn else Members.tryById (idFromShort MemberId model.MemberId) ctx.Conn
match tryMbr with match tryMbr with
| Some mbr when mbr.SmallGroupId = group.Id -> | Some mbr when mbr.SmallGroupId = group.Id ->
do! Members.save do! Members.save
@ -231,10 +216,9 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
Name = model.Name Name = model.Name
Email = model.Email Email = model.Email
Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode
} conn } ctx.Conn
let s = Views.I18N.localizer.Force () let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () addInfo ctx ctx.Strings["Successfully {0} group member", act]
addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
@ -249,15 +233,13 @@ 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
let! conn = ctx.Conn match! SmallGroups.tryByIdWithPreferences group.Id ctx.Conn with
match! SmallGroups.tryByIdWithPreferences group.Id conn with | Some group ->
| Some grp -> let pref = model.PopulatePreferences group.Preferences
let pref = model.PopulatePreferences grp.Preferences do! SmallGroups.savePreferences pref ctx.Conn
do! SmallGroups.savePreferences pref conn
// Refresh session instance // Refresh session instance
ctx.Session.CurrentGroup <- Some { grp with Preferences = pref } ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
let s = Views.I18N.localizer.Force () addInfo ctx ctx.Strings["Group preferences updated successfully"]
addInfo ctx s["Group preferences updated successfully"]
return! redirectTo false "/small-group/preferences" next ctx return! redirectTo false "/small-group/preferences" next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
@ -274,7 +256,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
let pref = group.Preferences let pref = group.Preferences
let usr = ctx.Session.CurrentUser.Value let usr = ctx.Session.CurrentUser.Value
let now = SmallGroup.localTimeNow ctx.Clock group let now = SmallGroup.localTimeNow ctx.Clock group
let s = Views.I18N.localizer.Force () let s = ctx.Strings
// Reformat the text to use the class's font stylings // Reformat the text to use the class's font stylings
let requestText = ckEditorToText model.Text let requestText = ckEditorToText model.Text
let htmlText = let htmlText =
@ -282,12 +264,11 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
|> renderHtmlNode |> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails // Send the e-mails
let! conn = ctx.Conn
let! recipients = task { let! recipients = task {
if model.SendToClass = "N" && usr.IsAdmin then if model.SendToClass = "N" && usr.IsAdmin then
let! users = Users.all conn let! users = Users.all ctx.Conn
return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email }) return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email })
else return! Members.forGroup group.Id conn else return! Members.forGroup group.Id ctx.Conn
} }
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails do! Email.sendEmails
@ -316,7 +297,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
Text = requestText Text = requestText
EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant() EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant()
UpdatedDate = now.InZoneLeniently(zone).ToInstant() UpdatedDate = now.InZoneLeniently(zone).ToInstant()
} conn } ctx.Conn
// Tell 'em what they've won, Johnny! // Tell 'em what they've won, Johnny!
let toWhom = let toWhom =
if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value

66
src/PrayerTracker/User.fs
View File

@ -78,12 +78,10 @@ let sanitizeUrl providedUrl defaultUrl =
let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<ChangePassword> () with match! ctx.TryBindFormAsync<ChangePassword> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force ()
let curUsr = ctx.Session.CurrentUser.Value let curUsr = ctx.Session.CurrentUser.Value
let hasher = PrayerTrackerPasswordHasher () let hasher = PrayerTrackerPasswordHasher ()
let! conn = ctx.Conn
let! user = task { let! user = task {
match! Users.tryById curUsr.Id conn with match! Users.tryById curUsr.Id ctx.Conn with
| Some usr -> | Some usr ->
if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword) if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
= PasswordVerificationResult.Success then = PasswordVerificationResult.Success then
@ -93,14 +91,14 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
} }
match user with match user with
| Some usr when model.NewPassword = model.NewPasswordConfirm -> | Some usr when model.NewPassword = model.NewPasswordConfirm ->
do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } conn do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } ctx.Conn
addInfo ctx s["Your password was changed successfully"] addInfo ctx ctx.Strings["Your password was changed successfully"]
return! redirectTo false "/" next ctx return! redirectTo false "/" next ctx
| Some _ -> | Some _ ->
addError ctx s["The new passwords did not match - your password was NOT changed"] addError ctx ctx.Strings["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx return! redirectTo false "/user/password" next ctx
| None -> | None ->
addError ctx s["The old password was incorrect - your password was NOT changed"] addError ctx ctx.Strings["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx return! redirectTo false "/user/password" next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
@ -108,12 +106,10 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
/// POST /user/[user-id]/delete /// POST /user/[user-id]/delete
let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let userId = UserId usrId let userId = UserId usrId
let! conn = ctx.Conn match! Users.tryById userId ctx.Conn with
match! Users.tryById userId conn with
| Some user -> | Some user ->
do! Users.deleteById userId conn do! Users.deleteById userId ctx.Conn
let s = Views.I18N.localizer.Force () addInfo ctx ctx.Strings["Successfully deleted user {0}", user.Name]
addInfo ctx s["Successfully deleted user {0}", user.Name]
return! redirectTo false "/users" next ctx return! redirectTo false "/users" next ctx
| _ -> return! fourOhFour ctx | _ -> return! fourOhFour ctx
} }
@ -128,11 +124,10 @@ open Microsoft.AspNetCore.Html
let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<UserLogOn> () with match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force () let s = ctx.Strings
let! conn = ctx.Conn match! findUserByPassword model ctx.Conn with
match! findUserByPassword model conn with
| Some user -> | Some user ->
match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) conn with match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn 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
@ -146,7 +141,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
AuthenticationProperties ( AuthenticationProperties (
IssuedUtc = DateTimeOffset.UtcNow, IssuedUtc = DateTimeOffset.UtcNow,
IsPersistent = defaultArg model.RememberMe false)) IsPersistent = defaultArg model.RememberMe false))
do! Users.updateLastSeen user.Id ctx.Now conn do! Users.updateLastSeen user.Id ctx.Now ctx.Conn
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
| None -> return! fourOhFour ctx | None -> return! fourOhFour ctx
@ -177,8 +172,7 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
let! conn = ctx.Conn match! Users.tryById userId ctx.Conn with
match! Users.tryById userId conn with
| Some user -> | Some user ->
return! return!
viewInfo ctx viewInfo ctx
@ -189,14 +183,12 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
/// GET /user/log-on /// GET /user/log-on
let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let! groups = SmallGroups.listAll ctx.Conn
let! conn = ctx.Conn
let! groups = SmallGroups.listAll conn
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
match url with match url with
| Some _ -> | Some _ ->
ctx.Session.Remove Key.Session.redirectUrl ctx.Session.Remove Key.Session.redirectUrl
addWarning ctx s["The page you requested requires authentication; please log on below."] addWarning ctx ctx.Strings["The page you requested requires authentication; please log on below."]
| None -> () | None -> ()
return! return!
{ viewInfo ctx with HelpLink = Some Help.logOn } { viewInfo ctx with HelpLink = Some Help.logOn }
@ -206,8 +198,7 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
/// GET /users /// GET /users
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn let! users = Users.all ctx.Conn
let! users = Users.all conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.User.maintain users ctx |> Views.User.maintain users ctx
@ -226,22 +217,22 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
| Ok model -> | Ok model ->
let! conn = ctx.Conn
let! user = let! user =
if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () }) if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
else Users.tryById (idFromShort UserId model.UserId) conn else Users.tryById (idFromShort UserId model.UserId) ctx.Conn
match user with match user with
| Some usr -> | Some usr ->
let hasher = PrayerTrackerPasswordHasher () let hasher = PrayerTrackerPasswordHasher ()
let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw)) let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
do! Users.save updatedUser conn do! Users.save updatedUser ctx.Conn
let s = Views.I18N.localizer.Force () let s = ctx.Strings
if model.IsNew then if model.IsNew then
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.info with { UserMessage.info with
Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()] Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
Description = Description =
h s["Please select at least one group for which this user ({0}) is authorized", updatedUser.Name] h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.Name]
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
@ -257,28 +248,25 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force ()
match Seq.length model.SmallGroups with match Seq.length model.SmallGroups with
| 0 -> | 0 ->
addError ctx s["You must select at least one group to assign"] addError ctx ctx.Strings["You must select at least one group to assign"]
return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx
| _ -> | _ ->
let! conn = ctx.Conn
do! Users.updateSmallGroups (idFromShort UserId model.UserId) do! Users.updateSmallGroups (idFromShort UserId model.UserId)
(model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) conn (model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) ctx.Conn
addInfo ctx s["Successfully updated group permissions for {0}", model.UserName] addInfo ctx ctx.Strings["Successfully updated group permissions for {0}", model.UserName]
return! redirectTo false "/users" next ctx return! redirectTo false "/users" next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /user/[user-id]/small-groups /// GET /user/[user-id]/small-groups
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let userId = UserId usrId let userId = UserId usrId
match! Users.tryById userId conn with match! Users.tryById userId ctx.Conn with
| Some user -> | Some user ->
let! groups = SmallGroups.listAll conn let! groups = SmallGroups.listAll ctx.Conn
let! groupIds = Users.groupIdsByUserId userId conn let! groupIds = Users.groupIdsByUserId userId ctx.Conn
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

1
src/PrayerTracker/wwwroot/css/app.css
View File

@ -156,6 +156,7 @@ input[type=text],
input[type=password], input[type=password],
input[type=date], input[type=date],
input[type=number], input[type=number],
input[type=url],
select { select {
border-radius: .2rem; border-radius: .2rem;
border-color: var(--lighter-dark); border-color: var(--lighter-dark);

10
src/names-to-lower.sql
View File

@ -76,13 +76,9 @@ ALTER TABLE pt."SmallGroup" RENAME TO small_group;
ALTER INDEX pt."IX_SmallGroup_ChurchId" RENAME TO ix_small_group_church_id; ALTER INDEX pt."IX_SmallGroup_ChurchId" RENAME TO ix_small_group_church_id;
-- Time Zone -- Time Zone (goes away)
ALTER TABLE pt."TimeZone" RENAME COLUMN "TimeZoneId" TO id; ALTER TABLE pt.list_preference DROP CONSTRAINT fk_list_preference_time_zone_id;
ALTER TABLE pt."TimeZone" RENAME COLUMN "Description" TO description; DROP TABLE pt."TimeZone";
ALTER TABLE pt."TimeZone" RENAME COLUMN "SortOrder" TO sort_order;
ALTER TABLE pt."TimeZone" RENAME COLUMN "IsActive" TO is_active;
ALTER TABLE pt."TimeZone" RENAME CONSTRAINT "PK_TimeZone" TO pk_time_zone;
ALTER TABLE pt."TimeZone" RENAME TO time_zone;
-- User -- User
ALTER TABLE pt."User" RENAME COLUMN "UserId" TO id; ALTER TABLE pt."User" RENAME COLUMN "UserId" TO id;