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

Move module funcs to properties

Browse Source
This commit is contained in:
Daniel J. Summers 2025-01-30 20:36:00 -05:00
parent facc294d66
commit 42e3a58131
12 changed files with 384 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,7 @@ open PrayerTracker.Entities
/// 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 /// Map a row to a Church instance
let mapToChurch (row : RowReader) = let mapToChurch (row : RowReader) =
{ Id = ChurchId (row.uuid "id") { Id = ChurchId (row.uuid "id")
@ -18,7 +18,7 @@ module private Helpers =
HasVpsInterface = row.bool "has_vps_interface" HasVpsInterface = row.bool "has_vps_interface"
InterfaceAddress = row.stringOrNone "interface_address" InterfaceAddress = row.stringOrNone "interface_address"
} }
/// Map a row to a ListPreferences instance /// Map a row to a ListPreferences instance
let mapToListPreferences (row : RowReader) = let mapToListPreferences (row : RowReader) =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id") { SmallGroupId = SmallGroupId (row.uuid "small_group_id")
@ -40,7 +40,7 @@ module private Helpers =
DefaultEmailType = EmailFormat.Parse (row.string "default_email_type") DefaultEmailType = EmailFormat.Parse (row.string "default_email_type")
AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display") AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display")
} }
/// Map a row to a Member instance /// Map a row to a Member instance
let mapToMember (row : RowReader) = let mapToMember (row : RowReader) =
{ Id = MemberId (row.uuid "id") { Id = MemberId (row.uuid "id")
@ -49,7 +49,7 @@ module private Helpers =
Email = row.string "email" Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse 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")
@ -63,15 +63,15 @@ module private Helpers =
RequestType = PrayerRequestType.Parse (row.string "request_type") RequestType = PrayerRequestType.Parse (row.string "request_type")
Expiration = Expiration.Parse (row.string "expiration") Expiration = Expiration.Parse (row.string "expiration")
} }
/// Map a row to a Small Group instance /// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) = let mapToSmallGroup (row : RowReader) =
{ Id = SmallGroupId (row.uuid "id") { Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id") ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name" Name = row.string "group_name"
Preferences = ListPreferences.empty 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")
@ -80,17 +80,17 @@ module private Helpers =
TimeZoneId = TimeZoneId (row.string "time_zone_id") TimeZoneId = TimeZoneId (row.string "time_zone_id")
IsPublic = row.bool "is_public" IsPublic = row.bool "is_public"
} }
/// Map a row to a Small Group list item /// Map a row to a Small Group list item
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 /// Map a row to a Small Group instance with populated list preferences
let mapToSmallGroupWithPreferences (row : RowReader) = let mapToSmallGroupWithPreferences (row : RowReader) =
{ mapToSmallGroup row with { mapToSmallGroup row with
Preferences = mapToListPreferences row 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")
@ -107,11 +107,11 @@ open BitBadger.Documents.Postgres
/// 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 Custom.list "SELECT * FROM pt.church ORDER BY church_name" [] mapToChurch
/// 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 ] ]
@ -127,7 +127,7 @@ module Churches =
"DELETE FROM pt.church WHERE id = @churchId", idParam ] "DELETE FROM pt.church WHERE id = @churchId", idParam ]
() ()
} }
/// Save a church's information /// Save a church's information
let save (church : Church) = let save (church : Church) =
Custom.nonQuery Custom.nonQuery
@ -147,7 +147,7 @@ module Churches =
"@state", Sql.string church.State "@state", Sql.string church.State
"@hasVpsInterface", Sql.bool church.HasVpsInterface "@hasVpsInterface", Sql.bool church.HasVpsInterface
"@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ] "@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ]
/// Find a church by its ID /// Find a church by its ID
let tryById (churchId : ChurchId) = let tryById (churchId : ChurchId) =
Custom.single "SELECT * FROM pt.church WHERE id = @id" [ "@id", Sql.uuid churchId.Value ] mapToChurch Custom.single "SELECT * FROM pt.church WHERE id = @id" [ "@id", Sql.uuid churchId.Value ] mapToChurch
@ -155,21 +155,21 @@ module Churches =
/// 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" Custom.scalar "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId"
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "mbr_count") [ "@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 ] Custom.nonQuery "DELETE FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ]
/// 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" Custom.list "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name"
[ "@groupId", Sql.uuid groupId.Value ] mapToMember [ "@groupId", Sql.uuid groupId.Value ] mapToMember
/// Save a small group member /// Save a small group member
let save (mbr : Member) = let save (mbr : Member) =
Custom.nonQuery Custom.nonQuery
@ -186,7 +186,7 @@ module Members =
"@name", Sql.string mbr.Name "@name", Sql.string mbr.Name
"@email", Sql.string mbr.Email "@email", Sql.string mbr.Email
"@format", Sql.stringOrNone (mbr.Format |> Option.map string) ] "@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 : MemberId) =
Custom.single "SELECT * FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] mapToMember Custom.single "SELECT * FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] mapToMember
@ -196,16 +196,16 @@ module Members =
type PrayerRequestOptions = type PrayerRequestOptions =
{ /// The small group for which requests should be retrieved { /// The small group for which requests should be retrieved
SmallGroup : SmallGroup SmallGroup : SmallGroup
/// The clock instance to use for date/time manipulation /// The clock instance to use for date/time manipulation
Clock : IClock Clock : IClock
/// The date for which the list is being retrieved /// The date for which the list is being retrieved
ListDate : LocalDate option ListDate : LocalDate option
/// Whether only active requests should be retrieved /// Whether only active requests should be retrieved
ActiveOnly : bool ActiveOnly : bool
/// The page number, for paged lists /// The page number, for paged lists
PageNumber : int PageNumber : int
} }
@ -213,17 +213,17 @@ type PrayerRequestOptions =
/// Functions to manipulate prayer requests /// Functions to manipulate prayer requests
module PrayerRequests = module PrayerRequests =
/// Central place to append sort criteria for prayer request queries /// Central place to append sort criteria for prayer request queries
let private orderBy sort = let private orderBy sort =
match sort with match sort with
| SortByDate -> "updated_date DESC, entered_date DESC, requestor" | SortByDate -> "updated_date DESC, entered_date DESC, requestor"
| SortByRequestor -> "requestor, updated_date DESC, entered_date DESC" | 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 =
if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else "" if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else ""
/// Count the number of prayer requests for a church /// Count the number of prayer requests for a church
let countByChurch (churchId : ChurchId) = let countByChurch (churchId : ChurchId) =
Custom.scalar Custom.scalar
@ -231,24 +231,24 @@ module PrayerRequests =
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" Custom.scalar "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId"
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "req_count") [ "@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 ] Custom.nonQuery "DELETE FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ]
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
let forGroup (opts : PrayerRequestOptions) = let forGroup (opts : PrayerRequestOptions) =
let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup) let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock)
let where, parameters = let where, parameters =
if opts.ActiveOnly then if opts.ActiveOnly then
let asOf = NpgsqlParameter ( let asOf = NpgsqlParameter (
"@asOf", "@asOf",
(theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup) (theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire) - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ()) .ToInstant ())
" AND ( updated_date > @asOf " AND ( updated_date > @asOf
@ -269,7 +269,7 @@ module PrayerRequests =
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}"
(("@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 : PrayerRequest) =
Custom.nonQuery Custom.nonQuery
@ -296,10 +296,10 @@ module PrayerRequests =
"@text", Sql.string req.Text "@text", Sql.string req.Text
"@notifyChaplain", Sql.bool req.NotifyChaplain "@notifyChaplain", Sql.bool req.NotifyChaplain
"@expiration", Sql.string (string req.Expiration) ] "@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 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
@ -311,7 +311,7 @@ module PrayerRequests =
let tryById (reqId : PrayerRequestId) = let tryById (reqId : PrayerRequestId) =
Custom.single "SELECT * FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] Custom.single "SELECT * FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ]
mapToPrayerRequest 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 = let sql, parameters =
@ -326,12 +326,12 @@ module PrayerRequests =
/// 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" Custom.scalar "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId"
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "group_count") [ "@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 ] ]
@ -345,7 +345,7 @@ module SmallGroups =
"DELETE FROM pt.small_group WHERE id = @groupId", idParam ] "DELETE FROM pt.small_group WHERE id = @groupId", idParam ]
() ()
} }
/// Get information for all small groups /// Get information for all small groups
let infoForAll () = let infoForAll () =
Custom.list Custom.list
@ -355,7 +355,7 @@ module SmallGroups =
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
ORDER BY sg.group_name" ORDER BY sg.group_name"
[] mapToSmallGroupInfo [] mapToSmallGroupInfo
/// 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 Custom.list
@ -364,7 +364,7 @@ module SmallGroups =
INNER JOIN pt.church c ON c.id = g.church_id INNER JOIN pt.church c ON c.id = g.church_id
ORDER BY c.church_name, g.group_name" ORDER BY c.church_name, g.group_name"
[] mapToSmallGroupItem [] mapToSmallGroupItem
/// 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 Custom.list
@ -375,7 +375,7 @@ module SmallGroups =
WHERE COALESCE(lp.group_password, '') <> '' WHERE COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name" ORDER BY c.church_name, g.group_name"
[] mapToSmallGroupItem [] mapToSmallGroupItem
/// 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 Custom.list
@ -387,7 +387,7 @@ module SmallGroups =
OR COALESCE(lp.group_password, '') <> '' OR COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name" ORDER BY c.church_name, g.group_name"
[] 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 =
Custom.single Custom.single
@ -397,7 +397,7 @@ module SmallGroups =
WHERE sg.id = @id WHERE sg.id = @id
AND lp.group_password = @password" AND lp.group_password = @password"
[ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ] mapToSmallGroupWithPreferences [ "@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 : SmallGroup) isNew = backgroundTask {
let! _ = let! _ =
@ -420,7 +420,7 @@ module SmallGroups =
] ]
() ()
} }
/// Save a small group's list preferences /// Save a small group's list preferences
let savePreferences (pref : ListPreferences) = let savePreferences (pref : ListPreferences) =
Custom.nonQuery Custom.nonQuery
@ -458,14 +458,14 @@ module SmallGroups =
"@groupPassword", Sql.string pref.GroupPassword "@groupPassword", Sql.string pref.GroupPassword
"@defaultEmailType", Sql.string (string pref.DefaultEmailType) "@defaultEmailType", Sql.string (string pref.DefaultEmailType)
"@isPublic", Sql.bool pref.IsPublic "@isPublic", Sql.bool pref.IsPublic
"@timeZoneId", Sql.string (TimeZoneId.toString pref.TimeZoneId) "@timeZoneId", Sql.string (string pref.TimeZoneId)
"@pageSize", Sql.int pref.PageSize "@pageSize", Sql.int pref.PageSize
"@asOfDateDisplay", Sql.string (string pref.AsOfDateDisplay) ] "@asOfDateDisplay", Sql.string (string pref.AsOfDateDisplay) ]
/// Get a small group by its ID /// Get a small group by its ID
let tryById (groupId : SmallGroupId) = let tryById (groupId : SmallGroupId) =
Custom.single "SELECT * FROM pt.small_group WHERE id = @id" [ "@id", Sql.uuid groupId.Value ] mapToSmallGroup Custom.single "SELECT * FROM pt.small_group WHERE id = @id" [ "@id", Sql.uuid groupId.Value ] mapToSmallGroup
/// 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) = let tryByIdWithPreferences (groupId : SmallGroupId) =
Custom.single Custom.single
@ -478,11 +478,11 @@ module SmallGroups =
/// Functions to manipulate users /// Functions to manipulate users
module Users = 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 Custom.list "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" [] mapToUser
/// 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 Custom.scalar
@ -495,21 +495,21 @@ module Users =
WHERE usg.user_id = u.id WHERE usg.user_id = u.id
AND sg.church_id = @churchId)" AND sg.church_id = @churchId)"
[ "@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" Custom.scalar "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId"
[ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "user_count") [ "@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 ] Custom.nonQuery "DELETE FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ]
/// 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) = let groupIdsByUserId (userId : UserId) =
Custom.list "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id" 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")) [ "@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 Custom.list
@ -519,9 +519,9 @@ module Users =
WHERE usg.small_group_id = @groupId WHERE usg.small_group_id = @groupId
ORDER BY u.last_name, u.first_name" ORDER BY u.last_name, u.first_name"
[ "@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 : User) =
Custom.nonQuery Custom.nonQuery
"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
@ -539,7 +539,7 @@ module Users =
"@email", Sql.string user.Email "@email", Sql.string user.Email
"@isAdmin", Sql.bool user.IsAdmin "@isAdmin", Sql.bool user.IsAdmin
"@passwordHash", Sql.string user.PasswordHash ] "@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 (groupId : SmallGroupId) =
Custom.single Custom.single
@ -548,21 +548,21 @@ module Users =
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId
WHERE u.email = @email" WHERE u.email = @email"
[ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ] mapToUser [ "@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 : UserId) =
Custom.single "SELECT * FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] mapToUser Custom.single "SELECT * FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] mapToUser
/// 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" Custom.nonQuery "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
[ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", 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" Custom.nonQuery "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
[ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string 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 = backgroundTask {
let! existingGroupIds = groupIdsByUserId userId let! existingGroupIds = groupIdsByUserId userId

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

@ -174,14 +174,11 @@ type SmallGroupId =
/// PK type for the TimeZone entity /// PK type for the TimeZone entity
type TimeZoneId = TimeZoneId of string type TimeZoneId =
| TimeZoneId of string
/// Functions to support time zone IDs override this.ToString() =
module TimeZoneId = match this with
/// Convert a time zone ID to its string value
let toString =
function
| TimeZoneId it -> it | TimeZoneId it -> it
@ -259,12 +256,9 @@ type Church =
InterfaceAddress: string option InterfaceAddress: string option
} }
/// Functions to support churches
module Church =
/// An empty church /// An empty church
// aww... how sad :( // aww... how sad :(
let empty = static member Empty =
{ Id = ChurchId Guid.Empty { Id = ChurchId Guid.Empty
Name = "" Name = ""
City = "" City = ""
@ -339,11 +333,8 @@ type ListPreferences =
else else
this.Fonts this.Fonts
/// Functions to support list preferences
module ListPreferences =
/// A set of preferences with their default values /// A set of preferences with their default values
let empty = static member Empty =
{ SmallGroupId = SmallGroupId Guid.Empty { SmallGroupId = SmallGroupId Guid.Empty
DaysToExpire = 14 DaysToExpire = 14
DaysToKeepNew = 7 DaysToKeepNew = 7
@ -384,11 +375,8 @@ type Member =
Format: EmailFormat option Format: EmailFormat option
} }
/// Functions to support small group members
module Member =
/// An empty member /// An empty member
let empty = static member Empty =
{ Id = MemberId Guid.Empty { Id = MemberId Guid.Empty
SmallGroupId = SmallGroupId Guid.Empty SmallGroupId = SmallGroupId Guid.Empty
Name = "" Name = ""
@ -396,6 +384,50 @@ module Member =
Format = None } Format = None }
/// This represents a small group (Sunday School class, Bible study group, etc.)
[<NoComparison; NoEquality>]
type SmallGroup =
{
/// The ID of this small group
Id: SmallGroupId
/// The church to which this group belongs
ChurchId: ChurchId
/// The name of the group
Name: string
/// The preferences for the request list
Preferences: ListPreferences
}
/// The DateTimeZone for the time zone ID for this small group
member this.TimeZone =
let tzId = string this.Preferences.TimeZoneId
if DateTimeZoneProviders.Tzdb.Ids.Contains tzId then
DateTimeZoneProviders.Tzdb[tzId]
else
DateTimeZone.Utc
/// Get the local date/time for this group
member this.LocalTimeNow(clock: IClock) =
if isNull clock then
nullArg (nameof clock)
clock.GetCurrentInstant().InZone(this.TimeZone).LocalDateTime
/// Get the local date for this group
member this.LocalDateNow clock = this.LocalTimeNow(clock).Date
/// An empty small group
static member Empty =
{ Id = SmallGroupId Guid.Empty
ChurchId = ChurchId Guid.Empty
Name = ""
Preferences = ListPreferences.Empty }
/// This represents a single prayer request /// This represents a single prayer request
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type PrayerRequest = type PrayerRequest =
@ -430,61 +462,31 @@ type PrayerRequest =
/// Is this request expired? /// Is this request expired?
Expiration: Expiration Expiration: Expiration
} }
// functions are below small group functions
/// Is this request expired?
member this.IsExpired (asOf: LocalDate) (group: SmallGroup) =
match this.Expiration, this.RequestType with
| Forced, _ -> true
| Manual, _
| Automatic, LongTermRequest
| Automatic, Expecting -> false
| Automatic, _ ->
// Automatic expiration
Period
.Between(this.UpdatedDate.InZone(group.TimeZone).Date, asOf, PeriodUnits.Days)
.Days
>= group.Preferences.DaysToExpire
/// This represents a small group (Sunday School class, Bible study group, etc.) /// Is an update required for this long-term request?
[<NoComparison; NoEquality>] member this.UpdateRequired asOf group =
type SmallGroup = if this.IsExpired asOf group then
{ false
/// The ID of this small group
Id: SmallGroupId
/// The church to which this group belongs
ChurchId: ChurchId
/// The name of the group
Name: string
/// The preferences for the request list
Preferences: ListPreferences
}
/// Functions to support small groups
module SmallGroup =
/// An empty small group
let empty =
{ Id = SmallGroupId Guid.Empty
ChurchId = ChurchId Guid.Empty
Name = ""
Preferences = ListPreferences.empty }
/// The DateTimeZone for the time zone ID for this small group
let timeZone group =
let tzId = TimeZoneId.toString group.Preferences.TimeZoneId
if DateTimeZoneProviders.Tzdb.Ids.Contains tzId then
DateTimeZoneProviders.Tzdb[tzId]
else else
DateTimeZone.Utc asOf.PlusWeeks -group.Preferences.LongTermUpdateWeeks
>= this.UpdatedDate.InZone(group.TimeZone).Date
/// Get the local date/time for this group
let localTimeNow (clock: IClock) group =
if isNull clock then
nullArg (nameof clock)
clock.GetCurrentInstant().InZone(timeZone group).LocalDateTime
/// Get the local date for this group
let localDateNow clock group = (localTimeNow clock group).Date
/// Functions to support prayer requests
module PrayerRequest =
/// An empty request /// An empty request
let empty = static member Empty =
{ Id = PrayerRequestId Guid.Empty { Id = PrayerRequestId Guid.Empty
RequestType = CurrentRequest RequestType = CurrentRequest
UserId = UserId Guid.Empty UserId = UserId Guid.Empty
@ -496,28 +498,6 @@ module PrayerRequest =
NotifyChaplain = false NotifyChaplain = false
Expiration = Automatic } Expiration = Automatic }
/// Is this request expired?
let isExpired (asOf: LocalDate) group req =
match req.Expiration, req.RequestType with
| Forced, _ -> true
| Manual, _
| Automatic, LongTermRequest
| Automatic, Expecting -> false
| Automatic, _ ->
// Automatic expiration
Period
.Between(req.UpdatedDate.InZone(SmallGroup.timeZone group).Date, asOf, PeriodUnits.Days)
.Days
>= group.Preferences.DaysToExpire
/// Is an update required for this long-term request?
let updateRequired asOf group req =
if isExpired asOf group req then
false
else
asOf.PlusWeeks -group.Preferences.LongTermUpdateWeeks
>= req.UpdatedDate.InZone(SmallGroup.timeZone group).Date
/// This represents a user of PrayerTracker /// This represents a user of PrayerTracker
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
@ -548,11 +528,8 @@ type User =
/// The full name of the user /// The full name of the user
member this.Name = $"{this.FirstName} {this.LastName}" member this.Name = $"{this.FirstName} {this.LastName}"
/// Functions to support users
module User =
/// An empty user /// An empty user
let empty = static member Empty =
{ Id = UserId Guid.Empty { Id = UserId Guid.Empty
FirstName = "" FirstName = ""
LastName = "" LastName = ""
@ -573,10 +550,7 @@ type UserSmallGroup =
SmallGroupId: SmallGroupId SmallGroupId: SmallGroupId
} }
/// Functions to support user/small group cross-reference
module UserSmallGroup =
/// An empty user/small group xref /// An empty user/small group xref
let empty = static member Empty =
{ UserId = UserId Guid.Empty { UserId = UserId Guid.Empty
SmallGroupId = SmallGroupId Guid.Empty } SmallGroupId = SmallGroupId Guid.Empty }

114
src/PrayerTracker.Tests/Data/EntitiesTests.fs
View File

@ -39,8 +39,8 @@ let asOfDateDisplayTests =
[<Tests>] [<Tests>]
let churchTests = let churchTests =
testList "Church" [ testList "Church" [
test "empty is as expected" { test "Empty is as expected" {
let mt = Church.empty let mt = Church.Empty
Expect.equal mt.Id.Value Guid.Empty "The church ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.Name "" "The name should have been blank" Expect.equal mt.Name "" "The name should have been blank"
Expect.equal mt.City "" "The city should have been blank" Expect.equal mt.City "" "The city should have been blank"
@ -111,16 +111,16 @@ let expirationTests =
let listPreferencesTests = let listPreferencesTests =
testList "ListPreferences" [ testList "ListPreferences" [
test "FontStack is correct for native fonts" { test "FontStack is correct for native fonts" {
Expect.equal ListPreferences.empty.FontStack Expect.equal ListPreferences.Empty.FontStack
"""system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif""" """system-ui,-apple-system,"Segoe UI",Roboto,Ubuntu,"Liberation Sans",Cantarell,"Helvetica Neue",sans-serif"""
"The expected native font stack was incorrect" "The expected native font stack was incorrect"
} }
test "FontStack is correct for specific fonts" { test "FontStack is correct for specific fonts" {
Expect.equal { ListPreferences.empty with Fonts = "Arial,sans-serif" }.FontStack "Arial,sans-serif" Expect.equal { ListPreferences.Empty with Fonts = "Arial,sans-serif" }.FontStack "Arial,sans-serif"
"The specified fonts were not returned correctly" "The specified fonts were not returned correctly"
} }
test "empty is as expected" { test "Empty is as expected" {
let mt = ListPreferences.empty let mt = ListPreferences.Empty
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14" Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14"
Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7" Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7"
@ -137,8 +137,7 @@ let listPreferencesTests =
Expect.equal mt.GroupPassword "" "The default group password should have been blank" Expect.equal mt.GroupPassword "" "The default group password should have been blank"
Expect.equal mt.DefaultEmailType HtmlFormat "The default e-mail type should have been HTML" Expect.equal mt.DefaultEmailType HtmlFormat "The default e-mail type should have been HTML"
Expect.isFalse mt.IsPublic "The isPublic flag should not have been set" Expect.isFalse mt.IsPublic "The isPublic flag should not have been set"
Expect.equal (TimeZoneId.toString mt.TimeZoneId) "America/Denver" Expect.equal (string mt.TimeZoneId) "America/Denver" "The default time zone should have been America/Denver"
"The default time zone should have been America/Denver"
Expect.equal mt.PageSize 100 "The default page size should have been 100" Expect.equal mt.PageSize 100 "The default page size should have been 100"
Expect.equal mt.AsOfDateDisplay NoDisplay "The as-of date display should have been No Display" Expect.equal mt.AsOfDateDisplay NoDisplay "The as-of date display should have been No Display"
} }
@ -147,8 +146,8 @@ let listPreferencesTests =
[<Tests>] [<Tests>]
let memberTests = let memberTests =
testList "Member" [ testList "Member" [
test "empty is as expected" { test "Empty is as expected" {
let mt = Member.empty let mt = Member.Empty
Expect.equal mt.Id.Value Guid.Empty "The member ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The member ID should have been an empty GUID"
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.Name "" "The member name should have been blank" Expect.equal mt.Name "" "The member name should have been blank"
@ -162,8 +161,8 @@ let prayerRequestTests =
let instantNow = SystemClock.Instance.GetCurrentInstant let instantNow = SystemClock.Instance.GetCurrentInstant
let localDateNow () = (instantNow ()).InUtc().Date let localDateNow () = (instantNow ()).InUtc().Date
testList "PrayerRequest" [ testList "PrayerRequest" [
test "empty is as expected" { test "Empty is as expected" {
let mt = PrayerRequest.empty let mt = PrayerRequest.Empty
Expect.equal mt.Id.Value Guid.Empty "The request ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The request ID should have been an empty GUID"
Expect.equal mt.RequestType CurrentRequest "The request type should have been Current" Expect.equal mt.RequestType CurrentRequest "The request type should have been Current"
Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
@ -175,59 +174,60 @@ let prayerRequestTests =
Expect.isFalse mt.NotifyChaplain "The notify chaplain flag should not have been set" Expect.isFalse mt.NotifyChaplain "The notify chaplain flag should not have been set"
Expect.equal mt.Expiration Automatic "The expiration should have been Automatic" Expect.equal mt.Expiration Automatic "The expiration should have been Automatic"
} }
test "isExpired always returns false for expecting requests" { test "IsExpired always returns false for expecting requests" {
PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with RequestType = Expecting }.IsExpired (localDateNow ()) SmallGroup.Empty
{ PrayerRequest.empty with RequestType = Expecting }
|> Flip.Expect.isFalse "An expecting request should never be considered expired" |> Flip.Expect.isFalse "An expecting request should never be considered expired"
} }
test "isExpired always returns false for manually-expired requests" { test "IsExpired always returns false for manually-expired requests" {
PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with
{ PrayerRequest.empty with UpdatedDate = (instantNow ()) - Duration.FromDays 1; Expiration = Manual } UpdatedDate = (instantNow ()) - Duration.FromDays 1
Expiration = Manual }.IsExpired (localDateNow ()) SmallGroup.Empty
|> Flip.Expect.isFalse "A never-expired request should never be considered expired" |> Flip.Expect.isFalse "A never-expired request should never be considered expired"
} }
test "isExpired always returns false for long term/recurring requests" { test "IsExpired always returns false for long term/recurring requests" {
PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with RequestType = LongTermRequest }.IsExpired (localDateNow ()) SmallGroup.Empty
{ PrayerRequest.empty with RequestType = LongTermRequest }
|> Flip.Expect.isFalse "A recurring/long-term request should never be considered expired" |> Flip.Expect.isFalse "A recurring/long-term request should never be considered expired"
} }
test "isExpired always returns true for force-expired requests" { test "IsExpired always returns true for force-expired requests" {
PrayerRequest.isExpired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with UpdatedDate = (instantNow ()); Expiration = Forced }.IsExpired
{ PrayerRequest.empty with UpdatedDate = (instantNow ()); Expiration = Forced } (localDateNow ()) SmallGroup.Empty
|> Flip.Expect.isTrue "A force-expired request should always be considered expired" |> Flip.Expect.isTrue "A force-expired request should always be considered expired"
} }
test "isExpired returns false for non-expired requests" { test "IsExpired returns false for non-expired requests" {
let now = instantNow () let now = instantNow ()
PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty { PrayerRequest.Empty with UpdatedDate = now - Duration.FromDays 5 }.IsExpired
{ PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 5 } (now.InUtc().Date) SmallGroup.Empty
|> Flip.Expect.isFalse "A request updated 5 days ago should not be considered expired" |> Flip.Expect.isFalse "A request updated 5 days ago should not be considered expired"
} }
test "isExpired returns true for expired requests" { test "IsExpired returns true for expired requests" {
let now = instantNow () let now = instantNow ()
PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty { PrayerRequest.Empty with UpdatedDate = now - Duration.FromDays 15 }.IsExpired
{ PrayerRequest.empty with UpdatedDate = now - Duration.FromDays 15 } (now.InUtc().Date) SmallGroup.Empty
|> Flip.Expect.isTrue "A request updated 15 days ago should be considered expired" |> Flip.Expect.isTrue "A request updated 15 days ago should be considered expired"
} }
test "isExpired returns true for same-day expired requests" { test "IsExpired returns true for same-day expired requests" {
let now = instantNow () let now = instantNow ()
PrayerRequest.isExpired (now.InUtc().Date) SmallGroup.empty { PrayerRequest.Empty with
{ PrayerRequest.empty with UpdatedDate = now - (Duration.FromDays 14) - (Duration.FromSeconds 1L) } UpdatedDate = now - (Duration.FromDays 14) - (Duration.FromSeconds 1L) }.IsExpired
(now.InUtc().Date) SmallGroup.Empty
|> Flip.Expect.isTrue "A request entered a second before midnight should be considered expired" |> Flip.Expect.isTrue "A request entered a second before midnight should be considered expired"
} }
test "updateRequired returns false for expired requests" { test "UpdateRequired returns false for expired requests" {
PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with Expiration = Forced }.UpdateRequired (localDateNow ()) SmallGroup.Empty
{ PrayerRequest.empty with Expiration = Forced }
|> Flip.Expect.isFalse "An expired request should not require an update" |> Flip.Expect.isFalse "An expired request should not require an update"
} }
test "updateRequired returns false when an update is not required for an active request" { test "UpdateRequired returns false when an update is not required for an active request" {
let now = instantNow () let now = instantNow ()
PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with
{ PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 14 } RequestType = LongTermRequest
UpdatedDate = now - Duration.FromDays 14 }.UpdateRequired (localDateNow ()) SmallGroup.Empty
|> Flip.Expect.isFalse "An active request updated 14 days ago should not require an update until 28 days" |> Flip.Expect.isFalse "An active request updated 14 days ago should not require an update until 28 days"
} }
test "UpdateRequired returns true when an update is required for an active request" { test "UpdateRequired returns true when an update is required for an active request" {
let now = instantNow () let now = instantNow ()
PrayerRequest.updateRequired (localDateNow ()) SmallGroup.empty { PrayerRequest.Empty with
{ PrayerRequest.empty with RequestType = LongTermRequest; UpdatedDate = now - Duration.FromDays 34 } RequestType = LongTermRequest
UpdatedDate = now - Duration.FromDays 34 }.UpdateRequired (localDateNow ()) SmallGroup.Empty
|> Flip.Expect.isTrue "An active request updated 34 days ago should require an update (past 28 days)" |> Flip.Expect.isTrue "An active request updated 34 days ago should require an update (past 28 days)"
} }
] ]
@ -311,8 +311,8 @@ let smallGroupTests =
let now = Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc)) let now = Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc))
let withFakeClock f () = let withFakeClock f () =
FakeClock now |> f FakeClock now |> f
yield test "empty is as expected" { yield test "Empty is as expected" {
let mt = SmallGroup.empty let mt = SmallGroup.Empty
Expect.equal mt.Id.Value Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.ChurchId.Value Guid.Empty "The church ID should have been an empty GUID" Expect.equal mt.ChurchId.Value Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.Name "" "The name should have been blank" Expect.equal mt.Name "" "The name should have been blank"
@ -321,31 +321,31 @@ let smallGroupTests =
"LocalTimeNow adjusts the time ahead of UTC", "LocalTimeNow adjusts the time ahead of UTC",
fun clock -> fun clock ->
let grp = let grp =
{ SmallGroup.empty with { SmallGroup.Empty with
Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "Europe/Berlin" } Preferences = { ListPreferences.Empty with TimeZoneId = TimeZoneId "Europe/Berlin" }
} }
Expect.isGreaterThan (SmallGroup.localTimeNow clock grp) (now.InUtc().LocalDateTime) Expect.isGreaterThan (grp.LocalTimeNow clock) (now.InUtc().LocalDateTime)
"UTC to Europe/Berlin should have added hours" "UTC to Europe/Berlin should have added hours"
"LocalTimeNow adjusts the time behind UTC", "LocalTimeNow adjusts the time behind UTC",
fun clock -> fun clock ->
Expect.isLessThan (SmallGroup.localTimeNow clock SmallGroup.empty) (now.InUtc().LocalDateTime) Expect.isLessThan (SmallGroup.Empty.LocalTimeNow clock) (now.InUtc().LocalDateTime)
"UTC to America/Denver should have subtracted hours" "UTC to America/Denver should have subtracted hours"
"LocalTimeNow returns UTC when the time zone is invalid", "LocalTimeNow returns UTC when the time zone is invalid",
fun clock -> fun clock ->
let grp = let grp =
{ SmallGroup.empty with { SmallGroup.Empty with
Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "garbage" } Preferences = { ListPreferences.Empty with TimeZoneId = TimeZoneId "garbage" }
} }
Expect.equal (SmallGroup.localTimeNow clock grp) (now.InUtc().LocalDateTime) Expect.equal (grp.LocalTimeNow clock) (now.InUtc().LocalDateTime)
"UTC should have been returned for an invalid time zone" "UTC should have been returned for an invalid time zone"
] ]
yield test "localTimeNow fails when clock is not passed" { yield test "localTimeNow fails when clock is not passed" {
Expect.throws (fun () -> (SmallGroup.localTimeNow null SmallGroup.empty |> ignore)) Expect.throws (fun () -> SmallGroup.Empty.LocalTimeNow null |> ignore)
"Should have raised an exception for null clock" "Should have raised an exception for null clock"
} }
yield test "LocalDateNow returns the date portion" { yield test "LocalDateNow returns the date portion" {
let clock = FakeClock (Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc))) let clock = FakeClock (Instant.FromDateTimeUtc (DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc)))
Expect.isLessThan (SmallGroup.localDateNow clock SmallGroup.empty) (now.InUtc().Date) Expect.isLessThan (SmallGroup.Empty.LocalDateNow clock) (now.InUtc().Date)
"The date should have been a day earlier" "The date should have been a day earlier"
} }
] ]
@ -353,8 +353,8 @@ let smallGroupTests =
[<Tests>] [<Tests>]
let userTests = let userTests =
testList "User" [ testList "User" [
test "empty is as expected" { test "Empty is as expected" {
let mt = User.empty let mt = User.Empty
Expect.equal mt.Id.Value Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.Id.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.FirstName "" "The first name should have been blank" Expect.equal mt.FirstName "" "The first name should have been blank"
Expect.equal mt.LastName "" "The last name should have been blank" Expect.equal mt.LastName "" "The last name should have been blank"
@ -363,7 +363,7 @@ let userTests =
Expect.equal mt.PasswordHash "" "The password hash should have been blank" Expect.equal mt.PasswordHash "" "The password hash should have been blank"
} }
test "Name concatenates first and last names" { test "Name concatenates first and last names" {
let user = { User.empty with FirstName = "Unit"; LastName = "Test" } let user = { User.Empty with FirstName = "Unit"; LastName = "Test" }
Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space" Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space"
} }
] ]
@ -371,8 +371,8 @@ let userTests =
[<Tests>] [<Tests>]
let userSmallGroupTests = let userSmallGroupTests =
testList "UserSmallGroup" [ testList "UserSmallGroup" [
test "empty is as expected" { test "Empty is as expected" {
let mt = UserSmallGroup.empty let mt = UserSmallGroup.Empty
Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID" Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
} }

64
src/PrayerTracker.Tests/UI/ViewModelsTests.fs
View File

@ -15,7 +15,7 @@ let countAll _ = true
module ReferenceListTests = module ReferenceListTests =
[<Tests>] [<Tests>]
let asOfDateListTests = let asOfDateListTests =
testList "ReferenceList.asOfDateList" [ testList "ReferenceList.asOfDateList" [
@ -43,7 +43,7 @@ module ReferenceListTests =
Expect.equal (fst lst) (string PlainTextFormat) "The 3rd option should have been plain text" Expect.equal (fst lst) (string PlainTextFormat) "The 3rd option should have been plain text"
} }
] ]
[<Tests>] [<Tests>]
let expirationListTests = let expirationListTests =
testList "ReferenceList.expirationList" [ testList "ReferenceList.expirationList" [
@ -66,7 +66,7 @@ module ReferenceListTests =
"The option for immediate expiration was not found" "The option for immediate expiration was not found"
} }
] ]
[<Tests>] [<Tests>]
let requestTypeListTests = let requestTypeListTests =
testList "ReferenceList.requestTypeList" [ testList "ReferenceList.requestTypeList" [
@ -129,7 +129,7 @@ let appViewInfoTests =
let assignGroupsTests = let assignGroupsTests =
testList "AssignGroups" [ testList "AssignGroups" [
test "fromUser populates correctly" { test "fromUser populates correctly" {
let usr = { User.empty with Id = (Guid.NewGuid >> UserId) (); FirstName = "Alice"; LastName = "Bob" } let usr = { User.Empty with Id = (Guid.NewGuid >> UserId) (); FirstName = "Alice"; LastName = "Bob" }
let asg = AssignGroups.fromUser usr let asg = AssignGroups.fromUser usr
Expect.equal asg.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly" Expect.equal asg.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly"
Expect.equal asg.UserName usr.Name "The user's name was not filled correctly" Expect.equal asg.UserName usr.Name "The user's name was not filled correctly"
@ -142,7 +142,7 @@ let editChurchTests =
testList "EditChurch" [ testList "EditChurch" [
test "fromChurch populates correctly when interface exists" { test "fromChurch populates correctly when interface exists" {
let church = let church =
{ Church.empty with { Church.Empty with
Id = (Guid.NewGuid >> ChurchId) () Id = (Guid.NewGuid >> ChurchId) ()
Name = "Unit Test" Name = "Unit Test"
City = "Testlandia" City = "Testlandia"
@ -163,7 +163,7 @@ let editChurchTests =
test "fromChurch populates correctly when interface does not exist" { test "fromChurch populates correctly when interface does not exist" {
let edit = let edit =
EditChurch.fromChurch EditChurch.fromChurch
{ Church.empty with { Church.Empty with
Id = (Guid.NewGuid >> ChurchId) () Id = (Guid.NewGuid >> ChurchId) ()
Name = "Unit Test" Name = "Unit Test"
City = "Testlandia" City = "Testlandia"
@ -198,7 +198,7 @@ let editChurchTests =
HasInterface = Some true HasInterface = Some true
InterfaceAddress = Some "https://test.units" InterfaceAddress = Some "https://test.units"
} }
let church = edit.PopulateChurch Church.empty let church = edit.PopulateChurch Church.Empty
Expect.notEqual (shortGuid church.Id.Value) edit.ChurchId "The church ID should not have been modified" Expect.notEqual (shortGuid church.Id.Value) edit.ChurchId "The church ID should not have been modified"
Expect.equal church.Name edit.Name "The church name was not updated correctly" Expect.equal church.Name edit.Name "The church name was not updated correctly"
Expect.equal church.City edit.City "The church's city was not updated correctly" Expect.equal church.City edit.City "The church's city was not updated correctly"
@ -213,7 +213,7 @@ let editChurchTests =
Name = "Test Baptist Church" Name = "Test Baptist Church"
City = "Testerville" City = "Testerville"
State = "TE" State = "TE"
}.PopulateChurch Church.empty }.PopulateChurch Church.Empty
Expect.isFalse church.HasVpsInterface "The church should show that it has an interface" Expect.isFalse church.HasVpsInterface "The church should show that it has an interface"
Expect.isNone church.InterfaceAddress "The interface address should exist" Expect.isNone church.InterfaceAddress "The interface address should exist"
} }
@ -224,7 +224,7 @@ let editMemberTests =
testList "EditMember" [ testList "EditMember" [
test "fromMember populates with group default format" { test "fromMember populates with group default format" {
let mbr = let mbr =
{ Member.empty with { Member.Empty with
Id = (Guid.NewGuid >> MemberId) () Id = (Guid.NewGuid >> MemberId) ()
Name = "Test Name" Name = "Test Name"
Email = "test_units@example.com" Email = "test_units@example.com"
@ -236,7 +236,7 @@ let editMemberTests =
Expect.equal edit.Format "" "The e-mail format should have been blank for group default" Expect.equal edit.Format "" "The e-mail format should have been blank for group default"
} }
test "fromMember populates with specific format" { test "fromMember populates with specific format" {
let edit = EditMember.fromMember { Member.empty with Format = Some HtmlFormat } let edit = EditMember.fromMember { Member.Empty with Format = Some HtmlFormat }
Expect.equal edit.Format (string HtmlFormat) "The e-mail format was not filled correctly" Expect.equal edit.Format (string HtmlFormat) "The e-mail format was not filled correctly"
} }
test "empty is as expected" { test "empty is as expected" {
@ -259,7 +259,7 @@ let editMemberTests =
let editPreferencesTests = let editPreferencesTests =
testList "EditPreferences" [ testList "EditPreferences" [
test "fromPreferences succeeds for native fonts, named colors, and private list" { test "fromPreferences succeeds for native fonts, named colors, and private list" {
let prefs = ListPreferences.empty let prefs = ListPreferences.Empty
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.ExpireDays prefs.DaysToExpire "The expiration days were not filled correctly" Expect.equal edit.ExpireDays prefs.DaysToExpire "The expiration days were not filled correctly"
Expect.equal edit.DaysToKeepNew prefs.DaysToKeepNew "The days to keep new were not filled correctly" Expect.equal edit.DaysToKeepNew prefs.DaysToKeepNew "The days to keep new were not filled correctly"
@ -278,7 +278,7 @@ let editPreferencesTests =
Expect.isNone edit.Fonts "The list fonts should not exist for native font stack" Expect.isNone edit.Fonts "The list fonts should not exist for native font stack"
Expect.equal edit.HeadingFontSize prefs.HeadingFontSize "The heading font size was not filled correctly" Expect.equal edit.HeadingFontSize prefs.HeadingFontSize "The heading font size was not filled correctly"
Expect.equal edit.ListFontSize prefs.TextFontSize "The list text font size was not filled correctly" Expect.equal edit.ListFontSize prefs.TextFontSize "The list text font size was not filled correctly"
Expect.equal edit.TimeZone (TimeZoneId.toString prefs.TimeZoneId) "The time zone was not filled correctly" Expect.equal edit.TimeZone (string prefs.TimeZoneId) "The time zone was not filled correctly"
Expect.isSome edit.GroupPassword "The group password should have been set" Expect.isSome edit.GroupPassword "The group password should have been set"
Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly" Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly"
Expect.equal edit.Visibility GroupVisibility.PrivateList Expect.equal edit.Visibility GroupVisibility.PrivateList
@ -287,7 +287,7 @@ let editPreferencesTests =
Expect.equal edit.AsOfDate (string prefs.AsOfDateDisplay) "The as-of date display was not filled correctly" Expect.equal edit.AsOfDate (string prefs.AsOfDateDisplay) "The as-of date display was not filled correctly"
} }
test "fromPreferences succeeds for RGB line color and password-protected list" { test "fromPreferences succeeds for RGB line color and password-protected list" {
let prefs = { ListPreferences.empty with LineColor = "#ff0000"; GroupPassword = "pw" } let prefs = { ListPreferences.Empty with LineColor = "#ff0000"; GroupPassword = "pw" }
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.LineColorType "RGB" "The heading line color type was not derived correctly" Expect.equal edit.LineColorType "RGB" "The heading line color type was not derived correctly"
Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly" Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly"
@ -297,7 +297,7 @@ let editPreferencesTests =
"The list visibility was not derived correctly" "The list visibility was not derived correctly"
} }
test "fromPreferences succeeds for RGB text color and public list" { test "fromPreferences succeeds for RGB text color and public list" {
let prefs = { ListPreferences.empty with HeadingColor = "#0000ff"; IsPublic = true } let prefs = { ListPreferences.Empty with HeadingColor = "#0000ff"; IsPublic = true }
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.HeadingColorType "RGB" "The heading text color type was not derived correctly" Expect.equal edit.HeadingColorType "RGB" "The heading text color type was not derived correctly"
Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly" Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly"
@ -307,7 +307,7 @@ let editPreferencesTests =
"The list visibility was not derived correctly" "The list visibility was not derived correctly"
} }
test "fromPreferences succeeds for non-native fonts" { test "fromPreferences succeeds for non-native fonts" {
let prefs = { ListPreferences.empty with Fonts = "Arial,sans-serif" } let prefs = { ListPreferences.Empty with Fonts = "Arial,sans-serif" }
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.isFalse edit.IsNative "The IsNative flag should have been false" Expect.isFalse edit.IsNative "The IsNative flag should have been false"
Expect.isSome edit.Fonts "The fonts should have been filled for non-native fonts" Expect.isSome edit.Fonts "The fonts should have been filled for non-native fonts"
@ -330,7 +330,7 @@ let editRequestTests =
} }
test "fromRequest succeeds" { test "fromRequest succeeds" {
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.Empty with
Id = (Guid.NewGuid >> PrayerRequestId) () Id = (Guid.NewGuid >> PrayerRequestId) ()
RequestType = CurrentRequest RequestType = CurrentRequest
Requestor = Some "Me" Requestor = Some "Me"
@ -358,7 +358,7 @@ let editSmallGroupTests =
testList "EditSmallGroup" [ testList "EditSmallGroup" [
test "fromGroup succeeds" { test "fromGroup succeeds" {
let grp = let grp =
{ SmallGroup.empty with { SmallGroup.Empty with
Id = (Guid.NewGuid >> SmallGroupId) () Id = (Guid.NewGuid >> SmallGroupId) ()
Name = "test group" Name = "test group"
ChurchId = (Guid.NewGuid >> ChurchId) () ChurchId = (Guid.NewGuid >> ChurchId) ()
@ -387,7 +387,7 @@ let editSmallGroupTests =
Name = "test name" Name = "test name"
ChurchId = (Guid.NewGuid >> shortGuid) () ChurchId = (Guid.NewGuid >> shortGuid) ()
} }
let grp = edit.populateGroup SmallGroup.empty let grp = edit.populateGroup SmallGroup.Empty
Expect.equal grp.Name edit.Name "The name was not populated correctly" Expect.equal grp.Name edit.Name "The name was not populated correctly"
Expect.equal grp.ChurchId (idFromShort ChurchId edit.ChurchId) "The church ID was not populated correctly" Expect.equal grp.ChurchId (idFromShort ChurchId edit.ChurchId) "The church ID was not populated correctly"
} }
@ -408,7 +408,7 @@ let editUserTests =
} }
test "fromUser succeeds" { test "fromUser succeeds" {
let usr = let usr =
{ User.empty with { User.Empty with
Id = (Guid.NewGuid >> UserId) () Id = (Guid.NewGuid >> UserId) ()
FirstName = "user" FirstName = "user"
LastName = "test" LastName = "test"
@ -438,7 +438,7 @@ let editUserTests =
Password = "testpw" Password = "testpw"
} }
let hasher = fun x -> x + "+" let hasher = fun x -> x + "+"
let usr = edit.PopulateUser User.empty hasher let usr = edit.PopulateUser User.Empty hasher
Expect.equal usr.FirstName edit.FirstName "The first name was not populated correctly" Expect.equal usr.FirstName edit.FirstName "The first name was not populated correctly"
Expect.equal usr.LastName edit.LastName "The last name was not populated correctly" Expect.equal usr.LastName edit.LastName "The last name was not populated correctly"
Expect.equal usr.Email edit.Email "The e-mail address was not populated correctly" Expect.equal usr.Email edit.Email "The e-mail address was not populated correctly"
@ -500,26 +500,26 @@ let requestListTests =
let withRequestList f () = let withRequestList f () =
let today = SystemClock.Instance.GetCurrentInstant () let today = SystemClock.Instance.GetCurrentInstant ()
{ Requests = [ { Requests = [
{ PrayerRequest.empty with { PrayerRequest.Empty with
RequestType = CurrentRequest RequestType = CurrentRequest
Requestor = Some "Zeb" Requestor = Some "Zeb"
Text = "zyx" Text = "zyx"
UpdatedDate = today UpdatedDate = today
} }
{ PrayerRequest.empty with { PrayerRequest.Empty with
RequestType = CurrentRequest RequestType = CurrentRequest
Requestor = Some "Aaron" Requestor = Some "Aaron"
Text = "abc" Text = "abc"
UpdatedDate = today - Duration.FromDays 9 UpdatedDate = today - Duration.FromDays 9
} }
{ PrayerRequest.empty with { PrayerRequest.Empty with
RequestType = PraiseReport RequestType = PraiseReport
Text = "nmo" Text = "nmo"
UpdatedDate = today UpdatedDate = today
} }
] ]
Date = today.InUtc().Date Date = today.InUtc().Date
SmallGroup = SmallGroup.empty SmallGroup = SmallGroup.Empty
ShowHeader = false ShowHeader = false
Recipients = [] Recipients = []
CanEmail = false CanEmail = false
@ -596,10 +596,10 @@ let requestListTests =
} }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("d", null) htmlList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("d", null)
|> sprintf """<strong>Zeb</strong> &ndash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>""" |> sprintf """<strong>Zeb</strong> &ndash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>"""
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains html expected "Expected short as-of date not found" Expect.stringContains html expected "Expected short as-of date not found"
"AsHtml succeeds with long as-of date", "AsHtml succeeds with long as-of date",
fun reqList -> fun reqList ->
let htmlList = let htmlList =
@ -611,10 +611,10 @@ let requestListTests =
} }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("D", null) htmlList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("D", null)
|> sprintf """<strong>Zeb</strong> &ndash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>""" |> sprintf """<strong>Zeb</strong> &ndash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>"""
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains html expected "Expected long as-of date not found" Expect.stringContains html expected "Expected long as-of date not found"
"AsText succeeds with no as-of date", "AsText succeeds with no as-of date",
fun reqList -> fun reqList ->
let textList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test Group" } } let textList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test Group" } }
@ -642,10 +642,10 @@ let requestListTests =
} }
let text = textList.AsText _s let text = textList.AsText _s
let expected = let expected =
textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("d", null) textList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("d", null)
|> sprintf " + Zeb - zyx (as of %s)" |> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains text expected "Expected short as-of date not found" Expect.stringContains text expected "Expected short as-of date not found"
"AsText succeeds with long as-of date", "AsText succeeds with long as-of date",
fun reqList -> fun reqList ->
let textList = let textList =
@ -657,10 +657,10 @@ let requestListTests =
} }
let text = textList.AsText _s let text = textList.AsText _s
let expected = let expected =
textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("D", null) textList.Requests[0].UpdatedDate.InZone(reqList.SmallGroup.TimeZone).Date.ToString ("D", null)
|> sprintf " + Zeb - zyx (as of %s)" |> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains text expected "Expected long as-of date not found" Expect.stringContains text expected "Expected long as-of date not found"
"IsNew succeeds for both old and new requests", "IsNew succeeds for both old and new requests",
fun reqList -> fun reqList ->
let allReqs = reqList.RequestsByType _s let allReqs = reqList.RequestsByType _s

14
src/PrayerTracker.UI/CommonFunctions.fs
View File

@ -51,7 +51,7 @@ let tableSummary itemCount (s: IStringLocalizer) =
|> locStr |> locStr
] ]
] ]
/// Generate a list of named HTML colors /// Generate a list of named HTML colors
let namedColorList name selected attrs (s: IStringLocalizer) = let namedColorList name selected attrs (s: IStringLocalizer) =
// The list of HTML named colors (name, display, text color) // The list of HTML named colors (name, display, text color)
@ -104,7 +104,7 @@ let colorToHex (color: string) =
| "white" -> "#ffffff" | "white" -> "#ffffff"
| "yellow" -> "#ffff00" | "yellow" -> "#ffff00"
| it -> it | it -> it
/// <summary>Generate an <c>input type=radio</c> that is selected if its value is the current value</summary> /// <summary>Generate an <c>input type=radio</c> that is selected if its value is the current value</summary>
let radio name domId value current = let radio name domId value current =
input [ _type "radio" input [ _type "radio"
@ -197,7 +197,7 @@ let renderHtmlString = renderHtmlNode >> HtmlString
/// Utility methods to help with time zones (and localization of their names) /// Utility methods to help with time zones (and localization of their names)
module TimeZones = module TimeZones =
open PrayerTracker.Entities open PrayerTracker.Entities
/// Cross-reference between time zone Ids and their English names /// Cross-reference between time zone Ids and their English names
@ -215,9 +215,9 @@ module TimeZones =
match xref |> List.tryFind (fun it -> fst it = timeZoneId) with match xref |> List.tryFind (fun it -> fst it = timeZoneId) with
| Some tz -> s[snd tz] | Some tz -> s[snd tz]
| None -> | None ->
let tzId = TimeZoneId.toString timeZoneId let tzId = string timeZoneId
LocalizedString (tzId, tzId) LocalizedString (tzId, tzId)
/// All known time zones in their defined order /// All known time zones in their defined order
let all = xref |> List.map fst let all = xref |> List.map fst
@ -226,9 +226,9 @@ open Giraffe.ViewEngine.Htmx
/// Known htmx targets /// Known htmx targets
module Target = module Target =
/// htmx links target the body element /// htmx links target the body element
let body = _hxTarget "body" let body = _hxTarget "body"
/// htmx links target the #pt-body element /// htmx links target the #pt-body element
let content = _hxTarget "#pt-body" let content = _hxTarget "#pt-body"

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

@ -98,7 +98,7 @@ let email model viewInfo =
/// View for a small group's public prayer request list /// View for a small group's public prayer request list
let list (model : RequestList) viewInfo = let list (model : RequestList) viewInfo =
[ br [] [ br []
I18N.localizer.Force () |> (model.AsHtml >> rawText) I18N.localizer.Force () |> (model.AsHtml >> rawText)
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard viewInfo "View Request List" |> Layout.standard viewInfo "View Request List"
@ -156,7 +156,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let group = model.SmallGroup let group = model.SmallGroup
let now = SmallGroup.localDateNow (ctx.GetService<IClock> ()) group let now = group.LocalDateNow (ctx.GetService<IClock>())
let types = ReferenceList.requestTypeList s |> Map.ofList let types = ReferenceList.requestTypeList s |> Map.ofList
let vi = AppViewInfo.withScopedStyles [ "#requestList { grid-template-columns: repeat(5, auto); }" ] viewInfo let vi = AppViewInfo.withScopedStyles [ "#requestList { grid-template-columns: repeat(5, auto); }" ] viewInfo
/// Iterate the sequence once, before we render, so we can get the count of it at the top of the table /// Iterate the sequence once, before we render, so we can get the count of it at the top of the table
@ -164,8 +164,8 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
model.Requests model.Requests
|> List.map (fun req -> |> List.map (fun req ->
let updateClass = let updateClass =
_class (if PrayerRequest.updateRequired now group req then "cell pt-request-update" else "cell") _class (if req.UpdateRequired now group then "cell pt-request-update" else "cell")
let isExpired = PrayerRequest.isExpired now group req let isExpired = req.IsExpired now group
let expiredClass = _class (if isExpired then "cell pt-request-expired" else "cell") let expiredClass = _class (if isExpired then "cell pt-request-expired" else "cell")
let reqId = shortGuid req.Id.Value let reqId = shortGuid req.Id.Value
let reqText = htmlToPlainText req.Text let reqText = htmlToPlainText req.Text

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

@ -99,7 +99,7 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo =
"", selectDefault s["Select Church"].Value "", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> shortGuid c.Id.Value, c.Name) yield! churches |> List.map (fun c -> shortGuid c.Id.Value, c.Name)
} }
|> selectList (nameof model.ChurchId) model.ChurchId [ _required ] |> selectList (nameof model.ChurchId) model.ChurchId [ _required ]
] ]
] ]
div [ _fieldRow ] [ submit [] "save" s["Save Group"] ] div [ _fieldRow ] [ submit [] "save" s["Save Group"] ]
@ -476,7 +476,7 @@ let preferences (model : EditPreferences) ctx viewInfo =
locStr s["Custom Color"] locStr s["Custom Color"]
] ]
space space
input [ _type "color" input [ _type "color"
_name (nameof model.LineColor) _name (nameof model.LineColor)
_id $"{nameof model.LineColor}_Color" _id $"{nameof model.LineColor}_Color"
_value (colorToHex model.LineColor) _value (colorToHex model.LineColor)
@ -589,7 +589,7 @@ let preferences (model : EditPreferences) ctx viewInfo =
"", selectDefault s["Select"].Value "", selectDefault s["Select"].Value
yield! yield!
TimeZones.all TimeZones.all
|> List.map (fun tz -> TimeZoneId.toString tz, (TimeZones.name tz s).Value) |> List.map (fun tz -> string tz, (TimeZones.name tz s).Value)
} }
|> selectList (nameof model.TimeZone) model.TimeZone [ _required ] |> selectList (nameof model.TimeZone) model.TimeZone [ _required ]
] ]

244
src/PrayerTracker.UI/ViewModels.fs
View File

@ -54,14 +54,14 @@ type MessageLevel =
/// Support for the MessageLevel type /// Support for the MessageLevel type
module MessageLevel = module MessageLevel =
/// Convert a message level to its string representation /// Convert a message level to its string representation
let toString = let toString =
function function
| Info -> "Info" | Info -> "Info"
| Warning -> "WARNING" | Warning -> "WARNING"
| Error -> "ERROR" | Error -> "ERROR"
let toCssClass level = (toString level).ToLowerInvariant() let toCssClass level = (toString level).ToLowerInvariant()
@ -70,31 +70,31 @@ module MessageLevel =
type UserMessage = type UserMessage =
{ /// The type { /// The type
Level : MessageLevel Level : MessageLevel
/// The actual message /// The actual message
Text : HtmlString Text : HtmlString
/// The description (further information) /// The description (further information)
Description : HtmlString option Description : HtmlString option
} }
/// Support for the UserMessage type /// Support for the UserMessage type
module UserMessage = module UserMessage =
/// Error message template /// Error message template
let error = let error =
{ Level = Error { Level = Error
Text = HtmlString.Empty Text = HtmlString.Empty
Description = None Description = None
} }
/// Warning message template /// Warning message template
let warning = let warning =
{ Level = Warning { Level = Warning
Text = HtmlString.Empty Text = HtmlString.Empty
Description = None Description = None
} }
/// Info message template /// Info message template
let info = let info =
{ Level = Info { Level = Info
@ -104,13 +104,13 @@ module UserMessage =
/// The template with which the content will be rendered /// The template with which the content will be rendered
type LayoutType = type LayoutType =
/// A full page load /// A full page load
| FullPage | FullPage
/// A response that will provide a new body tag /// A response that will provide a new body tag
| PartialPage | PartialPage
/// A response that will replace the page content /// A response that will replace the page content
| ContentOnly | ContentOnly
@ -122,38 +122,38 @@ open NodaTime
type AppViewInfo = type AppViewInfo =
{ /// CSS files for the page { /// CSS files for the page
Style : string list Style : string list
/// The link for help on this page /// The link for help on this page
HelpLink : string option HelpLink : string option
/// Messages to be displayed to the user /// Messages to be displayed to the user
Messages : UserMessage list Messages : UserMessage list
/// The current version of PrayerTracker /// The current version of PrayerTracker
Version : string Version : string
/// The ticks when the request started /// The ticks when the request started
RequestStart : Instant RequestStart : Instant
/// The currently logged on user, if there is one /// The currently logged on user, if there is one
User : User option User : User option
/// The currently logged on small group, if there is one /// The currently logged on small group, if there is one
Group : SmallGroup option Group : SmallGroup option
/// The layout with which the content will be rendered /// The layout with which the content will be rendered
Layout : LayoutType Layout : LayoutType
/// Scoped styles for this view /// Scoped styles for this view
ScopedStyle : string list ScopedStyle : string list
/// A JavaScript function to run on page load /// A JavaScript function to run on page load
OnLoadScript : string option OnLoadScript : string option
} }
/// Support for the AppViewInfo type /// Support for the AppViewInfo type
module AppViewInfo = module AppViewInfo =
/// A fresh version that can be populated to process the current request /// A fresh version that can be populated to process the current request
let fresh = let fresh =
{ Style = [] { Style = []
@ -167,11 +167,11 @@ module AppViewInfo =
ScopedStyle = [] ScopedStyle = []
OnLoadScript = None OnLoadScript = None
} }
/// Add scoped styles to the given view info object /// Add scoped styles to the given view info object
let withScopedStyles styles viewInfo = let withScopedStyles styles viewInfo =
{ viewInfo with ScopedStyle = styles } { viewInfo with ScopedStyle = styles }
/// Add an onload action to the given view info object /// Add an onload action to the given view info object
let withOnLoadScript script viewInfo = let withOnLoadScript script viewInfo =
{ viewInfo with OnLoadScript = Some script } { viewInfo with OnLoadScript = Some script }
@ -182,18 +182,18 @@ module AppViewInfo =
type Announcement = type Announcement =
{ /// Whether the announcement should be sent to the class or to PrayerTracker users { /// Whether the announcement should be sent to the class or to PrayerTracker users
SendToClass : string SendToClass : string
/// The text of the announcement /// The text of the announcement
Text : string Text : string
/// Whether this announcement should be added to the "Announcements" of the prayer list /// Whether this announcement should be added to the "Announcements" of the prayer list
AddToRequestList : bool option AddToRequestList : bool option
/// The ID of the request type to which this announcement should be added /// The ID of the request type to which this announcement should be added
RequestType : string option RequestType : string option
} }
with with
/// The text of the announcement, in plain text /// The text of the announcement, in plain text
member this.PlainText member this.PlainText
with get () = (htmlToPlainText >> wordWrap 74) this.Text with get () = (htmlToPlainText >> wordWrap 74) this.Text
@ -204,17 +204,17 @@ with
type AssignGroups = type AssignGroups =
{ /// The Id of the user being assigned { /// The Id of the user being assigned
UserId : string UserId : string
/// The full name of the user being assigned /// The full name of the user being assigned
UserName : string UserName : string
/// The Ids of the small groups to which the user is authorized /// The Ids of the small groups to which the user is authorized
SmallGroups : string SmallGroups : string
} }
/// Support for the AssignGroups type /// Support for the AssignGroups type
module AssignGroups = module AssignGroups =
/// Create an instance of this form from an existing user /// Create an instance of this form from an existing user
let fromUser (user: User) = let fromUser (user: User) =
{ UserId = shortGuid user.Id.Value { UserId = shortGuid user.Id.Value
@ -228,10 +228,10 @@ module AssignGroups =
type ChangePassword = type ChangePassword =
{ /// The user's current password { /// The user's current password
OldPassword : string OldPassword : string
/// The user's new password /// The user's new password
NewPassword : string NewPassword : string
/// The user's new password, confirmed /// The user's new password, confirmed
NewPasswordConfirm : string NewPasswordConfirm : string
} }
@ -242,27 +242,27 @@ type ChangePassword =
type EditChurch = type EditChurch =
{ /// The ID of the church { /// The ID of the church
ChurchId : string ChurchId : string
/// The name of the church /// The name of the church
Name : string Name : string
/// The city for the church /// The city for the church
City : string City : string
/// The state or province for the church /// The state or province for the church
State : string State : string
/// Whether the church has an active Virtual Prayer Room interface /// Whether the church has an active Virtual Prayer Room interface
HasInterface : bool option HasInterface : bool option
/// The address for the interface /// The address for the interface
InterfaceAddress : string option InterfaceAddress : string option
} }
with with
/// Is this a new church? /// Is this a new church?
member this.IsNew = emptyGuid = this.ChurchId member this.IsNew = emptyGuid = this.ChurchId
/// Populate a church from this form /// Populate a church from this form
member this.PopulateChurch (church: Church) = member this.PopulateChurch (church: Church) =
{ church with { church with
@ -275,7 +275,7 @@ with
/// Support for the EditChurch type /// Support for the EditChurch type
module EditChurch = module EditChurch =
/// Create an instance from an existing church /// Create an instance from an existing church
let fromChurch (church: Church) = let fromChurch (church: Church) =
{ ChurchId = shortGuid church.Id.Value { ChurchId = shortGuid church.Id.Value
@ -285,7 +285,7 @@ module EditChurch =
HasInterface = match church.HasVpsInterface with true -> Some true | false -> None HasInterface = match church.HasVpsInterface with true -> Some true | false -> None
InterfaceAddress = church.InterfaceAddress InterfaceAddress = church.InterfaceAddress
} }
/// An instance to use for adding churches /// An instance to use for adding churches
let empty = let empty =
{ ChurchId = emptyGuid { ChurchId = emptyGuid
@ -296,30 +296,30 @@ module EditChurch =
InterfaceAddress = None InterfaceAddress = None
} }
/// Form for adding/editing small group members /// Form for adding/editing small group members
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditMember = type EditMember =
{ /// The Id for this small group member (not user-entered) { /// The Id for this small group member (not user-entered)
MemberId : string MemberId : string
/// The name of the member /// The name of the member
Name : string Name : string
/// The e-mail address /// The e-mail address
Email : string Email : string
/// The e-mail format /// The e-mail format
Format : string Format : string
} }
with with
/// Is this a new member? /// Is this a new member?
member this.IsNew = emptyGuid = this.MemberId member this.IsNew = emptyGuid = this.MemberId
/// Support for the EditMember type /// Support for the EditMember type
module EditMember = module EditMember =
/// Create an instance from an existing member /// Create an instance from an existing member
let fromMember (mbr: Member) = let fromMember (mbr: Member) =
{ MemberId = shortGuid mbr.Id.Value { MemberId = shortGuid mbr.Id.Value
@ -327,7 +327,7 @@ module EditMember =
Email = mbr.Email Email = mbr.Email
Format = mbr.Format |> Option.map string |> Option.defaultValue "" Format = mbr.Format |> Option.map string |> Option.defaultValue ""
} }
/// An empty instance /// An empty instance
let empty = let empty =
{ MemberId = emptyGuid { MemberId = emptyGuid
@ -342,66 +342,66 @@ module EditMember =
type EditPreferences = type EditPreferences =
{ /// The number of days after which requests are automatically expired { /// The number of days after which requests are automatically expired
ExpireDays : int ExpireDays : int
/// The number of days requests are considered "new" /// The number of days requests are considered "new"
DaysToKeepNew : int DaysToKeepNew : int
/// The number of weeks after which a long-term requests is flagged as requiring an update /// The number of weeks after which a long-term requests is flagged as requiring an update
LongTermUpdateWeeks : int LongTermUpdateWeeks : int
/// Whether to sort by updated date or requestor/subject /// Whether to sort by updated date or requestor/subject
RequestSort : string RequestSort : string
/// The name from which e-mail will be sent /// The name from which e-mail will be sent
EmailFromName : string EmailFromName : string
/// The e-mail address from which e-mail will be sent /// The e-mail address from which e-mail will be sent
EmailFromAddress : string EmailFromAddress : string
/// The default e-mail type for this group /// The default e-mail type for this group
DefaultEmailType : string DefaultEmailType : string
/// Whether the heading line color uses named colors or R/G/B /// Whether the heading line color uses named colors or R/G/B
LineColorType : string LineColorType : string
/// The named color for the heading lines /// The named color for the heading lines
LineColor : string LineColor : string
/// Whether the heading text color uses named colors or R/G/B /// Whether the heading text color uses named colors or R/G/B
HeadingColorType : string HeadingColorType : string
/// The named color for the heading text /// The named color for the heading text
HeadingColor : string HeadingColor : string
/// Whether the class uses the native font stack /// Whether the class uses the native font stack
IsNative : bool IsNative : bool
/// The fonts to use for the list /// The fonts to use for the list
Fonts : string option Fonts : string option
/// The font size for the heading text /// The font size for the heading text
HeadingFontSize : int HeadingFontSize : int
/// The font size for the list text /// The font size for the list text
ListFontSize : int ListFontSize : int
/// The time zone for the class /// The time zone for the class
TimeZone : string TimeZone : string
/// The list visibility /// The list visibility
Visibility : int Visibility : int
/// The small group password /// The small group password
GroupPassword : string option GroupPassword : string option
/// The page size for search / inactive requests /// The page size for search / inactive requests
PageSize : int PageSize : int
/// How the as-of date should be displayed /// How the as-of date should be displayed
AsOfDate : string AsOfDate : string
} }
with with
/// Set the properties of a small group based on the form's properties /// Set the properties of a small group based on the form's properties
member this.PopulatePreferences (prefs: ListPreferences) = member this.PopulatePreferences (prefs: ListPreferences) =
let isPublic, grpPw = let isPublic, grpPw =
@ -448,7 +448,7 @@ module EditPreferences =
Fonts = if prefs.Fonts = "native" then None else Some prefs.Fonts Fonts = if prefs.Fonts = "native" then None else Some prefs.Fonts
HeadingFontSize = prefs.HeadingFontSize HeadingFontSize = prefs.HeadingFontSize
ListFontSize = prefs.TextFontSize ListFontSize = prefs.TextFontSize
TimeZone = TimeZoneId.toString prefs.TimeZoneId TimeZone = string prefs.TimeZoneId
GroupPassword = Some prefs.GroupPassword GroupPassword = Some prefs.GroupPassword
PageSize = prefs.PageSize PageSize = prefs.PageSize
AsOfDate = string prefs.AsOfDateDisplay AsOfDate = string prefs.AsOfDateDisplay
@ -464,33 +464,33 @@ module EditPreferences =
type EditRequest = type EditRequest =
{ /// The ID of the request { /// The ID of the request
RequestId : string RequestId : string
/// The type of the request /// The type of the request
RequestType : string RequestType : string
/// The date of the request /// The date of the request
EnteredDate : string option EnteredDate : string option
/// Whether to update the date or not /// Whether to update the date or not
SkipDateUpdate : bool option SkipDateUpdate : bool option
/// The requestor or subject /// The requestor or subject
Requestor : string option Requestor : string option
/// How this request is expired /// How this request is expired
Expiration : string Expiration : string
/// The text of the request /// The text of the request
Text : string Text : string
} }
with with
/// Is this a new request? /// Is this a new request?
member this.IsNew = emptyGuid = this.RequestId member this.IsNew = emptyGuid = this.RequestId
/// Support for the EditRequest type /// Support for the EditRequest type
module EditRequest = module EditRequest =
/// An empty instance to use for new requests /// An empty instance to use for new requests
let empty = let empty =
{ RequestId = emptyGuid { RequestId = emptyGuid
@ -501,7 +501,7 @@ module EditRequest =
Expiration = string Automatic Expiration = string Automatic
Text = "" Text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
let fromRequest (req: PrayerRequest) = let fromRequest (req: PrayerRequest) =
{ empty with { empty with
@ -518,18 +518,18 @@ module EditRequest =
type EditSmallGroup = type EditSmallGroup =
{ /// The ID of the small group { /// The ID of the small group
SmallGroupId : string SmallGroupId : string
/// The name of the small group /// The name of the small group
Name : string Name : string
/// The ID of the church to which this small group belongs /// The ID of the church to which this small group belongs
ChurchId : string ChurchId : string
} }
with with
/// Is this a new small group? /// Is this a new small group?
member this.IsNew = emptyGuid = this.SmallGroupId member this.IsNew = emptyGuid = this.SmallGroupId
/// Populate a small group from this form /// Populate a small group from this form
member this.populateGroup (grp: SmallGroup) = member this.populateGroup (grp: SmallGroup) =
{ grp with { grp with
@ -539,14 +539,14 @@ with
/// Support for the EditSmallGroup type /// Support for the EditSmallGroup type
module EditSmallGroup = module EditSmallGroup =
/// Create an instance from an existing small group /// Create an instance from an existing small group
let fromGroup (grp: SmallGroup) = let fromGroup (grp: SmallGroup) =
{ SmallGroupId = shortGuid grp.Id.Value { SmallGroupId = shortGuid grp.Id.Value
Name = grp.Name Name = grp.Name
ChurchId = shortGuid grp.ChurchId.Value ChurchId = shortGuid grp.ChurchId.Value
} }
/// An empty instance (used when adding a new group) /// An empty instance (used when adding a new group)
let empty = let empty =
{ SmallGroupId = emptyGuid { SmallGroupId = emptyGuid
@ -560,30 +560,30 @@ module EditSmallGroup =
type EditUser = type EditUser =
{ /// The ID of the user { /// The ID of the user
UserId : string UserId : string
/// The first name of the user /// The first name of the user
FirstName : string FirstName : string
/// The last name of the user /// The last name of the user
LastName : string LastName : string
/// The e-mail address for the user /// The e-mail address for the user
Email : string Email : string
/// The password for the user /// The password for the user
Password : string Password : string
/// The password hash for the user a second time /// The password hash for the user a second time
PasswordConfirm : string PasswordConfirm : string
/// Is this user a PrayerTracker administrator? /// Is this user a PrayerTracker administrator?
IsAdmin : bool option IsAdmin : bool option
} }
with with
/// Is this a new user? /// Is this a new user?
member this.IsNew = emptyGuid = this.UserId member this.IsNew = emptyGuid = this.UserId
/// Populate a user from the form /// Populate a user from the form
member this.PopulateUser (user: User) hasher = member this.PopulateUser (user: User) hasher =
{ user with { user with
@ -598,7 +598,7 @@ with
/// Support for the EditUser type /// Support for the EditUser type
module EditUser = module EditUser =
/// An empty instance /// An empty instance
let empty = let empty =
{ UserId = emptyGuid { UserId = emptyGuid
@ -609,7 +609,7 @@ module EditUser =
PasswordConfirm = "" PasswordConfirm = ""
IsAdmin = None IsAdmin = None
} }
/// Create an instance from an existing user /// Create an instance from an existing user
let fromUser (user: User) = let fromUser (user: User) =
{ empty with { empty with
@ -626,17 +626,17 @@ module EditUser =
type GroupLogOn = type GroupLogOn =
{ /// The ID of the small group to which the user is logging on { /// The ID of the small group to which the user is logging on
SmallGroupId : string SmallGroupId : string
/// The password entered /// The password entered
Password : string Password : string
/// Whether to remember the login /// Whether to remember the login
RememberMe : bool option RememberMe : bool option
} }
/// Support for the GroupLogOn type /// Support for the GroupLogOn type
module GroupLogOn = module GroupLogOn =
/// An empty instance /// An empty instance
let empty = let empty =
{ SmallGroupId = emptyGuid { SmallGroupId = emptyGuid
@ -650,27 +650,27 @@ module GroupLogOn =
type MaintainRequests = type MaintainRequests =
{ /// The requests to be displayed { /// The requests to be displayed
Requests : PrayerRequest list Requests : PrayerRequest list
/// The small group to which the requests belong /// The small group to which the requests belong
SmallGroup : SmallGroup SmallGroup : SmallGroup
/// Whether only active requests are included /// Whether only active requests are included
OnlyActive : bool option OnlyActive : bool option
/// The search term for the requests /// The search term for the requests
SearchTerm : string option SearchTerm : string option
/// The page number of the results /// The page number of the results
PageNbr : int option PageNbr : int option
} }
/// Support for the MaintainRequests type /// Support for the MaintainRequests type
module MaintainRequests = module MaintainRequests =
/// An empty instance /// An empty instance
let empty = let empty =
{ Requests = [] { Requests = []
SmallGroup = SmallGroup.empty SmallGroup = SmallGroup.Empty
OnlyActive = None OnlyActive = None
SearchTerm = None SearchTerm = None
PageNbr = None PageNbr = None
@ -682,16 +682,16 @@ module MaintainRequests =
type Overview = type Overview =
{ /// The total number of active requests { /// The total number of active requests
TotalActiveReqs : int TotalActiveReqs : int
/// The numbers of active requests by request type /// The numbers of active requests by request type
ActiveReqsByType : Map<PrayerRequestType, int> ActiveReqsByType : Map<PrayerRequestType, int>
/// A count of all requests /// A count of all requests
AllReqs : int AllReqs : int
/// A count of all members /// A count of all members
TotalMembers : int TotalMembers : int
/// The users authorized to administer this group /// The users authorized to administer this group
Admins : User list Admins : User list
} }
@ -702,23 +702,23 @@ type Overview =
type UserLogOn = type UserLogOn =
{ /// The e-mail address of the user { /// The e-mail address of the user
Email : string Email : string
/// The password entered /// The password entered
Password : string Password : string
/// The ID of the small group to which the user is logging on /// The ID of the small group to which the user is logging on
SmallGroupId : string SmallGroupId : string
/// Whether to remember the login /// Whether to remember the login
RememberMe : bool option RememberMe : bool option
/// The URL to which the user should be redirected once login is successful /// The URL to which the user should be redirected once login is successful
RedirectUrl : string option RedirectUrl : string option
} }
/// Support for the UserLogOn type /// Support for the UserLogOn type
module UserLogOn = module UserLogOn =
/// An empty instance /// An empty instance
let empty = let empty =
{ Email = "" { Email = ""
@ -736,19 +736,19 @@ open Giraffe.ViewEngine
type RequestList = type RequestList =
{ /// The prayer request list { /// The prayer request list
Requests : PrayerRequest list Requests : PrayerRequest list
/// The date for which this list is being generated /// The date for which this list is being generated
Date : LocalDate Date : LocalDate
/// The small group to which this list belongs /// The small group to which this list belongs
SmallGroup : SmallGroup SmallGroup : SmallGroup
/// Whether to show the class header /// Whether to show the class header
ShowHeader : bool ShowHeader : bool
/// The list of recipients (populated if requests are e-mailed) /// The list of recipients (populated if requests are e-mailed)
Recipients : Member list Recipients : Member list
/// Whether the user can e-mail this list /// Whether the user can e-mail this list
CanEmail : bool CanEmail : bool
} }
@ -770,12 +770,12 @@ with
|> List.ofSeq |> List.ofSeq
typ, name, reqs) typ, name, reqs)
|> List.filter (fun (_, _, reqs) -> not (List.isEmpty reqs)) |> List.filter (fun (_, _, reqs) -> not (List.isEmpty reqs))
/// Is this request new? /// Is this request new?
member this.IsNew (req: PrayerRequest) = member this.IsNew (req: PrayerRequest) =
let reqDate = req.UpdatedDate.InZone(SmallGroup.timeZone this.SmallGroup).Date let reqDate = req.UpdatedDate.InZone(this.SmallGroup.TimeZone).Date
Period.Between(reqDate, this.Date, PeriodUnits.Days).Days <= this.SmallGroup.Preferences.DaysToKeepNew Period.Between(reqDate, this.Date, PeriodUnits.Days).Days <= this.SmallGroup.Preferences.DaysToKeepNew
/// Generate this list as HTML /// Generate this list as HTML
member this.AsHtml (s: IStringLocalizer) = member this.AsHtml (s: IStringLocalizer) =
let p = this.SmallGroup.Preferences let p = this.SmallGroup.Preferences
@ -803,7 +803,7 @@ with
] ]
] ]
] ]
let tz = SmallGroup.timeZone this.SmallGroup let tz = this.SmallGroup.TimeZone
reqs reqs
|> List.map (fun req -> |> List.map (fun req ->
let bullet = if this.IsNew req then "circle" else "disc" let bullet = if this.IsNew req then "circle" else "disc"
@ -835,7 +835,7 @@ with
/// Generate this list as plain text /// Generate this list as plain text
member this.AsText (s: IStringLocalizer) = member this.AsText (s: IStringLocalizer) =
let tz = SmallGroup.timeZone this.SmallGroup let tz = this.SmallGroup.TimeZone
seq { seq {
this.SmallGroup.Name this.SmallGroup.Name
s["Prayer Requests"].Value s["Prayer Requests"].Value

4
src/PrayerTracker/Church.fs
View File

@ -40,7 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|> renderHtml next ctx |> renderHtml next ctx
else else
match! Churches.tryById (ChurchId churchId) with match! Churches.tryById (ChurchId churchId) with
| Some church -> | Some church ->
return! return!
viewInfo ctx viewInfo ctx
|> Views.Church.edit (EditChurch.fromChurch church) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
@ -63,7 +63,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
match! ctx.TryBindFormAsync<EditChurch> () with match! ctx.TryBindFormAsync<EditChurch> () with
| Ok model -> | Ok model ->
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) else Churches.tryById (idFromShort ChurchId model.ChurchId)
match church with match church with
| Some ch -> | Some ch ->

14
src/PrayerTracker/PrayerRequest.fs
View File

@ -20,7 +20,7 @@ let private findRequest (ctx: HttpContext) reqId = task {
/// Generate a list of requests for the given date /// Generate a list of requests for the given date
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 = defaultArg date (group.LocalDateNow ctx.Clock)
let! reqs = let! reqs =
PrayerRequests.forGroup PrayerRequests.forGroup
{ SmallGroup = group { SmallGroup = group
@ -50,7 +50,7 @@ open System
// GET /prayer-request/[request-id]/edit // GET /prayer-request/[request-id]/edit
let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let now = SmallGroup.localDateNow ctx.Clock group let now = group.LocalDateNow ctx.Clock
let requestId = PrayerRequestId reqId let requestId = PrayerRequestId reqId
if requestId.Value = Guid.Empty then if requestId.Value = Guid.Empty then
return! return!
@ -61,7 +61,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = ctx.Strings let s = ctx.Strings
if PrayerRequest.isExpired now group req then if req.IsExpired now group then
{ UserMessage.warning with { UserMessage.warning with
Text = htmlLocString s["This request is expired."] Text = htmlLocString s["This request is expired."]
Description = Description =
@ -139,7 +139,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ Requests = reqs { Requests = reqs
Date = SmallGroup.localDateNow ctx.Clock group Date = group.LocalDateNow ctx.Clock
SmallGroup = group SmallGroup = group
ShowHeader = true ShowHeader = true
CanEmail = Option.isSome ctx.User.UserId CanEmail = Option.isSome ctx.User.UserId
@ -226,7 +226,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! req = let! req =
if model.IsNew then if model.IsNew then
{ PrayerRequest.empty with { PrayerRequest.Empty with
Id = (Guid.NewGuid >> PrayerRequestId) () Id = (Guid.NewGuid >> PrayerRequestId) ()
SmallGroupId = group.Id SmallGroupId = group.Id
UserId = ctx.User.UserId.Value UserId = ctx.User.UserId.Value
@ -235,7 +235,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId)
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 = group.LocalDateNow ctx.Clock
let updated = let updated =
{ pr with { pr with
RequestType = PrayerRequestType.Parse model.RequestType RequestType = PrayerRequestType.Parse model.RequestType
@ -247,7 +247,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
| it when model.IsNew -> | it when model.IsNew ->
let dt = let dt =
(defaultArg (parseListDate model.EnteredDate) now) (defaultArg (parseListDate model.EnteredDate) now)
.AtStartOfDayInZone(SmallGroup.timeZone group) .AtStartOfDayInZone(group.TimeZone)
.ToInstant() .ToInstant()
{ 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

12
src/PrayerTracker/SmallGroup.fs
View File

@ -183,7 +183,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
match! ctx.TryBindFormAsync<EditSmallGroup>() with match! ctx.TryBindFormAsync<EditSmallGroup>() with
| Ok model -> | Ok model ->
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) else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId)
match tryGroup with match tryGroup with
| Some group -> | Some group ->
@ -202,7 +202,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
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) else Members.tryById (idFromShort MemberId model.MemberId)
match tryMbr with match tryMbr with
| Some mbr when mbr.SmallGroupId = group.Id -> | Some mbr when mbr.SmallGroupId = group.Id ->
@ -250,7 +250,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
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 = group.LocalTimeNow ctx.Clock
let s = ctx.Strings 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
@ -262,7 +262,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
let! recipients = task { let! recipients = task {
if model.SendToClass = "N" && usr.IsAdmin then if model.SendToClass = "N" && usr.IsAdmin then
let! users = Users.all () let! users = Users.all ()
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 else return! Members.forGroup group.Id
} }
use! client = Email.getConnection () use! client = Email.getConnection ()
@ -282,9 +282,9 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
| _, None -> () | _, None -> ()
| _, Some x when not x -> () | _, Some x when not x -> ()
| _, _ -> | _, _ ->
let zone = SmallGroup.timeZone group let zone = group.TimeZone
do! PrayerRequests.save do! PrayerRequests.save
{ PrayerRequest.empty with { PrayerRequest.Empty with
Id = (Guid.NewGuid >> PrayerRequestId) () Id = (Guid.NewGuid >> PrayerRequestId) ()
SmallGroupId = group.Id SmallGroupId = group.Id
UserId = usr.Id UserId = usr.Id

20
src/PrayerTracker/User.fs
View File

@ -14,20 +14,20 @@ open PrayerTracker.ViewModels
/// Password hashing implementation extending ASP.NET Core's identity implementation /// Password hashing implementation extending ASP.NET Core's identity implementation
[<AutoOpen>] [<AutoOpen>]
module Hashing = module Hashing =
open System.Security.Cryptography open System.Security.Cryptography
open System.Text open System.Text
/// Custom password hasher used to verify and upgrade old password hashes /// Custom password hasher used to verify and upgrade old password hashes
type PrayerTrackerPasswordHasher() = type PrayerTrackerPasswordHasher() =
inherit PasswordHasher<User>() inherit PasswordHasher<User>()
override this.VerifyHashedPassword(user, hashedPassword, providedPassword) = override this.VerifyHashedPassword(user, hashedPassword, providedPassword) =
if isNull hashedPassword then nullArg (nameof hashedPassword) if isNull hashedPassword then nullArg (nameof hashedPassword)
if isNull providedPassword then nullArg (nameof providedPassword) if isNull providedPassword then nullArg (nameof providedPassword)
let hashBytes = Convert.FromBase64String hashedPassword let hashBytes = Convert.FromBase64String hashedPassword
match hashBytes[0] with match hashBytes[0] with
| 255uy -> | 255uy ->
// v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds // v2 hashes - PBKDF2 (RFC 2898), 1,024 rounds
@ -53,7 +53,7 @@ module Hashing =
PasswordVerificationResult.Failed PasswordVerificationResult.Failed
| _ -> base.VerifyHashedPassword(user, hashedPassword, providedPassword) | _ -> base.VerifyHashedPassword(user, hashedPassword, providedPassword)
/// Retrieve a user from the database by password, upgrading password hashes if required /// Retrieve a user from the database by password, upgrading password hashes if required
let private findUserByPassword model = task { let private findUserByPassword model = task {
match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
@ -125,7 +125,7 @@ open Microsoft.AspNetCore.Html
// POST /user/log-on // POST /user/log-on
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 = ctx.Strings let s = ctx.Strings
match! findUserByPassword model with match! findUserByPassword model with
| Some user -> | Some user ->
@ -218,7 +218,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
match! ctx.TryBindFormAsync<EditUser>() with match! ctx.TryBindFormAsync<EditUser>() with
| Ok model -> | Ok model ->
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) else Users.tryById (idFromShort UserId model.UserId)
match user with match user with
| Some usr -> | Some usr ->
@ -230,7 +230,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
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", h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.Name] updatedUser.Name]
|> Some } |> Some }
@ -267,7 +267,7 @@ let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -
let! groups = SmallGroups.listAll () let! groups = SmallGroups.listAll ()
let! groupIds = Users.groupIdsByUserId userId let! groupIds = Users.groupIdsByUserId userId
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
|> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx