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

Use short GUIDs in URLs and forms (#1)

Browse Source 
- Fully implement single-case DUs for previously aliased IDs
- Capitalize entity data items
This commit is contained in:
Daniel J. Summers 2022-08-01 21:57:55 -04:00
parent 7786896dfd
commit f068d20612
20 changed files with 1248 additions and 1085 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

163
src/PrayerTracker.Data/DataAccess.fs
View File

@ -11,13 +11,13 @@ module private Helpers =
let reqSort sort (q : IQueryable<PrayerRequest>) = let reqSort sort (q : IQueryable<PrayerRequest>) =
match sort with match sort with
| SortByDate -> | SortByDate ->
q.OrderByDescending(fun req -> req.updatedDate) q.OrderByDescending(fun req -> req.UpdatedDate)
.ThenByDescending(fun req -> req.enteredDate) .ThenByDescending(fun req -> req.EnteredDate)
.ThenBy (fun req -> req.requestor) .ThenBy (fun req -> req.Requestor)
| SortByRequestor -> | SortByRequestor ->
q.OrderBy(fun req -> req.requestor) q.OrderBy(fun req -> req.Requestor)
.ThenByDescending(fun req -> req.updatedDate) .ThenByDescending(fun req -> req.UpdatedDate)
.ThenByDescending (fun req -> req.enteredDate) .ThenByDescending (fun req -> req.EnteredDate)
/// Paginate a prayer request query /// Paginate a prayer request query
let paginate (pageNbr : int) pageSize (q : IQueryable<PrayerRequest>) = let paginate (pageNbr : int) pageSize (q : IQueryable<PrayerRequest>) =
@ -48,44 +48,44 @@ type AppDbContext with
(*-- CHURCH EXTENSIONS --*) (*-- CHURCH EXTENSIONS --*)
/// Find a church by its Id /// Find a church by its Id
member this.TryChurchById cId = backgroundTask { member this.TryChurchById churchId = backgroundTask {
let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.churchId = cId) let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.Id = churchId)
return Option.fromObject church return Option.fromObject church
} }
/// Find all churches /// Find all churches
member this.AllChurches () = backgroundTask { member this.AllChurches () = backgroundTask {
let! churches = this.Churches.OrderBy(fun ch -> ch.name).ToListAsync () let! churches = this.Churches.OrderBy(fun ch -> ch.Name).ToListAsync ()
return List.ofSeq churches return List.ofSeq churches
} }
(*-- MEMBER EXTENSIONS --*) (*-- MEMBER EXTENSIONS --*)
/// Get a small group member by its Id /// Get a small group member by its Id
member this.TryMemberById mbrId = backgroundTask { member this.TryMemberById memberId = backgroundTask {
let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.memberId = mbrId) let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.Id = memberId)
return Option.fromObject mbr return Option.fromObject mbr
} }
/// Find all members for a small group /// Find all members for a small group
member this.AllMembersForSmallGroup gId = backgroundTask { member this.AllMembersForSmallGroup groupId = backgroundTask {
let! members = let! members =
this.Members.Where(fun mbr -> mbr.smallGroupId = gId) this.Members.Where(fun mbr -> mbr.SmallGroupId = groupId)
.OrderBy(fun mbr -> mbr.memberName) .OrderBy(fun mbr -> mbr.Name)
.ToListAsync () .ToListAsync ()
return List.ofSeq members return List.ofSeq members
} }
/// Count members for a small group /// Count members for a small group
member this.CountMembersForSmallGroup gId = backgroundTask { member this.CountMembersForSmallGroup groupId = backgroundTask {
return! this.Members.CountAsync (fun m -> m.smallGroupId = gId) return! this.Members.CountAsync (fun m -> m.SmallGroupId = groupId)
} }
(*-- PRAYER REQUEST EXTENSIONS --*) (*-- PRAYER REQUEST EXTENSIONS --*)
/// Get a prayer request by its Id /// Get a prayer request by its Id
member this.TryRequestById reqId = backgroundTask { member this.TryRequestById reqId = backgroundTask {
let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.prayerRequestId = reqId) let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.Id = reqId)
return Option.fromObject req return Option.fromObject req
} }
@ -93,31 +93,31 @@ type AppDbContext with
member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr = backgroundTask { member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr = backgroundTask {
let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock
let query = let query =
this.PrayerRequests.Where(fun req -> req.smallGroupId = grp.smallGroupId) this.PrayerRequests.Where(fun req -> req.SmallGroupId = grp.Id)
|> function |> function
| q when activeOnly -> | q when activeOnly ->
let asOf = DateTime (theDate.AddDays(-(float grp.preferences.daysToExpire)).Date.Ticks, DateTimeKind.Utc) let asOf = DateTime (theDate.AddDays(-(float grp.Preferences.DaysToExpire)).Date.Ticks, DateTimeKind.Utc)
q.Where(fun req -> q.Where(fun req ->
( req.updatedDate > asOf ( req.UpdatedDate > asOf
|| req.expiration = Manual || req.Expiration = Manual
|| req.requestType = LongTermRequest || req.RequestType = LongTermRequest
|| req.requestType = Expecting) || req.RequestType = Expecting)
&& req.expiration <> Forced) && req.Expiration <> Forced)
|> reqSort grp.preferences.requestSort |> reqSort grp.Preferences.RequestSort
|> paginate pageNbr grp.preferences.pageSize |> paginate pageNbr grp.Preferences.PageSize
| q -> reqSort grp.preferences.requestSort q | q -> reqSort grp.Preferences.RequestSort q
let! reqs = query.ToListAsync () let! reqs = query.ToListAsync ()
return List.ofSeq reqs return List.ofSeq reqs
} }
/// Count prayer requests for the given small group Id /// Count prayer requests for the given small group Id
member this.CountRequestsBySmallGroup gId = backgroundTask { member this.CountRequestsBySmallGroup groupId = backgroundTask {
return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId) return! this.PrayerRequests.CountAsync (fun pr -> pr.SmallGroupId = groupId)
} }
/// Count prayer requests for the given church Id /// Count prayer requests for the given church Id
member this.CountRequestsByChurch cId = backgroundTask { member this.CountRequestsByChurch churchId = backgroundTask {
return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId) return! this.PrayerRequests.CountAsync (fun pr -> pr.SmallGroup.ChurchId = churchId)
} }
/// 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
@ -128,9 +128,9 @@ type AppDbContext with
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}"""
let like = sprintf "%%%s%%" let like = sprintf "%%%s%%"
let query = let query =
this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm) this.PrayerRequests.FromSqlRaw(sql, grp.Id, like searchTerm)
|> reqSort grp.preferences.requestSort |> reqSort grp.Preferences.RequestSort
|> paginate pageNbr grp.preferences.pageSize |> paginate pageNbr grp.Preferences.PageSize
let! reqs = query.ToListAsync () let! reqs = query.ToListAsync ()
return List.ofSeq reqs return List.ofSeq reqs
} }
@ -138,21 +138,21 @@ type AppDbContext with
(*-- SMALL GROUP EXTENSIONS --*) (*-- SMALL GROUP EXTENSIONS --*)
/// Find a small group by its Id /// Find a small group by its Id
member this.TryGroupById gId = backgroundTask { member this.TryGroupById groupId = backgroundTask {
let! grp = let! grp =
this.SmallGroups.Include(fun sg -> sg.preferences) this.SmallGroups.Include(fun sg -> sg.Preferences)
.SingleOrDefaultAsync (fun sg -> sg.smallGroupId = gId) .SingleOrDefaultAsync (fun sg -> sg.Id = groupId)
return Option.fromObject grp return Option.fromObject grp
} }
/// Get small groups that are public or password protected /// Get small groups that are public or password protected
member this.PublicAndProtectedGroups () = backgroundTask { member this.PublicAndProtectedGroups () = backgroundTask {
let! groups = let! groups =
this.SmallGroups.Include(fun sg -> sg.preferences).Include(fun sg -> sg.church) this.SmallGroups.Include(fun sg -> sg.Preferences).Include(fun sg -> sg.Church)
.Where(fun sg -> .Where(fun sg ->
sg.preferences.isPublic sg.Preferences.IsPublic
|| (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")) || (sg.Preferences.GroupPassword <> null && sg.Preferences.GroupPassword <> ""))
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name)
.ToListAsync () .ToListAsync ()
return List.ofSeq groups return List.ofSeq groups
} }
@ -160,9 +160,9 @@ type AppDbContext with
/// Get small groups that are password protected /// Get small groups that are password protected
member this.ProtectedGroups () = backgroundTask { member this.ProtectedGroups () = backgroundTask {
let! groups = let! groups =
this.SmallGroups.Include(fun sg -> sg.church) this.SmallGroups.Include(fun sg -> sg.Church)
.Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "") .Where(fun sg -> sg.Preferences.GroupPassword <> null && sg.Preferences.GroupPassword <> "")
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name)
.ToListAsync () .ToListAsync ()
return List.ofSeq groups return List.ofSeq groups
} }
@ -171,10 +171,10 @@ type AppDbContext with
member this.AllGroups () = backgroundTask { member this.AllGroups () = backgroundTask {
let! groups = let! groups =
this.SmallGroups this.SmallGroups
.Include(fun sg -> sg.church) .Include(fun sg -> sg.Church)
.Include(fun sg -> sg.preferences) .Include(fun sg -> sg.Preferences)
.Include(fun sg -> sg.preferences.timeZone) .Include(fun sg -> sg.Preferences.TimeZone)
.OrderBy(fun sg -> sg.name) .OrderBy(fun sg -> sg.Name)
.ToListAsync () .ToListAsync ()
return List.ofSeq groups return List.ofSeq groups
} }
@ -182,88 +182,89 @@ type AppDbContext with
/// Get a small group list by their Id, with their church prepended to their name /// Get a small group list by their Id, with their church prepended to their name
member this.GroupList () = backgroundTask { member this.GroupList () = backgroundTask {
let! groups = let! groups =
this.SmallGroups.Include(fun sg -> sg.church) this.SmallGroups.Include(fun sg -> sg.Church)
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name)
.ToListAsync () .ToListAsync ()
return groups return
|> Seq.map (fun sg -> sg.smallGroupId.ToString "N", $"{sg.church.name} | {sg.name}") groups
|> Seq.map (fun sg -> Giraffe.ShortGuid.fromGuid sg.Id.Value, $"{sg.Church.Name} | {sg.Name}")
|> List.ofSeq |> List.ofSeq
} }
/// Log on a small group /// Log on a small group
member this.TryGroupLogOnByPassword gId pw = backgroundTask { member this.TryGroupLogOnByPassword groupId pw = backgroundTask {
match! this.TryGroupById gId with match! this.TryGroupById groupId with
| None -> return None | Some grp when pw = grp.Preferences.GroupPassword -> return Some grp
| Some grp -> return if pw = grp.preferences.groupPassword then Some grp else None | _ -> return None
} }
/// Check a cookie log on for a small group /// Check a cookie log on for a small group
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = backgroundTask { member this.TryGroupLogOnByCookie groupId pwHash (hasher : string -> string) = backgroundTask {
match! this.TryGroupById gId with match! this.TryGroupById groupId with
| None -> return None | None -> return None
| Some grp -> return if pwHash = hasher grp.preferences.groupPassword then Some grp else None | Some grp -> return if pwHash = hasher grp.Preferences.GroupPassword then Some grp else None
} }
/// Count small groups for the given church Id /// Count small groups for the given church Id
member this.CountGroupsByChurch cId = backgroundTask { member this.CountGroupsByChurch churchId = backgroundTask {
return! this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId) return! this.SmallGroups.CountAsync (fun sg -> sg.ChurchId = churchId)
} }
(*-- TIME ZONE EXTENSIONS --*) (*-- TIME ZONE EXTENSIONS --*)
/// Get a time zone by its Id /// Get a time zone by its Id
member this.TryTimeZoneById tzId = backgroundTask { member this.TryTimeZoneById tzId = backgroundTask {
let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.timeZoneId = tzId) let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.Id = tzId)
return Option.fromObject zone return Option.fromObject zone
} }
/// Get all time zones /// Get all time zones
member this.AllTimeZones () = backgroundTask { member this.AllTimeZones () = backgroundTask {
let! zones = this.TimeZones.OrderBy(fun tz -> tz.sortOrder).ToListAsync () let! zones = this.TimeZones.OrderBy(fun tz -> tz.SortOrder).ToListAsync ()
return List.ofSeq zones return List.ofSeq zones
} }
(*-- USER EXTENSIONS --*) (*-- USER EXTENSIONS --*)
/// Find a user by its Id /// Find a user by its Id
member this.TryUserById uId = backgroundTask { member this.TryUserById userId = backgroundTask {
let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.userId = uId) let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.Id = userId)
return Option.fromObject usr return Option.fromObject usr
} }
/// Find a user by its e-mail address and authorized small group /// Find a user by its e-mail address and authorized small group
member this.TryUserByEmailAndGroup email gId = backgroundTask { member this.TryUserByEmailAndGroup email groupId = backgroundTask {
let! usr = let! usr =
this.Users.SingleOrDefaultAsync (fun u -> this.Users.SingleOrDefaultAsync (fun u ->
u.emailAddress = email && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) u.Email = email && u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
return Option.fromObject usr return Option.fromObject usr
} }
/// Find a user by its Id, eagerly loading the user's groups /// Find a user by its Id, eagerly loading the user's groups
member this.TryUserByIdWithGroups uId = backgroundTask { member this.TryUserByIdWithGroups userId = backgroundTask {
let! usr = this.Users.Include(fun u -> u.smallGroups).SingleOrDefaultAsync (fun u -> u.userId = uId) let! usr = this.Users.Include(fun u -> u.SmallGroups).SingleOrDefaultAsync (fun u -> u.Id = userId)
return Option.fromObject usr return Option.fromObject usr
} }
/// Get a list of all users /// Get a list of all users
member this.AllUsers () = backgroundTask { member this.AllUsers () = backgroundTask {
let! users = this.Users.OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync () let! users = this.Users.OrderBy(fun u -> u.LastName).ThenBy(fun u -> u.FirstName).ToListAsync ()
return List.ofSeq users return List.ofSeq users
} }
/// Get all PrayerTracker users as members (used to send e-mails) /// Get all PrayerTracker users as members (used to send e-mails)
member this.AllUsersAsMembers () = backgroundTask { member this.AllUsersAsMembers () = backgroundTask {
let! users = this.AllUsers () let! users = this.AllUsers ()
return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName }) return users |> List.map (fun u -> { Member.empty with Email = u.Email; Name = u.fullName })
} }
/// Find a user based on their credentials /// Find a user based on their credentials
member this.TryUserLogOnByPassword email pwHash gId = backgroundTask { member this.TryUserLogOnByPassword email pwHash groupId = backgroundTask {
let! usr = let! usr =
this.Users.SingleOrDefaultAsync (fun u -> this.Users.SingleOrDefaultAsync (fun u ->
u.emailAddress = email u.Email = email
&& u.passwordHash = pwHash && u.PasswordHash = pwHash
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) && u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
return Option.fromObject usr return Option.fromObject usr
} }
@ -272,17 +273,17 @@ type AppDbContext with
match! this.TryUserByIdWithGroups uId with match! this.TryUserByIdWithGroups uId with
| None -> return None | None -> return None
| Some usr -> | Some usr ->
if pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) then if pwHash = usr.PasswordHash && usr.SmallGroups |> Seq.exists (fun xref -> xref.SmallGroupId = gId) then
return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() } return Some { usr with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }
else return None else return None
} }
/// Count the number of users for a small group /// Count the number of users for a small group
member this.CountUsersBySmallGroup gId = backgroundTask { member this.CountUsersBySmallGroup groupId = backgroundTask {
return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId))
} }
/// Count the number of users for a church /// Count the number of users for a church
member this.CountUsersByChurch cId = backgroundTask { member this.CountUsersByChurch churchId = backgroundTask {
return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroup.churchId = cId)) return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroup.ChurchId = churchId))
} }

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

File diff suppressed because it is too large Load Diff

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

@ -14,6 +14,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" /> <PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
<PackageReference Include="NodaTime" Version="3.1.0" /> <PackageReference Include="NodaTime" Version="3.1.0" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.5" /> <PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.5" />

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

@ -9,13 +9,13 @@ open System
let asOfDateDisplayTests = let asOfDateDisplayTests =
testList "AsOfDateDisplay" [ testList "AsOfDateDisplay" [
test "NoDisplay code is correct" { test "NoDisplay code is correct" {
Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\"" Expect.equal (AsOfDateDisplay.toCode NoDisplay) "N" "The code for NoDisplay should have been \"N\""
} }
test "ShortDate code is correct" { test "ShortDate code is correct" {
Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\"" Expect.equal (AsOfDateDisplay.toCode ShortDate) "S" "The code for ShortDate should have been \"S\""
} }
test "LongDate code is correct" { test "LongDate code is correct" {
Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\"" Expect.equal (AsOfDateDisplay.toCode LongDate) "L" "The code for LongDate should have been \"N\""
} }
test "fromCode N should return NoDisplay" { test "fromCode N should return NoDisplay" {
Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay" Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay"
@ -37,14 +37,14 @@ 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.churchId 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"
Expect.equal mt.st "" "The state should have been blank" Expect.equal mt.State "" "The state should have been blank"
Expect.isFalse mt.hasInterface "The church should not show that it has an interface" Expect.isFalse mt.HasInterface "The church should not show that it has an interface"
Expect.isNone mt.interfaceAddress "The interface address should not exist" Expect.isNone mt.InterfaceAddress "The interface address should not exist"
Expect.isNotNull mt.smallGroups "The small groups navigation property should not be null" Expect.isNotNull mt.SmallGroups "The small groups navigation property should not be null"
Expect.isEmpty mt.smallGroups "There should be no small groups for an empty church" Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty church"
} }
] ]
@ -52,10 +52,10 @@ let churchTests =
let emailFormatTests = let emailFormatTests =
testList "EmailFormat" [ testList "EmailFormat" [
test "HtmlFormat code is correct" { test "HtmlFormat code is correct" {
Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\"" Expect.equal (EmailFormat.toCode HtmlFormat) "H" "The code for HtmlFormat should have been \"H\""
} }
test "PlainTextFormat code is correct" { test "PlainTextFormat code is correct" {
Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\"" Expect.equal (EmailFormat.toCode PlainTextFormat) "P" "The code for PlainTextFormat should have been \"P\""
} }
test "fromCode H should return HtmlFormat" { test "fromCode H should return HtmlFormat" {
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
@ -74,13 +74,13 @@ let emailFormatTests =
let expirationTests = let expirationTests =
testList "Expiration" [ testList "Expiration" [
test "Automatic code is correct" { test "Automatic code is correct" {
Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\"" Expect.equal (Expiration.toCode Automatic) "A" "The code for Automatic should have been \"A\""
} }
test "Manual code is correct" { test "Manual code is correct" {
Expect.equal Manual.code "M" "The code for Manual should have been \"M\"" Expect.equal (Expiration.toCode Manual) "M" "The code for Manual should have been \"M\""
} }
test "Forced code is correct" { test "Forced code is correct" {
Expect.equal Forced.code "F" "The code for Forced should have been \"F\"" Expect.equal (Expiration.toCode Forced) "F" "The code for Forced should have been \"F\""
} }
test "fromCode A should return Automatic" { test "fromCode A should return Automatic" {
Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic" Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic"
@ -102,27 +102,28 @@ let listPreferencesTests =
testList "ListPreferences" [ testList "ListPreferences" [
test "empty is as expected" { test "empty is as expected" {
let mt = ListPreferences.empty let mt = ListPreferences.empty
Expect.equal mt.smallGroupId 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"
Expect.equal mt.longTermUpdateWeeks 4 "The default long term update weeks should have been 4" Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4"
Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" Expect.equal mt.EmailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker"
Expect.equal mt.emailFromAddress "prayer@djs-consulting.com" Expect.equal mt.EmailFromAddress "prayer@djs-consulting.com"
"The default e-mail from address should have been prayer@djs-consulting.com" "The default e-mail from address should have been prayer@djs-consulting.com"
Expect.equal mt.listFonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" Expect.equal mt.Fonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" "The default list fonts were incorrect"
"The default list fonts were incorrect" Expect.equal mt.HeadingColor "maroon" "The default heading text color should have been maroon"
Expect.equal mt.headingColor "maroon" "The default heading text color should have been maroon" Expect.equal mt.LineColor "navy" "The default heding line color should have been navy"
Expect.equal mt.lineColor "navy" "The default heding line color should have been navy" Expect.equal mt.HeadingFontSize 16 "The default heading font size should have been 16"
Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16" Expect.equal mt.TextFontSize 12 "The default text font size should have been 12"
Expect.equal mt.textFontSize 12 "The default text font size should have been 12" Expect.equal mt.RequestSort SortByDate "The default request sort should have been by date"
Expect.equal mt.requestSort SortByDate "The default request sort should have been by date" 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 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.timeZone.timeZoneId "" "The default preferences should have included an empty time zone" Expect.equal (TimeZoneId.toString mt.TimeZone.Id) ""
Expect.equal mt.pageSize 100 "The default page size should have been 100" "The default preferences should have included an empty time zone"
Expect.equal mt.asOfDateDisplay NoDisplay "The as-of date display should have been No Display" 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"
} }
] ]
@ -131,12 +132,12 @@ 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.memberId 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 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.memberName "" "The member name should have been blank" Expect.equal mt.Name "" "The member name should have been blank"
Expect.equal mt.email "" "The member e-mail address should have been blank" Expect.equal mt.Email "" "The member e-mail address should have been blank"
Expect.isNone mt.format "The preferred e-mail format should not exist" Expect.isNone mt.Format "The preferred e-mail format should not exist"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one"
} }
] ]
@ -145,62 +146,62 @@ let prayerRequestTests =
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.prayerRequestId 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 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 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.enteredDate DateTime.MinValue "The entered date should have been the minimum" Expect.equal mt.EnteredDate DateTime.MinValue "The entered date should have been the minimum"
Expect.equal mt.updatedDate DateTime.MinValue "The updated date should have been the minimum" Expect.equal mt.UpdatedDate DateTime.MinValue "The updated date should have been the minimum"
Expect.isNone mt.requestor "The requestor should not exist" Expect.isNone mt.Requestor "The requestor should not exist"
Expect.equal mt.text "" "The request text should have been blank" Expect.equal mt.Text "" "The request text should have been blank"
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"
Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one" Expect.equal mt.User.Id.Value Guid.Empty "The user should have been an empty one"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one"
} }
test "isExpired always returns false for expecting requests" { test "isExpired always returns false for expecting requests" {
let req = { PrayerRequest.empty with requestType = Expecting } let req = { PrayerRequest.empty with RequestType = Expecting }
Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired" Expect.isFalse (req.isExpired DateTime.Now 0) "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" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddMonths -1; expiration = Manual } let req = { PrayerRequest.empty with UpdatedDate = DateTime.Now.AddMonths -1; Expiration = Manual }
Expect.isFalse (req.isExpired DateTime.Now 4) "A never-expired request should never be considered expired" Expect.isFalse (req.isExpired DateTime.Now 4) "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" {
let req = { PrayerRequest.empty with requestType = LongTermRequest } let req = { PrayerRequest.empty with RequestType = LongTermRequest }
Expect.isFalse (req.isExpired DateTime.Now 0) Expect.isFalse (req.isExpired DateTime.Now 0)
"A recurring/long-term request should never be considered expired" "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" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced } let req = { PrayerRequest.empty with UpdatedDate = DateTime.Now; Expiration = Forced }
Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired" Expect.isTrue (req.isExpired DateTime.Now 5) "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 = DateTime.Now let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.AddDays -5. } let req = { PrayerRequest.empty with UpdatedDate = now.AddDays -5. }
Expect.isFalse (req.isExpired now 7) "A request updated 5 days ago should not be considered expired" Expect.isFalse (req.isExpired now 7) "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 = DateTime.Now let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.AddDays -8. } let req = { PrayerRequest.empty with UpdatedDate = now.AddDays -8. }
Expect.isTrue (req.isExpired now 7) "A request updated 8 days ago should be considered expired" Expect.isTrue (req.isExpired now 7) "A request updated 8 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 = DateTime.Now let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. } let req = { PrayerRequest.empty with UpdatedDate = now.Date.AddDays(-7.).AddSeconds -1. }
Expect.isTrue (req.isExpired now 7) Expect.isTrue (req.isExpired now 7)
"A request entered a second before midnight should be considered expired" "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" {
let req = { PrayerRequest.empty with expiration = Forced } let req = { PrayerRequest.empty with Expiration = Forced }
Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update" Expect.isFalse (req.updateRequired DateTime.Now 7 4) "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 = DateTime.Now let now = DateTime.Now
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = LongTermRequest RequestType = LongTermRequest
updatedDate = now.AddDays -14. UpdatedDate = now.AddDays -14.
} }
Expect.isFalse (req.updateRequired now 7 4) Expect.isFalse (req.updateRequired now 7 4)
"An active request updated 14 days ago should not require an update until 28 days" "An active request updated 14 days ago should not require an update until 28 days"
@ -209,8 +210,8 @@ let prayerRequestTests =
let now = DateTime.Now let now = DateTime.Now
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = LongTermRequest RequestType = LongTermRequest
updatedDate = now.AddDays -34. UpdatedDate = now.AddDays -34.
} }
Expect.isTrue (req.updateRequired now 7 4) Expect.isTrue (req.updateRequired now 7 4)
"An active request updated 34 days ago should require an update (past 28 days)" "An active request updated 34 days ago should require an update (past 28 days)"
@ -221,19 +222,21 @@ let prayerRequestTests =
let prayerRequestTypeTests = let prayerRequestTypeTests =
testList "PrayerRequestType" [ testList "PrayerRequestType" [
test "CurrentRequest code is correct" { test "CurrentRequest code is correct" {
Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\"" Expect.equal (PrayerRequestType.toCode CurrentRequest) "C"
"The code for CurrentRequest should have been \"C\""
} }
test "LongTermRequest code is correct" { test "LongTermRequest code is correct" {
Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\"" Expect.equal (PrayerRequestType.toCode LongTermRequest) "L"
"The code for LongTermRequest should have been \"L\""
} }
test "PraiseReport code is correct" { test "PraiseReport code is correct" {
Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\"" Expect.equal (PrayerRequestType.toCode PraiseReport) "P" "The code for PraiseReport should have been \"P\""
} }
test "Expecting code is correct" { test "Expecting code is correct" {
Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\"" Expect.equal (PrayerRequestType.toCode Expecting) "E" "The code for Expecting should have been \"E\""
} }
test "Announcement code is correct" { test "Announcement code is correct" {
Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\"" Expect.equal (PrayerRequestType.toCode Announcement) "A" "The code for Announcement should have been \"A\""
} }
test "fromCode C should return CurrentRequest" { test "fromCode C should return CurrentRequest" {
Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest
@ -264,10 +267,10 @@ let prayerRequestTypeTests =
let requestSortTests = let requestSortTests =
testList "RequestSort" [ testList "RequestSort" [
test "SortByDate code is correct" { test "SortByDate code is correct" {
Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\"" Expect.equal (RequestSort.toCode SortByDate) "D" "The code for SortByDate should have been \"D\""
} }
test "SortByRequestor code is correct" { test "SortByRequestor code is correct" {
Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\"" Expect.equal (RequestSort.toCode SortByRequestor) "R" "The code for SortByRequestor should have been \"R\""
} }
test "fromCode D should return SortByDate" { test "fromCode D should return SortByDate" {
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
@ -290,23 +293,23 @@ let smallGroupTests =
FakeClock (Instant.FromDateTimeUtc now) |> f FakeClock (Instant.FromDateTimeUtc 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.smallGroupId 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 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"
Expect.equal mt.church.churchId Guid.Empty "The church should have been an empty one" Expect.equal mt.Church.Id.Value Guid.Empty "The church should have been an empty one"
Expect.isNotNull mt.members "The members navigation property should not be null" Expect.isNotNull mt.Members "The members navigation property should not be null"
Expect.isEmpty mt.members "There should be no members for an empty small group" Expect.isEmpty mt.Members "There should be no members for an empty small group"
Expect.isNotNull mt.prayerRequests "The prayer requests navigation property should not be null" Expect.isNotNull mt.PrayerRequests "The prayer requests navigation property should not be null"
Expect.isEmpty mt.prayerRequests "There should be no prayer requests for an empty small group" Expect.isEmpty mt.PrayerRequests "There should be no prayer requests for an empty small group"
Expect.isNotNull mt.users "The users navigation property should not be null" Expect.isNotNull mt.Users "The users navigation property should not be null"
Expect.isEmpty mt.users "There should be no users for an empty small group" Expect.isEmpty mt.Users "There should be no users for an empty small group"
} }
yield! testFixture withFakeClock [ yield! testFixture withFakeClock [
"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 = "Europe/Berlin" } Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "Europe/Berlin" }
} }
Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours" Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours"
"localTimeNow adjusts the time behind UTC", "localTimeNow adjusts the time behind UTC",
@ -315,7 +318,10 @@ let smallGroupTests =
"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 = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "garbage" } } let grp =
{ SmallGroup.empty with
Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "garbage" }
}
Expect.equal (grp.localTimeNow clock) now "UTC should have been returned for an invalid time zone" Expect.equal (grp.localTimeNow clock) now "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" {
@ -334,10 +340,10 @@ let timeZoneTests =
testList "TimeZone" [ testList "TimeZone" [
test "empty is as expected" { test "empty is as expected" {
let mt = TimeZone.empty let mt = TimeZone.empty
Expect.equal mt.timeZoneId "" "The time zone ID should have been blank" Expect.equal (TimeZoneId.toString mt.Id) "" "The time zone ID should have been blank"
Expect.equal mt.description "" "The description should have been blank" Expect.equal mt.Description "" "The description should have been blank"
Expect.equal mt.sortOrder 0 "The sort order should have been zero" Expect.equal mt.SortOrder 0 "The sort order should have been zero"
Expect.isFalse mt.isActive "The is-active flag should not have been set" Expect.isFalse mt.IsActive "The is-active flag should not have been set"
} }
] ]
@ -346,18 +352,18 @@ 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.userId 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"
Expect.equal mt.emailAddress "" "The e-mail address should have been blank" Expect.equal mt.Email "" "The e-mail address should have been blank"
Expect.isFalse mt.isAdmin "The is admin flag should not have been set" Expect.isFalse mt.IsAdmin "The is admin flag should not have been set"
Expect.equal mt.passwordHash "" "The password hash should have been blank" Expect.equal mt.PasswordHash "" "The password hash should have been blank"
Expect.isNone mt.salt "The password salt should not exist" Expect.isNone mt.Salt "The password salt should not exist"
Expect.isNotNull mt.smallGroups "The small groups navigation property should not have been null" Expect.isNotNull mt.SmallGroups "The small groups navigation property should not have been null"
Expect.isEmpty mt.smallGroups "There should be no small groups for an empty user" Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty user"
} }
test "fullName concatenates first and last names" { test "fullName 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.fullName "Unit Test" "The full name should be the first and last, separated by a space" Expect.equal user.fullName "Unit Test" "The full name should be the first and last, separated by a space"
} }
] ]
@ -367,9 +373,9 @@ 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 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 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.user.userId Guid.Empty "The user should have been an empty one" Expect.equal mt.User.Id.Value Guid.Empty "The user should have been an empty one"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one"
} }
] ]

15
src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs
View File

@ -178,37 +178,38 @@ let tableSummaryTests =
module TimeZones = module TimeZones =
open PrayerTracker.Entities
open PrayerTracker.Views.CommonFunctions.TimeZones open PrayerTracker.Views.CommonFunctions.TimeZones
[<Tests>] [<Tests>]
let nameTests = let nameTests =
testList "TimeZones.name" [ testList "TimeZones.name" [
test "succeeds for US Eastern time" { test "succeeds for US Eastern time" {
Expect.equal (name "America/New_York" _s |> string) "Eastern" Expect.equal (name (TimeZoneId "America/New_York") _s |> string) "Eastern"
"US Eastern time zone not returned correctly" "US Eastern time zone not returned correctly"
} }
test "succeeds for US Central time" { test "succeeds for US Central time" {
Expect.equal (name "America/Chicago" _s |> string) "Central" Expect.equal (name (TimeZoneId "America/Chicago") _s |> string) "Central"
"US Central time zone not returned correctly" "US Central time zone not returned correctly"
} }
test "succeeds for US Mountain time" { test "succeeds for US Mountain time" {
Expect.equal (name "America/Denver" _s |> string) "Mountain" Expect.equal (name (TimeZoneId "America/Denver") _s |> string) "Mountain"
"US Mountain time zone not returned correctly" "US Mountain time zone not returned correctly"
} }
test "succeeds for US Mountain (AZ) time" { test "succeeds for US Mountain (AZ) time" {
Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)" Expect.equal (name (TimeZoneId "America/Phoenix") _s |> string) "Mountain (Arizona)"
"US Mountain (AZ) time zone not returned correctly" "US Mountain (AZ) time zone not returned correctly"
} }
test "succeeds for US Pacific time" { test "succeeds for US Pacific time" {
Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" Expect.equal (name (TimeZoneId "America/Los_Angeles") _s |> string) "Pacific"
"US Pacific time zone not returned correctly" "US Pacific time zone not returned correctly"
} }
test "succeeds for Central European time" { test "succeeds for Central European time" {
Expect.equal (name "Europe/Berlin" _s |> string) "Central European" Expect.equal (name (TimeZoneId "Europe/Berlin") _s |> string) "Central European"
"Central European time zone not returned correctly" "Central European time zone not returned correctly"
} }
test "fails for unexpected time zone" { test "fails for unexpected time zone" {
Expect.equal (name "Wakanda" _s |> string) "Wakanda" Expect.equal (name (TimeZoneId "Wakanda") _s |> string) "Wakanda"
"Unexpected time zone should have returned the original ID" "Unexpected time zone should have returned the original ID"
} }
] ]

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

@ -21,9 +21,12 @@ module ReferenceListTests =
test "has all three options listed" { test "has all three options listed" {
let asOf = ReferenceList.asOfDateList _s let asOf = ReferenceList.asOfDateList _s
Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned" Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned"
Expect.exists asOf (fun (x, _) -> x = NoDisplay.code) "The option for no display was not found" Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode NoDisplay)
Expect.exists asOf (fun (x, _) -> x = ShortDate.code) "The option for a short date was not found" "The option for no display was not found"
Expect.exists asOf (fun (x, _) -> x = LongDate.code) "The option for a full date was not found" Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode ShortDate)
"The option for a short date was not found"
Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode LongDate)
"The option for a full date was not found"
} }
] ]
@ -37,9 +40,9 @@ module ReferenceListTests =
Expect.equal (fst top) "" "The default option should have been blank" Expect.equal (fst top) "" "The default option should have been blank"
Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect" Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect"
let nxt = typs |> Seq.skip 1 |> Seq.head let nxt = typs |> Seq.skip 1 |> Seq.head
Expect.equal (fst nxt) HtmlFormat.code "The 2nd option should have been HTML" Expect.equal (fst nxt) (EmailFormat.toCode HtmlFormat) "The 2nd option should have been HTML"
let lst = typs |> Seq.last let lst = typs |> Seq.last
Expect.equal (fst lst) PlainTextFormat.code "The 3rd option should have been plain text" Expect.equal (fst lst) (EmailFormat.toCode PlainTextFormat) "The 3rd option should have been plain text"
} }
] ]
@ -49,17 +52,19 @@ module ReferenceListTests =
test "excludes immediate expiration if not required" { test "excludes immediate expiration if not required" {
let exps = ReferenceList.expirationList _s false let exps = ReferenceList.expirationList _s false
Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned" Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned"
Expect.exists exps (fun (exp, _) -> exp = Automatic.code) Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic)
"The option for automatic expiration was not found" "The option for automatic expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual)
"The option for manual expiration was not found"
} }
test "includes immediate expiration if required" { test "includes immediate expiration if required" {
let exps = ReferenceList.expirationList _s true let exps = ReferenceList.expirationList _s true
Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned" Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned"
Expect.exists exps (fun (exp, _) -> exp = Automatic.code) Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic)
"The option for automatic expiration was not found" "The option for automatic expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual)
Expect.exists exps (fun (exp, _) -> exp = Forced.code) "The option for manual expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Forced)
"The option for immediate expiration was not found" "The option for immediate expiration was not found"
} }
] ]
@ -127,9 +132,9 @@ let appViewInfoTests =
let assignGroupsTests = let assignGroupsTests =
testList "AssignGroups" [ testList "AssignGroups" [
test "fromUser populates correctly" { test "fromUser populates correctly" {
let usr = { User.empty with userId = Guid.NewGuid (); 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 usr.userId "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.fullName "The user name was not filled correctly" Expect.equal asg.UserName usr.fullName "The user name was not filled correctly"
Expect.equal asg.SmallGroups "" "The small group string was not filled correctly" Expect.equal asg.SmallGroups "" "The small group string was not filled correctly"
} }
@ -141,38 +146,38 @@ let editChurchTests =
test "fromChurch populates correctly when interface exists" { test "fromChurch populates correctly when interface exists" {
let church = let church =
{ Church.empty with { Church.empty with
churchId = Guid.NewGuid () Id = (Guid.NewGuid >> ChurchId) ()
name = "Unit Test" Name = "Unit Test"
city = "Testlandia" City = "Testlandia"
st = "UT" State = "UT"
hasInterface = true HasInterface = true
interfaceAddress = Some "https://test-dem-units.test" InterfaceAddress = Some "https://test-dem-units.test"
} }
let edit = EditChurch.fromChurch church let edit = EditChurch.fromChurch church
Expect.equal edit.ChurchId church.churchId "The church ID was not filled correctly" Expect.equal edit.ChurchId (shortGuid church.Id.Value) "The church ID was not filled correctly"
Expect.equal edit.Name church.name "The church name was not filled correctly" Expect.equal edit.Name church.Name "The church name was not filled correctly"
Expect.equal edit.City church.city "The church's city was not filled correctly" Expect.equal edit.City church.City "The church's city was not filled correctly"
Expect.equal edit.State church.st "The church's state was not filled correctly" Expect.equal edit.State church.State "The church's state was not filled correctly"
Expect.isSome edit.HasInterface "The church should show that it has an interface" Expect.isSome edit.HasInterface "The church should show that it has an interface"
Expect.equal edit.HasInterface (Some true) "The hasInterface flag should be true" Expect.equal edit.HasInterface (Some true) "The hasInterface flag should be true"
Expect.isSome edit.InterfaceAddress "The interface address should exist" Expect.isSome edit.InterfaceAddress "The interface address should exist"
Expect.equal edit.InterfaceAddress church.interfaceAddress "The interface address was not filled correctly" Expect.equal edit.InterfaceAddress church.InterfaceAddress "The interface address was not filled correctly"
} }
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
churchId = Guid.NewGuid () Id = (Guid.NewGuid >> ChurchId) ()
name = "Unit Test" Name = "Unit Test"
city = "Testlandia" City = "Testlandia"
st = "UT" State = "UT"
} }
Expect.isNone edit.HasInterface "The church should not show that it has an interface" Expect.isNone edit.HasInterface "The church should not show that it has an interface"
Expect.isNone edit.InterfaceAddress "The interface address should not exist" Expect.isNone edit.InterfaceAddress "The interface address should not exist"
} }
test "empty is as expected" { test "empty is as expected" {
let edit = EditChurch.empty let edit = EditChurch.empty
Expect.equal edit.ChurchId Guid.Empty "The church ID should be the empty GUID" Expect.equal edit.ChurchId emptyGuid "The church ID should be the empty GUID"
Expect.equal edit.Name "" "The church name should be blank" Expect.equal edit.Name "" "The church name should be blank"
Expect.equal edit.City "" "The church's city should be blank" Expect.equal edit.City "" "The church's city should be blank"
Expect.equal edit.State "" "The church's state should be blank" Expect.equal edit.State "" "The church's state should be blank"
@ -183,13 +188,13 @@ let editChurchTests =
Expect.isTrue EditChurch.empty.IsNew "An empty GUID should be flagged as a new church" Expect.isTrue EditChurch.empty.IsNew "An empty GUID should be flagged as a new church"
} }
test "isNew works on an existing church" { test "isNew works on an existing church" {
Expect.isFalse { EditChurch.empty with ChurchId = Guid.NewGuid () }.IsNew Expect.isFalse { EditChurch.empty with ChurchId = (Guid.NewGuid >> shortGuid) () }.IsNew
"A non-empty GUID should not be flagged as a new church" "A non-empty GUID should not be flagged as a new church"
} }
test "populateChurch works correctly when an interface exists" { test "populateChurch works correctly when an interface exists" {
let edit = let edit =
{ EditChurch.empty with { EditChurch.empty with
ChurchId = Guid.NewGuid () ChurchId = (Guid.NewGuid >> shortGuid) ()
Name = "Test Baptist Church" Name = "Test Baptist Church"
City = "Testerville" City = "Testerville"
State = "TE" State = "TE"
@ -197,13 +202,13 @@ let editChurchTests =
InterfaceAddress = Some "https://test.units" InterfaceAddress = Some "https://test.units"
} }
let church = edit.PopulateChurch Church.empty let church = edit.PopulateChurch Church.empty
Expect.notEqual church.churchId 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"
Expect.equal church.st edit.State "The church's state was not updated correctly" Expect.equal church.State edit.State "The church's state was not updated correctly"
Expect.isTrue church.hasInterface "The church should show that it has an interface" Expect.isTrue church.HasInterface "The church should show that it has an interface"
Expect.isSome church.interfaceAddress "The interface address should exist" Expect.isSome church.InterfaceAddress "The interface address should exist"
Expect.equal church.interfaceAddress edit.InterfaceAddress "The interface address was not updated correctly" Expect.equal church.InterfaceAddress edit.InterfaceAddress "The interface address was not updated correctly"
} }
test "populateChurch works correctly when an interface does not exist" { test "populateChurch works correctly when an interface does not exist" {
let church = let church =
@ -212,8 +217,8 @@ let editChurchTests =
City = "Testerville" City = "Testerville"
State = "TE" State = "TE"
}.PopulateChurch Church.empty }.PopulateChurch Church.empty
Expect.isFalse church.hasInterface "The church should show that it has an interface" Expect.isFalse church.HasInterface "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"
} }
] ]
@ -223,23 +228,23 @@ let editMemberTests =
test "fromMember populates with group default format" { test "fromMember populates with group default format" {
let mbr = let mbr =
{ Member.empty with { Member.empty with
memberId = Guid.NewGuid () Id = (Guid.NewGuid >> MemberId) ()
memberName = "Test Name" Name = "Test Name"
email = "test_units@example.com" Email = "test_units@example.com"
} }
let edit = EditMember.fromMember mbr let edit = EditMember.fromMember mbr
Expect.equal edit.MemberId mbr.memberId "The member ID was not filled correctly" Expect.equal edit.MemberId (shortGuid mbr.Id.Value) "The member ID was not filled correctly"
Expect.equal edit.Name mbr.memberName "The member name was not filled correctly" Expect.equal edit.Name mbr.Name "The member name was not filled correctly"
Expect.equal edit.Email mbr.email "The e-mail address was not filled correctly" Expect.equal edit.Email mbr.Email "The e-mail address was not filled correctly"
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.code } let edit = EditMember.fromMember { Member.empty with Format = Some HtmlFormat }
Expect.equal edit.Format HtmlFormat.code "The e-mail format was not filled correctly" Expect.equal edit.Format (EmailFormat.toCode HtmlFormat) "The e-mail format was not filled correctly"
} }
test "empty is as expected" { test "empty is as expected" {
let edit = EditMember.empty let edit = EditMember.empty
Expect.equal edit.MemberId Guid.Empty "The member ID should have been an empty GUID" Expect.equal edit.MemberId emptyGuid "The member ID should have been an empty GUID"
Expect.equal edit.Name "" "The member name should have been blank" Expect.equal edit.Name "" "The member name should have been blank"
Expect.equal edit.Email "" "The e-mail address should have been blank" Expect.equal edit.Email "" "The e-mail address should have been blank"
Expect.equal edit.Format "" "The e-mail format should have been blank" Expect.equal edit.Format "" "The e-mail format should have been blank"
@ -248,7 +253,7 @@ let editMemberTests =
Expect.isTrue EditMember.empty.IsNew "An empty GUID should be flagged as a new member" Expect.isTrue EditMember.empty.IsNew "An empty GUID should be flagged as a new member"
} }
test "isNew works for an existing member" { test "isNew works for an existing member" {
Expect.isFalse { EditMember.empty with MemberId = Guid.NewGuid () }.IsNew Expect.isFalse { EditMember.empty with MemberId = (Guid.NewGuid >> shortGuid) () }.IsNew
"A non-empty GUID should not be flagged as a new member" "A non-empty GUID should not be flagged as a new member"
} }
] ]
@ -259,45 +264,47 @@ let editPreferencesTests =
test "fromPreferences succeeds for named colors and private list" { test "fromPreferences succeeds for 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"
Expect.equal edit.LongTermUpdateWeeks prefs.longTermUpdateWeeks Expect.equal edit.LongTermUpdateWeeks prefs.LongTermUpdateWeeks
"The weeks for update were not filled correctly" "The weeks for update were not filled correctly"
Expect.equal edit.RequestSort prefs.requestSort.code "The request sort was not filled correctly" Expect.equal edit.RequestSort (RequestSort.toCode prefs.RequestSort)
Expect.equal edit.EmailFromName prefs.emailFromName "The e-mail from name was not filled correctly" "The request sort was not filled correctly"
Expect.equal edit.EmailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly" Expect.equal edit.EmailFromName prefs.EmailFromName "The e-mail from name was not filled correctly"
Expect.equal edit.DefaultEmailType prefs.defaultEmailType.code Expect.equal edit.EmailFromAddress prefs.EmailFromAddress "The e-mail from address was not filled correctly"
Expect.equal edit.DefaultEmailType (EmailFormat.toCode prefs.DefaultEmailType)
"The default e-mail type was not filled correctly" "The default e-mail type was not filled correctly"
Expect.equal edit.LineColorType "Name" "The heading line color type was not derived correctly" Expect.equal edit.LineColorType "Name" "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"
Expect.equal edit.HeadingColorType "Name" "The heading text color type was not derived correctly" Expect.equal edit.HeadingColorType "Name" "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"
Expect.equal edit.Fonts prefs.listFonts "The list fonts were not filled correctly" Expect.equal edit.Fonts prefs.Fonts "The list fonts were not filled correctly"
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 prefs.timeZoneId "The time zone was not filled correctly" Expect.equal edit.TimeZone (TimeZoneId.toString 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 RequestVisibility.``private`` Expect.equal edit.Visibility RequestVisibility.``private``
"The list visibility was not derived correctly" "The list visibility was not derived correctly"
Expect.equal edit.PageSize prefs.pageSize "The page size was not filled correctly" Expect.equal edit.PageSize prefs.PageSize "The page size was not filled correctly"
Expect.equal edit.AsOfDate prefs.asOfDateDisplay.code "The as-of date display was not filled correctly" Expect.equal edit.AsOfDate (AsOfDateDisplay.toCode 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"
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 RequestVisibility.passwordProtected Expect.equal edit.Visibility RequestVisibility.passwordProtected
"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"
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 "") "The group password was not filled correctly" Expect.equal edit.GroupPassword (Some "") "The group password was not filled correctly"
Expect.equal edit.Visibility RequestVisibility.``public`` Expect.equal edit.Visibility RequestVisibility.``public``
@ -310,35 +317,38 @@ let editRequestTests =
testList "EditRequest" [ testList "EditRequest" [
test "empty is as expected" { test "empty is as expected" {
let mt = EditRequest.empty let mt = EditRequest.empty
Expect.equal mt.RequestId Guid.Empty "The request ID should be an empty GUID" Expect.equal mt.RequestId emptyGuid "The request ID should be an empty GUID"
Expect.equal mt.RequestType CurrentRequest.code "The request type should have been \"Current\"" Expect.equal mt.RequestType (PrayerRequestType.toCode CurrentRequest)
"The request type should have been \"Current\""
Expect.isNone mt.EnteredDate "The entered date should have been None" Expect.isNone mt.EnteredDate "The entered date should have been None"
Expect.isNone mt.SkipDateUpdate """The "skip date update" flag should have been None""" Expect.isNone mt.SkipDateUpdate """The "skip date update" flag should have been None"""
Expect.isNone mt.Requestor "The requestor should have been None" Expect.isNone mt.Requestor "The requestor should have been None"
Expect.equal mt.Expiration Automatic.code """The expiration should have been "A" (Automatic)""" Expect.equal mt.Expiration (Expiration.toCode Automatic)
"""The expiration should have been "A" (Automatic)"""
Expect.equal mt.Text "" "The text should have been blank" Expect.equal mt.Text "" "The text should have been blank"
} }
test "fromRequest succeeds" { test "fromRequest succeeds" {
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.empty with
prayerRequestId = Guid.NewGuid () Id = (Guid.NewGuid >> PrayerRequestId) ()
requestType = CurrentRequest RequestType = CurrentRequest
requestor = Some "Me" Requestor = Some "Me"
expiration = Manual Expiration = Manual
text = "the text" Text = "the text"
} }
let edit = EditRequest.fromRequest req let edit = EditRequest.fromRequest req
Expect.equal edit.RequestId req.prayerRequestId "The request ID was not filled correctly" Expect.equal edit.RequestId (shortGuid req.Id.Value) "The request ID was not filled correctly"
Expect.equal edit.RequestType req.requestType.code "The request type was not filled correctly" Expect.equal edit.RequestType (PrayerRequestType.toCode req.RequestType)
Expect.equal edit.Requestor req.requestor "The requestor was not filled correctly" "The request type was not filled correctly"
Expect.equal edit.Expiration Manual.code "The expiration was not filled correctly" Expect.equal edit.Requestor req.Requestor "The requestor was not filled correctly"
Expect.equal edit.Text req.text "The text was not filled correctly" Expect.equal edit.Expiration (Expiration.toCode Manual) "The expiration was not filled correctly"
Expect.equal edit.Text req.Text "The text was not filled correctly"
} }
test "isNew works for a new request" { test "isNew works for a new request" {
Expect.isTrue EditRequest.empty.IsNew "An empty GUID should be flagged as a new request" Expect.isTrue EditRequest.empty.IsNew "An empty GUID should be flagged as a new request"
} }
test "isNew works for an existing request" { test "isNew works for an existing request" {
Expect.isFalse { EditRequest.empty with RequestId = Guid.NewGuid () }.IsNew Expect.isFalse { EditRequest.empty with RequestId = (Guid.NewGuid >> shortGuid) () }.IsNew
"A non-empty GUID should not be flagged as a new request" "A non-empty GUID should not be flagged as a new request"
} }
] ]
@ -349,37 +359,37 @@ let editSmallGroupTests =
test "fromGroup succeeds" { test "fromGroup succeeds" {
let grp = let grp =
{ SmallGroup.empty with { SmallGroup.empty with
smallGroupId = Guid.NewGuid () Id = (Guid.NewGuid >> SmallGroupId) ()
name = "test group" Name = "test group"
churchId = Guid.NewGuid () ChurchId = (Guid.NewGuid >> ChurchId) ()
} }
let edit = EditSmallGroup.fromGroup grp let edit = EditSmallGroup.fromGroup grp
Expect.equal edit.SmallGroupId grp.smallGroupId "The small group ID was not filled correctly" Expect.equal edit.SmallGroupId (shortGuid grp.Id.Value) "The small group ID was not filled correctly"
Expect.equal edit.Name grp.name "The name was not filled correctly" Expect.equal edit.Name grp.Name "The name was not filled correctly"
Expect.equal edit.ChurchId grp.churchId "The church ID was not filled correctly" Expect.equal edit.ChurchId (shortGuid grp.ChurchId.Value) "The church ID was not filled correctly"
} }
test "empty is as expected" { test "empty is as expected" {
let mt = EditSmallGroup.empty let mt = EditSmallGroup.empty
Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID"
Expect.equal mt.Name "" "The name should be blank" Expect.equal mt.Name "" "The name should be blank"
Expect.equal mt.ChurchId Guid.Empty "The church ID should be an empty GUID" Expect.equal mt.ChurchId emptyGuid "The church ID should be an empty GUID"
} }
test "isNew works for a new small group" { test "isNew works for a new small group" {
Expect.isTrue EditSmallGroup.empty.IsNew "An empty GUID should be flagged as a new small group" Expect.isTrue EditSmallGroup.empty.IsNew "An empty GUID should be flagged as a new small group"
} }
test "isNew works for an existing small group" { test "isNew works for an existing small group" {
Expect.isFalse { EditSmallGroup.empty with SmallGroupId = Guid.NewGuid () }.IsNew Expect.isFalse { EditSmallGroup.empty with SmallGroupId = (Guid.NewGuid >> shortGuid) () }.IsNew
"A non-empty GUID should not be flagged as a new small group" "A non-empty GUID should not be flagged as a new small group"
} }
test "populateGroup succeeds" { test "populateGroup succeeds" {
let edit = let edit =
{ EditSmallGroup.empty with { EditSmallGroup.empty with
Name = "test name" Name = "test name"
ChurchId = Guid.NewGuid () 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 edit.ChurchId "The church ID was not populated correctly" Expect.equal grp.ChurchId (idFromShort ChurchId edit.ChurchId) "The church ID was not populated correctly"
} }
] ]
@ -388,7 +398,7 @@ let editUserTests =
testList "EditUser" [ testList "EditUser" [
test "empty is as expected" { test "empty is as expected" {
let mt = EditUser.empty let mt = EditUser.empty
Expect.equal mt.UserId Guid.Empty "The user ID should be an empty GUID" Expect.equal mt.UserId emptyGuid "The user ID should be an empty GUID"
Expect.equal mt.FirstName "" "The first name should be blank" Expect.equal mt.FirstName "" "The first name should be blank"
Expect.equal mt.LastName "" "The last name should be blank" Expect.equal mt.LastName "" "The last name should be blank"
Expect.equal mt.Email "" "The e-mail address should be blank" Expect.equal mt.Email "" "The e-mail address should be blank"
@ -399,23 +409,23 @@ let editUserTests =
test "fromUser succeeds" { test "fromUser succeeds" {
let usr = let usr =
{ User.empty with { User.empty with
userId = Guid.NewGuid () Id = (Guid.NewGuid >> UserId) ()
firstName = "user" FirstName = "user"
lastName = "test" LastName = "test"
emailAddress = "a@b.c" Email = "a@b.c"
} }
let edit = EditUser.fromUser usr let edit = EditUser.fromUser usr
Expect.equal edit.UserId usr.userId "The user ID was not filled correctly" Expect.equal edit.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly"
Expect.equal edit.FirstName usr.firstName "The first name was not filled correctly" Expect.equal edit.FirstName usr.FirstName "The first name was not filled correctly"
Expect.equal edit.LastName usr.lastName "The last name was not filled correctly" Expect.equal edit.LastName usr.LastName "The last name was not filled correctly"
Expect.equal edit.Email usr.emailAddress "The e-mail address was not filled correctly" Expect.equal edit.Email usr.Email "The e-mail address was not filled correctly"
Expect.isNone edit.IsAdmin "The IsAdmin flag was not filled correctly" Expect.isNone edit.IsAdmin "The IsAdmin flag was not filled correctly"
} }
test "isNew works for a new user" { test "isNew works for a new user" {
Expect.isTrue EditUser.empty.IsNew "An empty GUID should be flagged as a new user" Expect.isTrue EditUser.empty.IsNew "An empty GUID should be flagged as a new user"
} }
test "isNew works for an existing user" { test "isNew works for an existing user" {
Expect.isFalse { EditUser.empty with UserId = Guid.NewGuid () }.IsNew Expect.isFalse { EditUser.empty with UserId = (Guid.NewGuid >> shortGuid) () }.IsNew
"A non-empty GUID should not be flagged as a new user" "A non-empty GUID should not be flagged as a new user"
} }
test "populateUser succeeds" { test "populateUser succeeds" {
@ -429,11 +439,11 @@ let editUserTests =
} }
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.emailAddress edit.Email "The e-mail address was not populated correctly" Expect.equal usr.Email edit.Email "The e-mail address was not populated correctly"
Expect.isTrue usr.isAdmin "The isAdmin flag was not populated correctly" Expect.isTrue usr.IsAdmin "The isAdmin flag was not populated correctly"
Expect.equal usr.passwordHash (hasher edit.Password) "The password hash was not populated correctly" Expect.equal usr.PasswordHash (hasher edit.Password) "The password hash was not populated correctly"
} }
] ]
@ -442,7 +452,7 @@ let groupLogOnTests =
testList "GroupLogOn" [ testList "GroupLogOn" [
test "empty is as expected" { test "empty is as expected" {
let mt = GroupLogOn.empty let mt = GroupLogOn.empty
Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID"
Expect.equal mt.Password "" "The password should be blank" Expect.equal mt.Password "" "The password should be blank"
Expect.isNone mt.RememberMe "Remember Me should be None" Expect.isNone mt.RememberMe "Remember Me should be None"
} }
@ -454,7 +464,7 @@ let maintainRequestsTests =
test "empty is as expected" { test "empty is as expected" {
let mt = MaintainRequests.empty let mt = MaintainRequests.empty
Expect.isEmpty mt.Requests "The requests for the model should have been empty" Expect.isEmpty mt.Requests "The requests for the model should have been empty"
Expect.equal mt.SmallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one"
Expect.isNone mt.OnlyActive "The only active flag should have been None" Expect.isNone mt.OnlyActive "The only active flag should have been None"
Expect.isNone mt.SearchTerm "The search term should have been None" Expect.isNone mt.SearchTerm "The search term should have been None"
Expect.isNone mt.PageNbr "The page number should have been None" Expect.isNone mt.PageNbr "The page number should have been None"
@ -490,21 +500,21 @@ let requestListTests =
let withRequestList f () = let withRequestList f () =
{ Requests = [ { Requests = [
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = CurrentRequest RequestType = CurrentRequest
requestor = Some "Zeb" Requestor = Some "Zeb"
text = "zyx" Text = "zyx"
updatedDate = DateTime.Today UpdatedDate = DateTime.Today
} }
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = CurrentRequest RequestType = CurrentRequest
requestor = Some "Aaron" Requestor = Some "Aaron"
text = "abc" Text = "abc"
updatedDate = DateTime.Today - TimeSpan.FromDays 9. UpdatedDate = DateTime.Today - TimeSpan.FromDays 9.
} }
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = PraiseReport RequestType = PraiseReport
text = "nmo" Text = "nmo"
updatedDate = DateTime.Today UpdatedDate = DateTime.Today
} }
] ]
Date = DateTime.Today Date = DateTime.Today
@ -517,7 +527,7 @@ let requestListTests =
yield! testFixture withRequestList [ yield! testFixture withRequestList [
"AsHtml succeeds without header or as-of date", "AsHtml succeeds without header or as-of date",
fun reqList -> fun reqList ->
let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" } } let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" } }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
Expect.equal -1 (html.IndexOf "Test HTML Group") Expect.equal -1 (html.IndexOf "Test HTML Group")
"The small group name should not have existed (no header)" "The small group name should not have existed (no header)"
@ -557,7 +567,7 @@ let requestListTests =
fun reqList -> fun reqList ->
let htmlList = let htmlList =
{ reqList with { reqList with
SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" } SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" }
ShowHeader = true ShowHeader = true
} }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
@ -578,12 +588,12 @@ let requestListTests =
{ reqList with { reqList with
SmallGroup = SmallGroup =
{ reqList.SmallGroup with { reqList.SmallGroup with
preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate } Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate }
} }
} }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.Requests[0].updatedDate.ToShortDateString () htmlList.Requests[0].UpdatedDate.ToShortDateString ()
|> sprintf """<strong>Zeb</strong> &mdash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>""" |> sprintf """<strong>Zeb</strong> &mdash; 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"
@ -593,20 +603,20 @@ let requestListTests =
{ reqList with { reqList with
SmallGroup = SmallGroup =
{ reqList.SmallGroup with { reqList.SmallGroup with
preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate } Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate }
} }
} }
let html = htmlList.AsHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.Requests[0].updatedDate.ToLongDateString () htmlList.Requests[0].UpdatedDate.ToLongDateString ()
|> sprintf """<strong>Zeb</strong> &mdash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>""" |> sprintf """<strong>Zeb</strong> &mdash; 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" } }
let text = textList.AsText _s let text = textList.AsText _s
Expect.stringContains text $"{textList.SmallGroup.name}\n" "Small group name not found" Expect.stringContains text $"{textList.SmallGroup.Name}\n" "Small group name not found"
Expect.stringContains text "Prayer Requests\n" "List heading not found" Expect.stringContains text "Prayer Requests\n" "List heading not found"
Expect.stringContains text ((textList.Date.ToString "MMMM d, yyyy") + "\n \n") "List date not found" Expect.stringContains text ((textList.Date.ToString "MMMM d, yyyy") + "\n \n") "List date not found"
Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n" Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n"
@ -623,12 +633,12 @@ let requestListTests =
{ reqList with { reqList with
SmallGroup = SmallGroup =
{ reqList.SmallGroup with { reqList.SmallGroup with
preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate } Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate }
} }
} }
let text = textList.AsText _s let text = textList.AsText _s
let expected = let expected =
textList.Requests[0].updatedDate.ToShortDateString () textList.Requests[0].UpdatedDate.ToShortDateString ()
|> 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"
@ -638,12 +648,12 @@ let requestListTests =
{ reqList with { reqList with
SmallGroup = SmallGroup =
{ reqList.SmallGroup with { reqList.SmallGroup with
preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate } Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate }
} }
} }
let text = textList.AsText _s let text = textList.AsText _s
let expected = let expected =
textList.Requests[0].updatedDate.ToLongDateString () textList.Requests[0].UpdatedDate.ToLongDateString ()
|> 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"
@ -663,7 +673,7 @@ let requestListTests =
let _, _, reqs = Option.get maybeCurrent let _, _, reqs = Option.get maybeCurrent
Expect.hasCountOf reqs 2u countAll "There should have been two requests" Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs let first = List.head reqs
Expect.equal first.text "zyx" "The requests should be sorted by updated date descending" Expect.equal first.Text "zyx" "The requests should be sorted by updated date descending"
Expect.isTrue (allReqs |> List.exists (fun (typ, _, _) -> typ = PraiseReport)) Expect.isTrue (allReqs |> List.exists (fun (typ, _, _) -> typ = PraiseReport))
"There should have been praise reports" "There should have been praise reports"
Expect.isFalse (allReqs |> List.exists (fun (typ, _, _) -> typ = Announcement)) Expect.isFalse (allReqs |> List.exists (fun (typ, _, _) -> typ = Announcement))
@ -674,14 +684,14 @@ let requestListTests =
{ reqList with { reqList with
SmallGroup = SmallGroup =
{ reqList.SmallGroup with { reqList.SmallGroup with
preferences = { reqList.SmallGroup.preferences with requestSort = SortByRequestor } Preferences = { reqList.SmallGroup.Preferences with RequestSort = SortByRequestor }
} }
} }
let allReqs = newList.RequestsByType _s let allReqs = newList.RequestsByType _s
let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest) let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest)
Expect.hasCountOf reqs 2u countAll "There should have been two requests" Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs let first = List.head reqs
Expect.equal first.text "abc" "The requests should be sorted by requestor" Expect.equal first.Text "abc" "The requests should be sorted by requestor"
] ]
] ]
@ -692,7 +702,7 @@ let userLogOnTests =
let mt = UserLogOn.empty let mt = UserLogOn.empty
Expect.equal mt.Email "" "The e-mail address should be blank" Expect.equal mt.Email "" "The e-mail address should be blank"
Expect.equal mt.Password "" "The password should be blank" Expect.equal mt.Password "" "The password should be blank"
Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID"
Expect.isNone mt.RememberMe "Remember Me should be None" Expect.isNone mt.RememberMe "Remember Me should be None"
Expect.isNone mt.RedirectUrl "Redirect URL should be None" Expect.isNone mt.RedirectUrl "Redirect URL should be None"
} }

19
src/PrayerTracker.UI/Church.fs
View File

@ -1,6 +1,7 @@
module PrayerTracker.Views.Church module PrayerTracker.Views.Church
open Giraffe.ViewEngine open Giraffe.ViewEngine
open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
@ -19,7 +20,7 @@ let edit (model : EditChurch) ctx viewInfo =
|> AppViewInfo.withOnLoadScript "PT.church.edit.onPageLoad" |> AppViewInfo.withOnLoadScript "PT.church.edit.onPageLoad"
form [ _action "/church/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ form [ _action "/church/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name (nameof model.ChurchId); _value (flatGuid model.ChurchId) ] input [ _type "hidden"; _name (nameof model.ChurchId); _value model.ChurchId ]
div [ _fieldRow ] [ div [ _fieldRow ] [
div [ _inputField ] [ div [ _inputField ] [
label [ _for (nameof model.Name) ] [ locStr s["Church Name"] ] label [ _for (nameof model.Name) ] [ locStr s["Church Name"] ]
@ -65,10 +66,10 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
tableHeadings s [ "Actions"; "Name"; "Location"; "Groups"; "Requests"; "Users"; "Interface?" ] tableHeadings s [ "Actions"; "Name"; "Location"; "Groups"; "Requests"; "Users"; "Interface?" ]
churches churches
|> List.map (fun ch -> |> List.map (fun ch ->
let chId = flatGuid ch.churchId let chId = shortGuid ch.Id.Value
let delAction = $"/church/{chId}/delete" let delAction = $"/church/{chId}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["Church"].Value.ToLower ()} ({ch.name})"""] $"""{s["Church"].Value.ToLower ()} ({ch.Name})"""]
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/church/{chId}/edit"; _title s["Edit This Church"].Value ] [ icon "edit" ] a [ _href $"/church/{chId}/edit"; _title s["Edit This Church"].Value ] [ icon "edit" ]
@ -78,12 +79,12 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
icon "delete_forever" icon "delete_forever"
] ]
] ]
td [] [ str ch.name ] td [] [ str ch.Name ]
td [] [ str ch.city; rawText ", "; str ch.st ] td [] [ str ch.City; rawText ", "; str ch.State ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].smallGroups.ToString "N0") ] td [ _class "pt-right-text" ] [ rawText (stats[chId].SmallGroups.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].prayerRequests.ToString "N0") ] td [ _class "pt-right-text" ] [ rawText (stats[chId].PrayerRequests.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].users.ToString "N0") ] td [ _class "pt-right-text" ] [ rawText (stats[chId].Users.ToString "N0") ]
td [ _class "pt-center-text" ] [ locStr s[if ch.hasInterface then "Yes" else "No"] ] td [ _class "pt-center-text" ] [ locStr s[if ch.HasInterface then "Yes" else "No"] ]
]) ])
|> tbody [] |> tbody []
] ]

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

@ -103,16 +103,6 @@ let selectDefault text = $"— %s{text} —"
/// Generate a standard submit button with icon and text /// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
open System
// TODO: this is where to implement issue #1
/// Format a GUID with no dashes (used for URLs and forms)
let flatGuid (x : Guid) = x.ToString "N"
/// An empty GUID string (used for "add" actions)
let emptyGuid = flatGuid Guid.Empty
/// Create an HTML onsubmit event handler /// Create an HTML onsubmit event handler
let _onsubmit = attr "onsubmit" let _onsubmit = attr "onsubmit"
@ -167,6 +157,7 @@ let renderHtmlString = renderHtmlNode >> HtmlString
module TimeZones = module TimeZones =
open System.Collections.Generic open System.Collections.Generic
open PrayerTracker.Entities
/// Cross-reference between time zone Ids and their English names /// Cross-reference between time zone Ids and their English names
let private xref = let private xref =
@ -180,7 +171,8 @@ module TimeZones =
|> Map.ofList |> Map.ofList
/// Get the name of a time zone, given its Id /// Get the name of a time zone, given its Id
let name tzId (s : IStringLocalizer) = let name timeZoneId (s : IStringLocalizer) =
let tzId = TimeZoneId.toString timeZoneId
try s[xref[tzId]] try s[xref[tzId]]
with :? KeyNotFoundException -> LocalizedString (tzId, tzId) with :? KeyNotFoundException -> LocalizedString (tzId, tzId)

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

@ -50,7 +50,7 @@ module Navigation =
] ]
] ]
] ]
if u.isAdmin then if u.IsAdmin then
li [ _class "dropdown" ] [ li [ _class "dropdown" ] [
a [ _dropdown a [ _dropdown
_ariaLabel s["Administration"].Value _ariaLabel s["Administration"].Value
@ -167,8 +167,8 @@ module Navigation =
icon "group" icon "group"
space space
match m.User with match m.User with
| Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.name ] ] | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ]
| None -> strong [] [ str g.name ] | None -> strong [] [ str g.Name ]
rawText " &nbsp;" rawText " &nbsp;"
] ]
| None -> [] | None -> []

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

@ -17,13 +17,13 @@ let edit (model : EditRequest) today ctx viewInfo =
let vi = AppViewInfo.withOnLoadScript "PT.initCKEditor" viewInfo let vi = AppViewInfo.withOnLoadScript "PT.initCKEditor" viewInfo
form [ _action "/prayer-request/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ form [ _action "/prayer-request/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.RequestId) (flatGuid model.RequestId) [] inputField "hidden" (nameof model.RequestId) model.RequestId []
div [ _fieldRow ] [ div [ _fieldRow ] [
div [ _inputField ] [ div [ _inputField ] [
label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ]
ReferenceList.requestTypeList s ReferenceList.requestTypeList s
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value)
|> selectList (nameof model.RequestType) model.RequestType [ _required; _autofocus ] |> selectList (nameof model.RequestType) model.RequestType [ _required; _autofocus ]
] ]
div [ _inputField ] [ div [ _inputField ] [
@ -76,10 +76,10 @@ let edit (model : EditRequest) today ctx viewInfo =
/// View for the request e-mail results page /// View for the request e-mail results page
let email model viewInfo = let email model viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let prefs = model.SmallGroup.preferences let prefs = model.SmallGroup.Preferences
let addresses = model.Recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>") |> String.concat ", " let addresses = model.Recipients |> List.map (fun mbr -> $"{mbr.Name} <{mbr.Email}>") |> String.concat ", "
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [ [ p [ _style $"font-family:{prefs.Fonts};font-size:%i{prefs.TextFontSize}pt;" ] [
locStr s["The request list was sent to the following people, via individual e-mails"] locStr s["The request list was sent to the following people, via individual e-mails"]
rawText ":" rawText ":"
br [] br []
@ -126,9 +126,9 @@ let lists (groups : SmallGroup list) viewInfo =
tableHeadings s [ "Actions"; "Church"; "Group" ] tableHeadings s [ "Actions"; "Church"; "Group" ]
groups groups
|> List.map (fun grp -> |> List.map (fun grp ->
let grpId = flatGuid grp.smallGroupId let grpId = shortGuid grp.Id.Value
tr [] [ tr [] [
if grp.preferences.isPublic then if grp.Preferences.IsPublic then
a [ _href $"/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ] a [ _href $"/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ]
else else
a [ _href $"/small-group/log-on/{grpId}"; _title s["Log On"].Value ] [ a [ _href $"/small-group/log-on/{grpId}"; _title s["Log On"].Value ] [
@ -136,8 +136,8 @@ let lists (groups : SmallGroup list) viewInfo =
] ]
|> List.singleton |> List.singleton
|> td [] |> td []
td [] [ str grp.church.name ] td [] [ str grp.Church.Name ]
td [] [ str grp.name ] td [] [ str grp.Name ]
]) ])
|> tbody [] |> tbody []
] ]
@ -153,19 +153,19 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let now = model.SmallGroup.localDateNow (ctx.GetService<IClock> ()) let now = model.SmallGroup.localDateNow (ctx.GetService<IClock> ())
let prefs = model.SmallGroup.preferences let prefs = model.SmallGroup.Preferences
let types = ReferenceList.requestTypeList s |> Map.ofList let types = ReferenceList.requestTypeList s |> Map.ofList
let updReq (req : PrayerRequest) = let updReq (req : PrayerRequest) =
if req.updateRequired now prefs.daysToExpire prefs.longTermUpdateWeeks then "pt-request-update" else "" if req.updateRequired now prefs.DaysToExpire prefs.LongTermUpdateWeeks then "pt-request-update" else ""
|> _class |> _class
let reqExp (req : PrayerRequest) = let reqExp (req : PrayerRequest) =
_class (if req.isExpired now prefs.daysToExpire then "pt-request-expired" else "") _class (if req.isExpired now prefs.DaysToExpire then "pt-request-expired" else "")
/// 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
let requests = let requests =
model.Requests model.Requests
|> List.map (fun req -> |> List.map (fun req ->
let reqId = flatGuid req.prayerRequestId let reqId = shortGuid req.Id.Value
let reqText = htmlToPlainText req.text let reqText = htmlToPlainText req.Text
let delAction = $"/prayer-request/{reqId}/delete" let delAction = $"/prayer-request/{reqId}/delete"
let delPrompt = let delPrompt =
[ s["Are you sure you want to delete this {0}? This action cannot be undone.", [ s["Are you sure you want to delete this {0}? This action cannot be undone.",
@ -180,7 +180,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
a [ _href $"/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ] [ a [ _href $"/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ] [
icon "edit" icon "edit"
] ]
if req.isExpired now prefs.daysToExpire then if req.isExpired now prefs.DaysToExpire then
a [ _href $"/prayer-request/{reqId}/restore" a [ _href $"/prayer-request/{reqId}/restore"
_title l["Restore This Inactive Request"].Value ] [ _title l["Restore This Inactive Request"].Value ] [
icon "visibility" icon "visibility"
@ -197,10 +197,10 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
] ]
] ]
td [ updReq req ] [ td [ updReq req ] [
str (req.updatedDate.ToString(s["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture)) str (req.UpdatedDate.ToString(s["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture))
] ]
td [] [ locStr types[req.requestType] ] td [] [ locStr types[req.RequestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] td [ reqExp req ] [ str (match req.Requestor with Some r -> r | None -> " ") ]
td [] [ td [] [
match reqText.Length with match reqText.Length with
| len when len < 60 -> rawText reqText | len when len < 60 -> rawText reqText
@ -265,7 +265,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
let withPage = match pg with 2 -> search | _ -> ("page", string (pg - 1)) :: search let withPage = match pg with 2 -> search | _ -> ("page", string (pg - 1)) :: search
a [ _href (makeUrl url withPage) ] [ icon "keyboard_arrow_left"; space; raw l["Previous Page"] ] a [ _href (makeUrl url withPage) ] [ icon "keyboard_arrow_left"; space; raw l["Previous Page"] ]
rawText " &nbsp; &nbsp; " rawText " &nbsp; &nbsp; "
match requests.Length = model.SmallGroup.preferences.pageSize with match requests.Length = model.SmallGroup.Preferences.PageSize with
| true -> | true ->
a [ _href (makeUrl url (("page", string (pg + 1)) :: search)) ] [ a [ _href (makeUrl url (("page", string (pg + 1)) :: search)) ] [
raw l["Next Page"]; space; icon "keyboard_arrow_right" raw l["Next Page"]; space; icon "keyboard_arrow_right"
@ -281,13 +281,13 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
/// View for the printable prayer request list /// View for the printable prayer request list
let print model version = let print model version =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}""" let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}"""
article [] [ article [] [
rawText (model.AsHtml s) rawText (model.AsHtml s)
br [] br []
hr [] hr []
div [ _style $"font-size:70%%;font-family:{model.SmallGroup.preferences.listFonts};" ] [ div [ _style $"font-size:70%%;font-family:{model.SmallGroup.Preferences.Fonts};" ] [
img [ _src $"""/img/{s["footer_en"].Value}.png""" img [ _src $"""/img/{s["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;" _style "vertical-align:text-bottom;"
_alt imgAlt _alt imgAlt
@ -302,7 +302,7 @@ let print model version =
/// View for the prayer request list /// View for the prayer request list
let view model viewInfo = let view model viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; " let spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = model.Date.ToString "yyyy-MM-dd" let dtString = model.Date.ToString "yyyy-MM-dd"
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [

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

@ -2,6 +2,7 @@
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
@ -45,8 +46,8 @@ let announcement isAdmin ctx viewInfo =
label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ]
reqTypes reqTypes
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value)
|> selectList (nameof model.RequestType) Announcement.code [] |> selectList (nameof model.RequestType) (PrayerRequestType.toCode Announcement) []
] ]
] ]
div [ _fieldRow ] [ submit [] "send" s["Send Announcement"] ] div [ _fieldRow ] [ submit [] "send" s["Send Announcement"] ]
@ -76,7 +77,7 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo =
let pageTitle = if model.IsNew then "Add a New Group" else "Edit Group" let pageTitle = if model.IsNew then "Add a New Group" else "Edit Group"
form [ _action "/small-group/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ form [ _action "/small-group/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.SmallGroupId) (flatGuid model.SmallGroupId) [] inputField "hidden" (nameof model.SmallGroupId) model.SmallGroupId []
div [ _fieldRow ] [ div [ _fieldRow ] [
div [ _inputField ] [ div [ _inputField ] [
label [ _for (nameof model.Name) ] [ locStr s["Group Name"] ] label [ _for (nameof model.Name) ] [ locStr s["Group Name"] ]
@ -88,9 +89,9 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo =
label [ _for (nameof model.ChurchId) ] [ locStr s["Church"] ] label [ _for (nameof model.ChurchId) ] [ locStr s["Church"] ]
seq { seq {
"", selectDefault s["Select Church"].Value "", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name) yield! churches |> List.map (fun c -> shortGuid c.Id.Value, c.Name)
} }
|> selectList (nameof model.ChurchId) (flatGuid model.ChurchId) [ _required ] |> selectList (nameof model.ChurchId) model.ChurchId [ _required ]
] ]
] ]
div [ _fieldRow ] [ submit [] "save" s["Save Group"] ] div [ _fieldRow ] [ submit [] "save" s["Save Group"] ]
@ -111,7 +112,7 @@ let editMember (model : EditMember) (types : (string * LocalizedString) seq) ctx
] viewInfo ] viewInfo
form [ _action "/small-group/member/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ form [ _action "/small-group/member/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.MemberId) (flatGuid model.MemberId) [] inputField "hidden" (nameof model.MemberId) model.MemberId []
div [ _fieldRow ] [ div [ _fieldRow ] [
div [ _inputField ] [ div [ _inputField ] [
label [ _for (nameof model.Name) ] [ locStr s["Member Name"] ] label [ _for (nameof model.Name) ] [ locStr s["Member Name"] ]
@ -140,7 +141,7 @@ let editMember (model : EditMember) (types : (string * LocalizedString) seq) ctx
/// View for the small group log on page /// View for the small group log on page
let logOn (groups : SmallGroup list) grpId ctx viewInfo = let logOn (groups : SmallGroup list) grpId ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let model = { SmallGroupId = System.Guid.Empty; Password = ""; RememberMe = None } let model = { SmallGroupId = emptyGuid; Password = ""; RememberMe = None }
let vi = AppViewInfo.withOnLoadScript "PT.smallGroup.logOn.onPageLoad" viewInfo let vi = AppViewInfo.withOnLoadScript "PT.smallGroup.logOn.onPageLoad" viewInfo
form [ _action "/small-group/log-on/submit"; _method "post"; _class "pt-center-columns"; Target.body ] [ form [ _action "/small-group/log-on/submit"; _method "post"; _class "pt-center-columns"; Target.body ] [
csrfToken ctx csrfToken ctx
@ -153,7 +154,7 @@ let logOn (groups : SmallGroup list) grpId ctx viewInfo =
"", selectDefault s["Select Group"].Value "", selectDefault s["Select Group"].Value
yield! yield!
groups groups
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}") |> List.map (fun grp -> shortGuid grp.Id.Value, $"{grp.Church.Name} | {grp.Name}")
} }
|> selectList (nameof model.SmallGroupId) grpId [ _required ] |> selectList (nameof model.SmallGroupId) grpId [ _required ]
] ]
@ -187,10 +188,10 @@ let maintain (groups : SmallGroup list) ctx viewInfo =
tableHeadings s [ "Actions"; "Name"; "Church"; "Time Zone"] tableHeadings s [ "Actions"; "Name"; "Church"; "Time Zone"]
groups groups
|> List.map (fun g -> |> List.map (fun g ->
let grpId = flatGuid g.smallGroupId let grpId = shortGuid g.Id.Value
let delAction = $"/small-group/{grpId}/delete" let delAction = $"/small-group/{grpId}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["Small Group"].Value.ToLower ()} ({g.name})""" ].Value $"""{s["Small Group"].Value.ToLower ()} ({g.Name})""" ].Value
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/small-group/{grpId}/edit"; _title s["Edit This Group"].Value ] [ icon "edit" ] a [ _href $"/small-group/{grpId}/edit"; _title s["Edit This Group"].Value ] [ icon "edit" ]
@ -200,9 +201,9 @@ let maintain (groups : SmallGroup list) ctx viewInfo =
icon "delete_forever" icon "delete_forever"
] ]
] ]
td [] [ str g.name ] td [] [ str g.Name ]
td [] [ str g.church.name ] td [] [ str g.Church.Name ]
td [] [ locStr (TimeZones.name g.preferences.timeZoneId s) ] td [] [ locStr (TimeZones.name g.Preferences.TimeZoneId s) ]
]) ])
|> tbody [] |> tbody []
] ]
@ -233,11 +234,11 @@ let members (members : Member list) (emailTypes : Map<string, LocalizedString>)
tableHeadings s [ "Actions"; "Name"; "E-mail Address"; "Format"] tableHeadings s [ "Actions"; "Name"; "E-mail Address"; "Format"]
members members
|> List.map (fun mbr -> |> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId let mbrId = shortGuid mbr.Id.Value
let delAction = $"/small-group/member/{mbrId}/delete" let delAction = $"/small-group/member/{mbrId}/delete"
let delPrompt = let delPrompt =
s["Are you sure you want to delete this {0}? This action cannot be undone.", s["group member"]] s["Are you sure you want to delete this {0}? This action cannot be undone.", s["group member"]]
.Value.Replace("?", $" ({mbr.memberName})?") .Value.Replace("?", $" ({mbr.Name})?")
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/small-group/member/{mbrId}/edit"; _title s["Edit This Group Member"].Value ] [ a [ _href $"/small-group/member/{mbrId}/edit"; _title s["Edit This Group Member"].Value ] [
@ -249,9 +250,9 @@ let members (members : Member list) (emailTypes : Map<string, LocalizedString>)
icon "delete_forever" icon "delete_forever"
] ]
] ]
td [] [ str mbr.memberName ] td [] [ str mbr.Name ]
td [] [ str mbr.email ] td [] [ str mbr.Email ]
td [] [ locStr emailTypes[defaultArg mbr.format ""] ] td [] [ locStr emailTypes[defaultArg (mbr.Format |> Option.map EmailFormat.toCode) ""] ]
]) ])
|> tbody [] |> tbody []
] ]
@ -326,7 +327,6 @@ let overview model viewInfo =
open System.IO open System.IO
open PrayerTracker
/// View for the small group preferences page /// View for the small group preferences page
let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo = let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo =
@ -494,7 +494,10 @@ let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo =
label [ _for (nameof model.TimeZone) ] [ locStr s["Time Zone"] ] label [ _for (nameof model.TimeZone) ] [ locStr s["Time Zone"] ]
seq { seq {
"", selectDefault s["Select"].Value "", selectDefault s["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value) yield!
tzs
|> List.map (fun tz ->
TimeZoneId.toString tz.Id, (TimeZones.name tz.Id s).Value)
} }
|> selectList (nameof model.TimeZone) model.TimeZone [ _required ] |> selectList (nameof model.TimeZone) model.TimeZone [ _required ]
] ]

9
src/PrayerTracker.UI/User.fs
View File

@ -1,6 +1,7 @@
module PrayerTracker.Views.User module PrayerTracker.Views.User
open Giraffe.ViewEngine open Giraffe.ViewEngine
open PrayerTracker
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
/// View for the group assignment page /// View for the group assignment page
@ -9,7 +10,7 @@ let assignGroups model groups curGroups ctx viewInfo =
let pageTitle = sprintf "%s • %A" model.UserName s["Assign Groups"] let pageTitle = sprintf "%s • %A" model.UserName s["Assign Groups"]
form [ _action "/user/small-groups/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ form [ _action "/user/small-groups/save"; _method "post"; _class "pt-center-columns"; Target.content ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.UserId) (flatGuid model.UserId) [] inputField "hidden" (nameof model.UserId) model.UserId []
inputField "hidden" (nameof model.UserName) model.UserName [] inputField "hidden" (nameof model.UserName) model.UserName []
table [ _class "pt-table" ] [ table [ _class "pt-table" ] [
thead [] [ thead [] [
@ -108,7 +109,7 @@ let edit (model : EditUser) ctx viewInfo =
_onsubmit $"""return PT.compareValidation('{nameof model.Password}','{nameof model.PasswordConfirm}','%A{s["The passwords do not match"]}')""" _onsubmit $"""return PT.compareValidation('{nameof model.Password}','{nameof model.PasswordConfirm}','%A{s["The passwords do not match"]}')"""
Target.content ] [ Target.content ] [
csrfToken ctx csrfToken ctx
inputField "hidden" (nameof model.UserId) (flatGuid model.UserId) [] inputField "hidden" (nameof model.UserId) model.UserId []
div [ _fieldRow ] [ div [ _fieldRow ] [
div [ _inputField ] [ div [ _inputField ] [
label [ _for (nameof model.FirstName) ] [ locStr s["First Name"] ] label [ _for (nameof model.FirstName) ] [ locStr s["First Name"] ]
@ -195,7 +196,7 @@ let maintain (users : User list) ctx viewInfo =
tableHeadings s [ "Actions"; "Name"; "Admin?" ] tableHeadings s [ "Actions"; "Name"; "Admin?" ]
users users
|> List.map (fun user -> |> List.map (fun user ->
let userId = flatGuid user.userId let userId = shortGuid user.Id.Value
let delAction = $"/user/{userId}/delete" let delAction = $"/user/{userId}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["User"].Value.ToLower ()} ({user.fullName})"""].Value $"""{s["User"].Value.ToLower ()} ({user.fullName})"""].Value
@ -213,7 +214,7 @@ let maintain (users : User list) ctx viewInfo =
] ]
td [] [ str user.fullName ] td [] [ str user.fullName ]
td [ _class "pt-center-text" ] [ td [ _class "pt-center-text" ] [
if user.isAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"] if user.IsAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"]
] ]
]) ])
|> tbody [] |> tbody []

13
src/PrayerTracker.UI/Utils.fs
View File

@ -12,12 +12,23 @@ let sha1Hash (x : string) =
|> Seq.map (fun chr -> chr.ToString "x2") |> Seq.map (fun chr -> chr.ToString "x2")
|> String.concat "" |> String.concat ""
/// Hash a string using 1,024 rounds of PBKDF2 and a salt /// Hash a string using 1,024 rounds of PBKDF2 and a salt
let pbkdf2Hash (salt : Guid) (x : string) = let pbkdf2Hash (salt : Guid) (x : string) =
use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024) use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024)
(alg.GetBytes >> Convert.ToBase64String) 64 (alg.GetBytes >> Convert.ToBase64String) 64
open Giraffe
/// Parse a short-GUID-based ID from a string
let idFromShort<'T> (f : Guid -> 'T) strValue =
(ShortGuid.toGuid >> f) strValue
/// Format a GUID as a short GUID
let shortGuid = ShortGuid.fromGuid
/// An empty short GUID string (used for "add" actions)
let emptyGuid = shortGuid Guid.Empty
/// String helper functions /// String helper functions
module String = module String =

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

@ -10,10 +10,10 @@ open PrayerTracker.Entities
module ReferenceList = module ReferenceList =
/// A localized list of the AsOfDateDisplay DU cases /// A localized list of the AsOfDateDisplay DU cases
let asOfDateList (s : IStringLocalizer) = let asOfDateList (s : IStringLocalizer) = [
[ NoDisplay.code, s["Do not display the “as of” date"] AsOfDateDisplay.toCode NoDisplay, s["Do not display the “as of” date"]
ShortDate.code, s["Display a short “as of” date"] AsOfDateDisplay.toCode ShortDate, s["Display a short “as of” date"]
LongDate.code, s["Display a full “as of” date"] AsOfDateDisplay.toCode LongDate, s["Display a full “as of” date"]
] ]
/// A list of e-mail type options /// A list of e-mail type options
@ -23,20 +23,20 @@ module ReferenceList =
s[match def with HtmlFormat -> "HTML Format" | PlainTextFormat -> "Plain-Text Format"].Value s[match def with HtmlFormat -> "HTML Format" | PlainTextFormat -> "Plain-Text Format"].Value
seq { seq {
"", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""") "", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""")
HtmlFormat.code, s["HTML Format"] EmailFormat.toCode HtmlFormat, s["HTML Format"]
PlainTextFormat.code, s["Plain-Text Format"] EmailFormat.toCode PlainTextFormat, s["Plain-Text Format"]
} }
/// A list of expiration options /// A list of expiration options
let expirationList (s : IStringLocalizer) includeExpireNow = let expirationList (s : IStringLocalizer) includeExpireNow = [
[ Automatic.code, s["Expire Normally"] Expiration.toCode Automatic, s["Expire Normally"]
Manual.code, s["Request Never Expires"] Expiration.toCode Manual, s["Request Never Expires"]
if includeExpireNow then Forced.code, s["Expire Immediately"] if includeExpireNow then Expiration.toCode Forced, s["Expire Immediately"]
] ]
/// A list of request types /// A list of request types
let requestTypeList (s : IStringLocalizer) = let requestTypeList (s : IStringLocalizer) = [
[ CurrentRequest, s["Current Requests"] CurrentRequest, s["Current Requests"]
LongTermRequest, s["Long-Term Requests"] LongTermRequest, s["Long-Term Requests"]
PraiseReport, s["Praise Reports"] PraiseReport, s["Praise Reports"]
Expecting, s["Expecting"] Expecting, s["Expecting"]
@ -209,7 +209,7 @@ with
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type AssignGroups = type AssignGroups =
{ /// The Id of the user being assigned { /// The Id of the user being assigned
UserId : UserId UserId : string
/// The full name of the user being assigned /// The full name of the user being assigned
UserName : string UserName : string
@ -222,9 +222,9 @@ type AssignGroups =
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 (u : User) = let fromUser (user : User) =
{ UserId = u.userId { UserId = shortGuid user.Id.Value
UserName = u.fullName UserName = user.fullName
SmallGroups = "" SmallGroups = ""
} }
@ -246,8 +246,8 @@ type ChangePassword =
/// Form for adding or editing a church /// Form for adding or editing a church
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditChurch = type EditChurch =
{ /// The Id of the church { /// The ID of the church
ChurchId : ChurchId ChurchId : string
/// The name of the church /// The name of the church
Name : string Name : string
@ -267,35 +267,34 @@ type EditChurch =
with with
/// Is this a new church? /// Is this a new church?
member this.IsNew member this.IsNew = emptyGuid = this.ChurchId
with get () = Guid.Empty = 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
name = this.Name Name = this.Name
city = this.City City = this.City
st = this.State State = this.State
hasInterface = match this.HasInterface with Some x -> x | None -> false HasInterface = match this.HasInterface with Some x -> x | None -> false
interfaceAddress = match this.HasInterface with Some x when x -> this.InterfaceAddress | _ -> None InterfaceAddress = match this.HasInterface with Some x when x -> this.InterfaceAddress | _ -> None
} }
/// 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 (ch : Church) = let fromChurch (church : Church) =
{ ChurchId = ch.churchId { ChurchId = shortGuid church.Id.Value
Name = ch.name Name = church.Name
City = ch.city City = church.City
State = ch.st State = church.State
HasInterface = match ch.hasInterface with true -> Some true | false -> None HasInterface = match church.HasInterface with true -> Some true | false -> None
InterfaceAddress = ch.interfaceAddress InterfaceAddress = church.InterfaceAddress
} }
/// An instance to use for adding churches /// An instance to use for adding churches
let empty = let empty =
{ ChurchId = Guid.Empty { ChurchId = emptyGuid
Name = "" Name = ""
City = "" City = ""
State = "" State = ""
@ -308,7 +307,7 @@ module EditChurch =
[<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 : MemberId MemberId : string
/// The name of the member /// The name of the member
Name : string Name : string
@ -322,23 +321,22 @@ type EditMember =
with with
/// Is this a new member? /// Is this a new member?
member this.IsNew member this.IsNew = emptyGuid = this.MemberId
with get () = Guid.Empty = 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 (m : Member) = let fromMember (mbr : Member) =
{ MemberId = m.memberId { MemberId = shortGuid mbr.Id.Value
Name = m.memberName Name = mbr.Name
Email = m.email Email = mbr.Email
Format = match m.format with Some f -> f | None -> "" Format = match mbr.Format with Some fmt -> EmailFormat.toCode fmt | None -> ""
} }
/// An empty instance /// An empty instance
let empty = let empty =
{ MemberId = Guid.Empty { MemberId = emptyGuid
Name = "" Name = ""
Email = "" Email = ""
Format = "" Format = ""
@ -416,23 +414,23 @@ with
| RequestVisibility.``private`` | RequestVisibility.``private``
| _ -> false, "" | _ -> false, ""
{ prefs with { prefs with
daysToExpire = this.ExpireDays DaysToExpire = this.ExpireDays
daysToKeepNew = this.DaysToKeepNew DaysToKeepNew = this.DaysToKeepNew
longTermUpdateWeeks = this.LongTermUpdateWeeks LongTermUpdateWeeks = this.LongTermUpdateWeeks
requestSort = RequestSort.fromCode this.RequestSort RequestSort = RequestSort.fromCode this.RequestSort
emailFromName = this.EmailFromName EmailFromName = this.EmailFromName
emailFromAddress = this.EmailFromAddress EmailFromAddress = this.EmailFromAddress
defaultEmailType = EmailFormat.fromCode this.DefaultEmailType DefaultEmailType = EmailFormat.fromCode this.DefaultEmailType
lineColor = this.LineColor LineColor = this.LineColor
headingColor = this.HeadingColor HeadingColor = this.HeadingColor
listFonts = this.Fonts Fonts = this.Fonts
headingFontSize = this.HeadingFontSize HeadingFontSize = this.HeadingFontSize
textFontSize = this.ListFontSize TextFontSize = this.ListFontSize
timeZoneId = this.TimeZone TimeZoneId = TimeZoneId this.TimeZone
isPublic = isPublic IsPublic = isPublic
groupPassword = grpPw GroupPassword = grpPw
pageSize = this.PageSize PageSize = this.PageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.AsOfDate AsOfDateDisplay = AsOfDateDisplay.fromCode this.AsOfDate
} }
/// Support for the EditPreferences type /// Support for the EditPreferences type
@ -440,28 +438,28 @@ module EditPreferences =
/// Populate an edit form from existing preferences /// Populate an edit form from existing preferences
let fromPreferences (prefs : ListPreferences) = let fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name" let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ ExpireDays = prefs.daysToExpire { ExpireDays = prefs.DaysToExpire
DaysToKeepNew = prefs.daysToKeepNew DaysToKeepNew = prefs.DaysToKeepNew
LongTermUpdateWeeks = prefs.longTermUpdateWeeks LongTermUpdateWeeks = prefs.LongTermUpdateWeeks
RequestSort = prefs.requestSort.code RequestSort = RequestSort.toCode prefs.RequestSort
EmailFromName = prefs.emailFromName EmailFromName = prefs.EmailFromName
EmailFromAddress = prefs.emailFromAddress EmailFromAddress = prefs.EmailFromAddress
DefaultEmailType = prefs.defaultEmailType.code DefaultEmailType = EmailFormat.toCode prefs.DefaultEmailType
LineColorType = setType prefs.lineColor LineColorType = setType prefs.LineColor
LineColor = prefs.lineColor LineColor = prefs.LineColor
HeadingColorType = setType prefs.headingColor HeadingColorType = setType prefs.HeadingColor
HeadingColor = prefs.headingColor HeadingColor = prefs.HeadingColor
Fonts = prefs.listFonts Fonts = prefs.Fonts
HeadingFontSize = prefs.headingFontSize HeadingFontSize = prefs.HeadingFontSize
ListFontSize = prefs.textFontSize ListFontSize = prefs.TextFontSize
TimeZone = prefs.timeZoneId TimeZone = TimeZoneId.toString prefs.TimeZoneId
GroupPassword = Some prefs.groupPassword GroupPassword = Some prefs.GroupPassword
PageSize = prefs.pageSize PageSize = prefs.PageSize
AsOfDate = prefs.asOfDateDisplay.code AsOfDate = AsOfDateDisplay.toCode prefs.AsOfDateDisplay
Visibility = Visibility =
match true with match true with
| _ when prefs.isPublic -> RequestVisibility.``public`` | _ when prefs.IsPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private`` | _ when prefs.GroupPassword = "" -> RequestVisibility.``private``
| _ -> RequestVisibility.passwordProtected | _ -> RequestVisibility.passwordProtected
} }
@ -469,8 +467,8 @@ module EditPreferences =
/// Form for adding or editing prayer requests /// Form for adding or editing prayer requests
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditRequest = type EditRequest =
{ /// The Id of the request { /// The ID of the request
RequestId : PrayerRequestId RequestId : string
/// The type of the request /// The type of the request
RequestType : string RequestType : string
@ -493,82 +491,80 @@ type EditRequest =
with with
/// Is this a new request? /// Is this a new request?
member this.IsNew member this.IsNew = emptyGuid = this.RequestId
with get () = Guid.Empty = 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 = Guid.Empty { RequestId = emptyGuid
RequestType = CurrentRequest.code RequestType = PrayerRequestType.toCode CurrentRequest
EnteredDate = None EnteredDate = None
SkipDateUpdate = None SkipDateUpdate = None
Requestor = None Requestor = None
Expiration = Automatic.code Expiration = Expiration.toCode Automatic
Text = "" Text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
let fromRequest req = let fromRequest (req : PrayerRequest) =
{ empty with { empty with
RequestId = req.prayerRequestId RequestId = shortGuid req.Id.Value
RequestType = req.requestType.code RequestType = PrayerRequestType.toCode req.RequestType
Requestor = req.requestor Requestor = req.Requestor
Expiration = req.expiration.code Expiration = Expiration.toCode req.Expiration
Text = req.text Text = req.Text
} }
/// Form for the admin-level editing of small groups /// Form for the admin-level editing of small groups
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditSmallGroup = type EditSmallGroup =
{ /// The Id of the small group { /// The ID of the small group
SmallGroupId : SmallGroupId 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 : ChurchId ChurchId : string
} }
with with
/// Is this a new small group? /// Is this a new small group?
member this.IsNew member this.IsNew = emptyGuid = this.SmallGroupId
with get () = Guid.Empty = 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
name = this.Name Name = this.Name
churchId = this.ChurchId ChurchId = idFromShort ChurchId this.ChurchId
} }
/// 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 (g : SmallGroup) = let fromGroup (grp : SmallGroup) =
{ SmallGroupId = g.smallGroupId { SmallGroupId = shortGuid grp.Id.Value
Name = g.name Name = grp.Name
ChurchId = g.churchId 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 = Guid.Empty { SmallGroupId = emptyGuid
Name = "" Name = ""
ChurchId = Guid.Empty ChurchId = emptyGuid
} }
/// Form for the user edit page /// Form for the user edit page
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type EditUser = type EditUser =
{ /// The Id of the user { /// The ID of the user
UserId : UserId UserId : string
/// The first name of the user /// The first name of the user
FirstName : string FirstName : string
@ -591,27 +587,26 @@ type EditUser =
with with
/// Is this a new user? /// Is this a new user?
member this.IsNew member this.IsNew = emptyGuid = this.UserId
with get () = Guid.Empty = 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
firstName = this.FirstName FirstName = this.FirstName
lastName = this.LastName LastName = this.LastName
emailAddress = this.Email Email = this.Email
isAdmin = defaultArg this.IsAdmin false IsAdmin = defaultArg this.IsAdmin false
} }
|> function |> function
| u when isNull this.Password || this.Password = "" -> u | u when isNull this.Password || this.Password = "" -> u
| u -> { u with passwordHash = hasher this.Password } | u -> { u with PasswordHash = hasher this.Password }
/// 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 = Guid.Empty { UserId = emptyGuid
FirstName = "" FirstName = ""
LastName = "" LastName = ""
Email = "" Email = ""
@ -623,11 +618,11 @@ module EditUser =
/// 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
UserId = user.userId UserId = shortGuid user.Id.Value
FirstName = user.firstName FirstName = user.FirstName
LastName = user.lastName LastName = user.LastName
Email = user.emailAddress Email = user.Email
IsAdmin = if user.isAdmin then Some true else None IsAdmin = if user.IsAdmin then Some true else None
} }
@ -635,7 +630,7 @@ module EditUser =
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
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 : SmallGroupId SmallGroupId : string
/// The password entered /// The password entered
Password : string Password : string
@ -649,7 +644,7 @@ module GroupLogOn =
/// An empty instance /// An empty instance
let empty = let empty =
{ SmallGroupId = Guid.Empty { SmallGroupId = emptyGuid
Password = "" Password = ""
RememberMe = None RememberMe = None
} }
@ -714,7 +709,7 @@ type UserLogOn =
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 : SmallGroupId SmallGroupId : string
/// Whether to remember the login /// Whether to remember the login
RememberMe : bool option RememberMe : bool option
@ -730,7 +725,7 @@ module UserLogOn =
let empty = let empty =
{ Email = "" { Email = ""
Password = "" Password = ""
SmallGroupId = Guid.Empty SmallGroupId = emptyGuid
RememberMe = None RememberMe = None
RedirectUrl = None RedirectUrl = None
} }
@ -765,13 +760,13 @@ with
ReferenceList.requestTypeList s ReferenceList.requestTypeList s
|> List.map (fun (typ, name) -> |> List.map (fun (typ, name) ->
let sort = let sort =
match this.SmallGroup.preferences.requestSort with match this.SmallGroup.Preferences.RequestSort with
| SortByDate -> Seq.sortByDescending (fun req -> req.updatedDate) | SortByDate -> Seq.sortByDescending (fun req -> req.UpdatedDate)
| SortByRequestor -> Seq.sortBy (fun req -> req.requestor) | SortByRequestor -> Seq.sortBy (fun req -> req.Requestor)
let reqs = let reqs =
this.Requests this.Requests
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun req -> req.requestType = typ) |> Seq.filter (fun req -> req.RequestType = typ)
|> sort |> sort
|> List.ofSeq |> List.ofSeq
typ, name, reqs) typ, name, reqs)
@ -779,20 +774,20 @@ with
/// Is this request new? /// Is this request new?
member this.IsNew (req : PrayerRequest) = member this.IsNew (req : PrayerRequest) =
(this.Date - req.updatedDate).Days <= this.SmallGroup.preferences.daysToKeepNew (this.Date - req.UpdatedDate).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 prefs = this.SmallGroup.preferences let prefs = this.SmallGroup.Preferences
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2) let asOfSize = Math.Round (float prefs.TextFontSize * 0.8, 2)
[ if this.ShowHeader then [ if this.ShowHeader then
div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [ div [ _style $"text-align:center;font-family:{prefs.Fonts}" ] [
span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [ span [ _style $"font-size:%i{prefs.HeadingFontSize}pt;" ] [
strong [] [ str s["Prayer Requests"].Value ] strong [] [ str s["Prayer Requests"].Value ]
] ]
br [] br []
span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [ span [ _style $"font-size:%i{prefs.TextFontSize}pt;" ] [
strong [] [ str this.SmallGroup.name ] strong [] [ str this.SmallGroup.Name ]
br [] br []
str (this.Date.ToString s["MMMM d, yyyy"].Value) str (this.Date.ToString s["MMMM d, yyyy"].Value)
] ]
@ -800,9 +795,9 @@ with
br [] br []
for _, name, reqs in this.RequestsByType s do for _, name, reqs in this.RequestsByType s do
div [ _style "padding-left:10px;padding-bottom:.5em;" ] [ div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [ table [ _style $"font-family:{prefs.Fonts};page-break-inside:avoid;" ] [
tr [] [ tr [] [
td [ _style $"font-size:%i{prefs.headingFontSize}pt;color:{prefs.headingColor};padding:3px 0;border-top:solid 3px {prefs.lineColor};border-bottom:solid 3px {prefs.lineColor};font-weight:bold;" ] [ td [ _style $"font-size:%i{prefs.HeadingFontSize}pt;color:{prefs.HeadingColor};padding:3px 0;border-top:solid 3px {prefs.LineColor};border-bottom:solid 3px {prefs.LineColor};font-weight:bold;" ] [
rawText "&nbsp; &nbsp; "; str name.Value; rawText "&nbsp; &nbsp; " rawText "&nbsp; &nbsp; "; str name.Value; rawText "&nbsp; &nbsp; "
] ]
] ]
@ -811,22 +806,22 @@ with
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"
li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [ li [ _style $"list-style-type:{bullet};font-family:{prefs.Fonts};font-size:%i{prefs.TextFontSize}pt;padding-bottom:.25em;" ] [
match req.requestor with match req.Requestor with
| Some r when r <> "" -> | Some r when r <> "" ->
strong [] [ str r ] strong [] [ str r ]
rawText " &mdash; " rawText " &mdash; "
| Some _ -> () | Some _ -> ()
| None -> () | None -> ()
rawText req.text rawText req.Text
match prefs.asOfDateDisplay with match prefs.AsOfDateDisplay with
| NoDisplay -> () | NoDisplay -> ()
| ShortDate | ShortDate
| LongDate -> | LongDate ->
let dt = let dt =
match prefs.asOfDateDisplay with match prefs.AsOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.UpdatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.UpdatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
i [ _style $"font-size:%.2f{asOfSize}pt" ] [ i [ _style $"font-size:%.2f{asOfSize}pt" ] [
rawText "&nbsp; ("; str s["as of"].Value; str " "; str dt; rawText ")" rawText "&nbsp; ("; str s["as of"].Value; str " "; str dt; rawText ")"
@ -840,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) =
seq { seq {
this.SmallGroup.name this.SmallGroup.Name
s["Prayer Requests"].Value s["Prayer Requests"].Value
this.Date.ToString s["MMMM d, yyyy"].Value this.Date.ToString s["MMMM d, yyyy"].Value
" " " "
@ -851,17 +846,17 @@ with
dashes dashes
for req in reqs do for req in reqs do
let bullet = if this.IsNew req then "+" else "-" let bullet = if this.IsNew req then "+" else "-"
let requestor = match req.requestor with Some r -> $"{r} - " | None -> "" let requestor = match req.Requestor with Some r -> $"{r} - " | None -> ""
match this.SmallGroup.preferences.asOfDateDisplay with match this.SmallGroup.Preferences.AsOfDateDisplay with
| NoDisplay -> "" | NoDisplay -> ""
| _ -> | _ ->
let dt = let dt =
match this.SmallGroup.preferences.asOfDateDisplay with match this.SmallGroup.Preferences.AsOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.UpdatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.UpdatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
$""" ({s["as of"].Value} {dt})""" $""" ({s["as of"].Value} {dt})"""
|> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text) |> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.Text)
" " " "
} }
|> String.concat "\n" |> String.concat "\n"

32
src/PrayerTracker/Church.fs
View File

@ -1,24 +1,21 @@
module PrayerTracker.Handlers.Church module PrayerTracker.Handlers.Church
open System
open System.Threading.Tasks
open Giraffe open Giraffe
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
/// Find statistics for the given church /// Find statistics for the given church
let private findStats (db : AppDbContext) churchId = task { let private findStats (db : AppDbContext) churchId = task {
let! grps = db.CountGroupsByChurch churchId let! grps = db.CountGroupsByChurch churchId
let! reqs = db.CountRequestsByChurch churchId let! reqs = db.CountRequestsByChurch churchId
let! usrs = db.CountUsersByChurch churchId let! usrs = db.CountUsersByChurch churchId
return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs } return shortGuid churchId.Value, { SmallGroups = grps; PrayerRequests = reqs; Users = usrs }
} }
/// POST /church/[church-id]/delete /// POST /church/[church-id]/delete
let delete churchId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let churchId = ChurchId chId
match! ctx.db.TryChurchById churchId with match! ctx.db.TryChurchById churchId with
| Some church -> | Some church ->
let! _, stats = findStats ctx.db churchId let! _, stats = findStats ctx.db churchId
@ -27,11 +24,12 @@ let delete churchId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=>
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", s["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.name, stats.smallGroups, stats.prayerRequests, stats.users] church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users]
return! redirectTo false "/churches" next ctx return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
open System
/// GET /church/[church-id]/edit /// GET /church/[church-id]/edit
let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
@ -42,7 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|> Views.Church.edit EditChurch.empty ctx |> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
match! ctx.db.TryChurchById churchId with match! ctx.db.TryChurchById (ChurchId churchId) with
| Some church -> | Some church ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
@ -51,35 +49,35 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /churches /// GET /churches
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let await = Async.AwaitTask >> Async.RunSynchronously let await = Async.AwaitTask >> Async.RunSynchronously
let! churches = ctx.db.AllChurches () let! churches = ctx.db.AllChurches ()
let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId)) let stats = churches |> List.map (fun c -> await (findStats ctx.db c.Id))
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.maintain churches (stats |> Map.ofList) ctx |> Views.Church.maintain churches (stats |> Map.ofList) ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
open System.Threading.Tasks
/// POST /church/save /// POST /church/save
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m -> | Ok model ->
let! church = let! church =
if m.IsNew then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () }) if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
else ctx.db.TryChurchById m.ChurchId else ctx.db.TryChurchById (idFromShort ChurchId model.ChurchId)
match church with match church with
| Some ch -> | Some ch ->
m.PopulateChurch ch model.PopulateChurch ch
|> (if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry) |> (if model.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower () let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} church “{1}”", act, m.Name] addInfo ctx s["Successfully {0} church “{1}”", act, model.Name]
return! redirectTo false "/churches" next ctx return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx

17
src/PrayerTracker/CommonFunctions.fs
View File

@ -72,8 +72,8 @@ let viewInfo (ctx : HttpContext) startTicks =
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the // The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the
// user back in transparently using this cookie. Every request resets the timer. // user back in transparently using this cookie. Every request resets the timer.
let timeout = let timeout =
{ Id = u.userId { Id = u.Id.Value
GroupId = (currentGroup ctx).smallGroupId GroupId = (currentGroup ctx).Id.Value
Until = DateTime.UtcNow.AddHours(2.).Ticks Until = DateTime.UtcNow.AddHours(2.).Ticks
Password = "" Password = ""
} }
@ -163,6 +163,7 @@ type AccessLevel =
open Microsoft.AspNetCore.Http.Extensions open Microsoft.AspNetCore.Http.Extensions
open PrayerTracker.Entities
/// Require the given access role (also refreshes "Remember Me" user and group logons) /// Require the given access role (also refreshes "Remember Me" user and group logons)
let requireAccess level : HttpHandler = let requireAccess level : HttpHandler =
@ -177,11 +178,11 @@ let requireAccess level : HttpHandler =
try try
match TimeoutCookie.fromPayload ctx.Request.Cookies[Key.Cookie.timeout] with match TimeoutCookie.fromPayload ctx.Request.Cookies[Key.Cookie.timeout] with
| Some c when c.Password = saltedTimeoutHash c -> | Some c when c.Password = saltedTimeoutHash c ->
let! user = ctx.db.TryUserById c.Id let! user = ctx.db.TryUserById (UserId c.Id)
match user with match user with
| Some _ -> | Some _ ->
ctx.Session.user <- user ctx.Session.user <- user
let! grp = ctx.db.TryGroupById c.GroupId let! grp = ctx.db.TryGroupById (SmallGroupId c.GroupId)
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
| _ -> () | _ -> ()
| _ -> () | _ -> ()
@ -193,11 +194,11 @@ let requireAccess level : HttpHandler =
let logOnUserFromCookie (ctx : HttpContext) = task { let logOnUserFromCookie (ctx : HttpContext) = task {
match UserCookie.fromPayload ctx.Request.Cookies[Key.Cookie.user] with match UserCookie.fromPayload ctx.Request.Cookies[Key.Cookie.user] with
| Some c -> | Some c ->
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash let! user = ctx.db.TryUserLogOnByCookie (UserId c.Id) (SmallGroupId c.GroupId) c.PasswordHash
match user with match user with
| Some _ -> | Some _ ->
ctx.Session.user <- user ctx.Session.user <- user
let! grp = ctx.db.TryGroupById c.GroupId let! grp = ctx.db.TryGroupById (SmallGroupId c.GroupId)
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
// Rewrite the cookie to extend the expiration // Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh) ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
@ -213,7 +214,7 @@ let requireAccess level : HttpHandler =
let logOnGroupFromCookie (ctx : HttpContext) = task { let logOnGroupFromCookie (ctx : HttpContext) = task {
match GroupCookie.fromPayload ctx.Request.Cookies[Key.Cookie.group] with match GroupCookie.fromPayload ctx.Request.Cookies[Key.Cookie.group] with
| Some c -> | Some c ->
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash let! grp = ctx.db.TryGroupLogOnByCookie (SmallGroupId c.GroupId) c.PasswordHash sha1Hash
match grp with match grp with
| Some _ -> | Some _ ->
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
@ -236,7 +237,7 @@ let requireAccess level : HttpHandler =
| _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx | _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx | _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Admin && isUserLoggedOn ctx -> | _ when level |> List.contains Admin && isUserLoggedOn ctx ->
match (currentUser ctx).isAdmin with match (currentUser ctx).IsAdmin with
| true -> return! next ctx | true -> return! next ctx
| false -> | false ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()

12
src/PrayerTracker/Email.fs
View File

@ -22,9 +22,9 @@ let getConnection () = task {
/// Create a mail message object, filled with everything but the body content /// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj = let createMessage (grp : SmallGroup) subj =
let msg = new MimeMessage () let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress)) msg.From.Add (MailboxAddress (grp.Preferences.EmailFromName, fromAddress))
msg.Subject <- subj msg.Subject <- subj
msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress)) msg.ReplyTo.Add (MailboxAddress (grp.Preferences.EmailFromName, grp.Preferences.EmailFromAddress))
msg msg
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
@ -63,12 +63,8 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
use plainTextMsg = createTextMessage grp subj text s use plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do for mbr in recipients do
let emailType = let emailTo = MailboxAddress (mbr.Name, mbr.Email)
match mbr.format with match defaultArg mbr.Format grp.Preferences.DefaultEmailType with
| Some f -> EmailFormat.fromCode f
| None -> grp.preferences.defaultEmailType
let emailTo = MailboxAddress (mbr.memberName, mbr.email)
match emailType with
| HtmlFormat -> | HtmlFormat ->
htmlMsg.To.Add emailTo htmlMsg.To.Add emailTo
let! _ = client.SendAsync htmlMsg let! _ = client.SendAsync htmlMsg

52
src/PrayerTracker/PrayerRequest.fs
View File

@ -12,7 +12,7 @@ open PrayerTracker.ViewModels
/// Retrieve a prayer request, and ensure that it belongs to the current class /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = task { let private findRequest (ctx : HttpContext) reqId = task {
match! ctx.db.TryRequestById reqId with match! ctx.db.TryRequestById reqId with
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req | Some req when req.SmallGroupId = (currentGroup ctx).Id -> return Ok req
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s["The prayer request you tried to access is not assigned to your group"] addError ctx s["The prayer request you tried to access is not assigned to your group"]
@ -44,20 +44,21 @@ let private parseListDate (date : string option) =
/// GET /prayer-request/[request-id]/edit /// GET /prayer-request/[request-id]/edit
let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ()) let now = grp.localDateNow (ctx.GetService<IClock> ())
if reqId = Guid.Empty then let requestId = PrayerRequestId reqId
if requestId.Value = Guid.Empty then
return! return!
{ viewInfo ctx startTicks with Script = [ "ckeditor/ckeditor" ]; HelpLink = Some Help.editRequest } { viewInfo ctx startTicks with Script = [ "ckeditor/ckeditor" ]; HelpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
match! findRequest ctx reqId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
if req.isExpired now grp.preferences.daysToExpire then if req.isExpired now grp.Preferences.DaysToExpire then
{ UserMessage.warning with { UserMessage.warning with
Text = htmlLocString s["This request is expired."] Text = htmlLocString s["This request is expired."]
Description = Description =
@ -81,10 +82,10 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let listDate = parseListDate (Some date) let listDate = parseListDate (Some date)
let grp = currentGroup ctx let grp = currentGroup ctx
let! list = generateRequestList ctx listDate let! list = generateRequestList ctx listDate
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId let! recipients = ctx.db.AllMembersForSmallGroup grp.Id
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients do! Email.sendEmails client recipients
grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.Date].Value grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.Name, list.Date].Value
(list.AsHtml s) (list.AsText s) s (list.AsHtml s) (list.AsText s) s
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
@ -95,7 +96,8 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// POST /prayer-request/[request-id]/delete /// POST /prayer-request/[request-id]/delete
let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
match! findRequest ctx reqId with let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.db.PrayerRequests.Remove req |> ignore ctx.db.PrayerRequests.Remove req |> ignore
@ -108,10 +110,11 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun
/// GET /prayer-request/[request-id]/expire /// GET /prayer-request/[request-id]/expire
let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
match! findRequest ctx reqId with let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Forced } ctx.db.UpdateEntry { req with Expiration = Forced }
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()] addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
@ -123,7 +126,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp when grp.preferences.isPublic -> | Some grp when grp.Preferences.IsPublic ->
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let! reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0 let! reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0
return! return!
@ -203,10 +206,11 @@ let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx ->
/// GET /prayer-request/[request-id]/restore /// GET /prayer-request/[request-id]/restore
let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
match! findRequest ctx reqId with let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now } ctx.db.UpdateEntry { req with Expiration = Automatic; UpdatedDate = DateTime.Now }
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()] addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
@ -219,16 +223,16 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
match! ctx.TryBindFormAsync<EditRequest> () with match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m -> | Ok m ->
let! req = let! req =
if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with Id = (Guid.NewGuid >> PrayerRequestId) () })
else ctx.db.TryRequestById m.RequestId else ctx.db.TryRequestById (idFromShort PrayerRequestId m.RequestId)
match req with match req with
| Some pr -> | Some pr ->
let upd8 = let upd8 =
{ pr with { pr with
requestType = PrayerRequestType.fromCode m.RequestType RequestType = PrayerRequestType.fromCode m.RequestType
requestor = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x Requestor = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x
text = ckEditorToText m.Text Text = ckEditorToText m.Text
expiration = Expiration.fromCode m.Expiration Expiration = Expiration.fromCode m.Expiration
} }
let grp = currentGroup ctx let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ()) let now = grp.localDateNow (ctx.GetService<IClock> ())
@ -236,13 +240,13 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
| true -> | true ->
let dt = defaultArg m.EnteredDate now let dt = defaultArg m.EnteredDate now
{ upd8 with { upd8 with
smallGroupId = grp.smallGroupId SmallGroupId = grp.Id
userId = (currentUser ctx).userId UserId = (currentUser ctx).Id
enteredDate = dt EnteredDate = dt
updatedDate = dt UpdatedDate = dt
} }
| false when defaultArg m.SkipDateUpdate false -> upd8 | false when defaultArg m.SkipDateUpdate false -> upd8
| false -> { upd8 with updatedDate = now } | false -> { upd8 with UpdatedDate = now }
|> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()

130
src/PrayerTracker/SmallGroup.fs
View File

@ -1,34 +1,29 @@
module PrayerTracker.Handlers.SmallGroup module PrayerTracker.Handlers.SmallGroup
open System
open Giraffe open Giraffe
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Cookies open PrayerTracker.Cookies
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
open System
open System.Threading.Tasks
/// Set a small group "Remember Me" cookie /// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash = let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), (Key.Cookie.group, { GroupId = (currentGroup ctx).Id.Value; PasswordHash = pwHash }.toPayload (),
autoRefresh) autoRefresh)
/// GET /small-group/announcement /// GET /small-group/announcement
let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx -> let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.sendAnnouncement; Script = [ "ckeditor/ckeditor" ] } { viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.sendAnnouncement; Script = [ "ckeditor/ckeditor" ] }
|> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx |> Views.SmallGroup.announcement (currentUser ctx).IsAdmin ctx
|> renderHtml next ctx |> renderHtml next ctx
/// POST /small-group/[group-id]/delete /// POST /small-group/[group-id]/delete
let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let groupId = SmallGroupId grpId
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp -> | Some grp ->
let! reqs = ctx.db.CountRequestsBySmallGroup groupId let! reqs = ctx.db.CountRequestsBySmallGroup groupId
@ -37,31 +32,31 @@ let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=>
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, users] grp.Name, reqs, users]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// POST /small-group/member/[member-id]/delete /// POST /small-group/member/[member-id]/delete
let deleteMember memberId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let memberId = MemberId mbrId
match! ctx.db.TryMemberById memberId with match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId -> | Some mbr when mbr.SmallGroupId = (currentGroup ctx).Id ->
ctx.db.RemoveEntry mbr ctx.db.RemoveEntry mbr
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addHtmlInfo ctx s["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName] addHtmlInfo ctx s["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/[group-id]/edit /// GET /small-group/[group-id]/edit
let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! churches = ctx.db.AllChurches () let! churches = ctx.db.AllChurches ()
if groupId = Guid.Empty then let groupId = SmallGroupId grpId
if groupId.Value = Guid.Empty then
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
@ -76,21 +71,21 @@ let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fu
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/member/[member-id]/edit /// GET /small-group/member/[member-id]/edit
let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx let grp = currentGroup ctx
let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s
if memberId = Guid.Empty then let memberId = MemberId mbrId
if memberId.Value = Guid.Empty then
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty types ctx |> Views.SmallGroup.editMember EditMember.empty types ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
match! ctx.db.TryMemberById memberId with match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.SmallGroupId = grp.Id ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
@ -99,25 +94,23 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=>
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/log-on/[group-id?] /// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! groups = ctx.db.ProtectedGroups () let! groups = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> "" let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
return! return!
{ viewInfo ctx startTicks with HelpLink = Some Help.logOn } { viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|> Views.SmallGroup.logOn groups grpId ctx |> Views.SmallGroup.logOn groups groupId ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// POST /small-group/log-on/submit /// POST /small-group/log-on/submit
let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<GroupLogOn> () with match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupLogOnByPassword m.SmallGroupId m.Password with match! ctx.db.TryGroupLogOnByPassword (idFromShort SmallGroupId m.SmallGroupId) m.Password with
| Some grp -> | Some grp ->
ctx.Session.smallGroup <- Some grp ctx.Session.smallGroup <- Some grp
if defaultArg m.RememberMe false then (setGroupCookie ctx << sha1Hash) m.Password if defaultArg m.RememberMe false then (setGroupCookie ctx << sha1Hash) m.Password
@ -125,11 +118,10 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
return! redirectTo false "/prayer-requests/view" next ctx return! redirectTo false "/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s["Password incorrect - login unsuccessful"] addError ctx s["Password incorrect - login unsuccessful"]
return! redirectTo false $"/small-group/log-on/{flatGuid m.SmallGroupId}" next ctx return! redirectTo false $"/small-group/log-on/{m.SmallGroupId}" next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /small-groups /// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
@ -140,28 +132,28 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/members /// GET /small-group/members
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! members = ctx.db.AllMembersForSmallGroup grp.smallGroupId let! members = ctx.db.AllMembersForSmallGroup grp.Id
let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s |> Map.ofSeq
return! return!
{ viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers } { viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members members types ctx |> Views.SmallGroup.members members types ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
open NodaTime
/// GET /small-group /// GET /small-group
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let! reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 let! reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).Id
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).Id
let m = let m =
{ TotalActiveReqs = List.length reqs { TotalActiveReqs = List.length reqs
AllReqs = reqCount AllReqs = reqCount
@ -169,9 +161,9 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
ActiveReqsByType = ActiveReqsByType =
(reqs (reqs
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun req -> req.requestType) |> Seq.map (fun req -> req.RequestType)
|> Seq.distinct |> Seq.distinct
|> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.requestType = reqType) |> List.length) |> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length)
|> Map.ofSeq) |> Map.ofSeq)
} }
return! return!
@ -180,17 +172,17 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/preferences /// GET /small-group/preferences
let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! tzs = ctx.db.AllTimeZones () let! tzs = ctx.db.AllTimeZones ()
return! return!
{ viewInfo ctx startTicks with HelpLink = Some Help.groupPreferences } { viewInfo ctx startTicks with HelpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx |> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).Preferences) tzs ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
open System.Threading.Tasks
/// POST /small-group/save /// POST /small-group/save
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
@ -198,15 +190,15 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! group = let! group =
if m.IsNew then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
else ctx.db.TryGroupById m.SmallGroupId else ctx.db.TryGroupById (idFromShort SmallGroupId m.SmallGroupId)
match group with match group with
| Some grp -> | Some grp ->
m.populateGroup grp m.populateGroup grp
|> function |> function
| grp when m.IsNew -> | grp when m.IsNew ->
ctx.db.AddEntry grp ctx.db.AddEntry grp
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId } ctx.db.AddEntry { grp.Preferences with SmallGroupId = grp.Id }
| grp -> ctx.db.UpdateEntry grp | grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower () let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
@ -216,27 +208,26 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// POST /small-group/member/save /// POST /small-group/member/save
let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditMember> () with match! ctx.TryBindFormAsync<EditMember> () with
| Ok m -> | Ok model ->
let grp = currentGroup ctx let grp = currentGroup ctx
let! mMbr = let! mMbr =
if m.IsNew then if model.IsNew then
Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId }) Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = grp.Id })
else ctx.db.TryMemberById m.MemberId else ctx.db.TryMemberById (idFromShort MemberId model.MemberId)
match mMbr with match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.SmallGroupId = grp.Id ->
{ mbr with { mbr with
memberName = m.Name Name = model.Name
email = m.Email Email = model.Email
format = match m.Format with "" | null -> None | _ -> Some m.Format Format = match model.Format with "" | null -> None | _ -> Some (EmailFormat.fromCode model.Format)
} }
|> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry |> if model.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower () let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act] addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/small-group/members" next ctx
| Some _ | Some _
@ -244,7 +235,6 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// POST /small-group/preferences/save /// POST /small-group/preferences/save
let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditPreferences> () with match! ctx.TryBindFormAsync<EditPreferences> () with
@ -252,13 +242,13 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works, // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works,
// we can repopulate the session instance. That way, if the update fails, the page should still show the // we can repopulate the session instance. That way, if the update fails, the page should still show the
// database values, not the then out-of-sync session ones. // database values, not the then out-of-sync session ones.
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with match! ctx.db.TryGroupById (currentGroup ctx).Id with
| Some grp -> | Some grp ->
let prefs = m.PopulatePreferences grp.preferences let prefs = m.PopulatePreferences grp.Preferences
ctx.db.UpdateEntry prefs ctx.db.UpdateEntry prefs
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
// Refresh session instance // Refresh session instance
ctx.Session.smallGroup <- Some { grp with preferences = prefs } ctx.Session.smallGroup <- Some { grp with Preferences = prefs }
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s["Group preferences updated successfully"] addInfo ctx s["Group preferences updated successfully"]
return! redirectTo false "/small-group/preferences" next ctx return! redirectTo false "/small-group/preferences" next ctx
@ -266,6 +256,8 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
open Giraffe.ViewEngine
open PrayerTracker.Views.CommonFunctions
/// POST /small-group/announcement/send /// POST /small-group/announcement/send
let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
@ -279,18 +271,18 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
// Reformat the text to use the class's font stylings // Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.Text let requestText = ckEditorToText m.Text
let htmlText = let htmlText =
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ] p [ _style $"font-family:{grp.Preferences.Fonts};font-size:%d{grp.Preferences.TextFontSize}pt;" ]
[ rawText requestText ] [ rawText requestText ]
|> renderHtmlNode |> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails // Send the e-mails
let! recipients = let! recipients =
match m.SendToClass with match m.SendToClass with
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers () | "N" when usr.IsAdmin -> ctx.db.AllUsersAsMembers ()
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId | _ -> ctx.db.AllMembersForSmallGroup grp.Id
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients grp do! Email.sendEmails client recipients grp
s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.name, now.Date, s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.Name, now.Date,
(now.ToString "h:mm tt").ToLower ()].Value (now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s htmlText plainText s
// Add to the request list if desired // Add to the request list if desired
@ -300,13 +292,13 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
| _, Some x when not x -> () | _, Some x when not x -> ()
| _, _ -> | _, _ ->
{ PrayerRequest.empty with { PrayerRequest.empty with
prayerRequestId = Guid.NewGuid () Id = (Guid.NewGuid >> PrayerRequestId) ()
smallGroupId = grp.smallGroupId SmallGroupId = grp.Id
userId = usr.userId UserId = usr.Id
requestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType RequestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType
text = requestText Text = requestText
enteredDate = now EnteredDate = now
updatedDate = now UpdatedDate = now
} }
|> ctx.db.AddEntry |> ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()

107
src/PrayerTracker/User.fs
View File

@ -1,47 +1,45 @@
module PrayerTracker.Handlers.User module PrayerTracker.Handlers.User
open System
open System.Collections.Generic
open System.Net
open System.Threading.Tasks
open Giraffe open Giraffe
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open PrayerTracker open PrayerTracker
open PrayerTracker.Cookies open PrayerTracker.Cookies
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions
/// Set the user's "remember me" cookie /// Set the user's "remember me" cookie
let private setUserCookie (ctx : HttpContext) pwHash = let private setUserCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ( ctx.Response.Cookies.Append (
Key.Cookie.user, Key.Cookie.user,
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), { Id = (currentUser ctx).Id.Value; GroupId = (currentGroup ctx).Id.Value; PasswordHash = pwHash }.toPayload (),
autoRefresh) autoRefresh)
open System
open System.Collections.Generic
/// Retrieve a user from the database by password /// Retrieve a user from the database by password
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does // If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
let private findUserByPassword m (db : AppDbContext) = task { let private findUserByPassword model (db : AppDbContext) = task {
match! db.TryUserByEmailAndGroup m.Email m.SmallGroupId with match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
| Some u when Option.isSome u.salt -> | Some u when Option.isSome u.Salt ->
// Already upgraded; match = success // Already upgraded; match = success
let pwHash = pbkdf2Hash (Option.get u.salt) m.Password let pwHash = pbkdf2Hash (Option.get u.Salt) model.Password
if u.passwordHash = pwHash then if u.PasswordHash = pwHash then
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }, pwHash
else return None, "" else return None, ""
| Some u when u.passwordHash = sha1Hash m.Password -> | Some u when u.PasswordHash = sha1Hash model.Password ->
// Not upgraded, but password is good; upgrade 'em! // Not upgraded, but password is good; upgrade 'em!
// Upgrade 'em! // Upgrade 'em!
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.Password let pwHash = pbkdf2Hash salt model.Password
let upgraded = { u with salt = Some salt; passwordHash = pwHash } let upgraded = { u with Salt = Some salt; PasswordHash = pwHash }
db.UpdateEntry upgraded db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
} }
open System.Threading.Tasks
/// POST /user/password/change /// POST /user/password/change
let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
@ -49,13 +47,13 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let curUsr = currentUser ctx let curUsr = currentUser ctx
let! dbUsr = ctx.db.TryUserById curUsr.userId let! dbUsr = ctx.db.TryUserById curUsr.Id
let! user = let! user =
match dbUsr with match dbUsr with
| Some usr -> | Some usr ->
// Check the old password against a possibly non-salted hash // Check the old password against a possibly non-salted hash
(match usr.salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.OldPassword (match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.OldPassword
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId |> ctx.db.TryUserLogOnByCookie curUsr.Id (currentGroup ctx).Id
| _ -> Task.FromResult None | _ -> Task.FromResult None
match user with match user with
| Some _ when m.NewPassword = m.NewPasswordConfirm -> | Some _ when m.NewPassword = m.NewPasswordConfirm ->
@ -63,10 +61,10 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
| Some usr -> | Some usr ->
// Generate new salt whenever the password is changed // Generate new salt whenever the password is changed
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.NewPassword; salt = Some salt } ctx.db.UpdateEntry { usr with PasswordHash = pbkdf2Hash salt m.NewPassword; Salt = Some salt }
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
// If the user is remembered, update the cookie with the new hash // If the user is remembered, update the cookie with the new hash
if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.passwordHash if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.PasswordHash
addInfo ctx s["Your password was changed successfully"] addInfo ctx s["Your password was changed successfully"]
| None -> addError ctx s["Unable to change password"] | None -> addError ctx s["Unable to change password"]
return! redirectTo false "/" next ctx return! redirectTo false "/" next ctx
@ -79,9 +77,9 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// POST /user/[user-id]/delete /// POST /user/[user-id]/delete
let delete userId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let userId = UserId usrId
match! ctx.db.TryUserById userId with match! ctx.db.TryUserById userId with
| Some user -> | Some user ->
ctx.db.RemoveEntry user ctx.db.RemoveEntry user
@ -92,33 +90,36 @@ let delete userId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> f
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
open System.Net
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 m -> | Ok model ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! usr, pwHash = findUserByPassword m ctx.db let! usr, pwHash = findUserByPassword model ctx.db
let! grp = ctx.db.TryGroupById m.SmallGroupId let! grp = ctx.db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId)
let nextUrl = let nextUrl =
match usr with match usr with
| Some _ -> | Some _ ->
ctx.Session.user <- usr ctx.Session.user <- usr
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
if defaultArg m.RememberMe false then setUserCookie ctx pwHash if defaultArg model.RememberMe false then setUserCookie ctx pwHash
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
match m.RedirectUrl with match model.RedirectUrl with
| None -> "/small-group" | None -> "/small-group"
// TODO: ensure "x" is a local URL
| Some x when x = "" -> "/small-group" | Some x when x = "" -> "/small-group"
| Some x -> x | Some x -> x
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" let grpName = match grp with Some g -> g.Name | _ -> "N/A"
{ UserMessage.error with { UserMessage.error with
Text = htmlLocString s["Invalid credentials - log on unsuccessful"] Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
Description = Description =
[ s["This is likely due to one of the following reasons"].Value [ s["This is likely due to one of the following reasons"].Value
":<ul><li>" ":<ul><li>"
s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.Email].Value s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value
"</li><li>" "</li><li>"
s["The password entered does not match the password for the given e-mail address."].Value s["The password entered does not match the password for the given e-mail address."].Value
"</li><li>" "</li><li>"
@ -137,9 +138,10 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
/// GET /user/[user-id]/edit /// GET /user/[user-id]/edit
let edit (userId : UserId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
if userId = Guid.Empty then let userId = UserId usrId
if userId.Value = Guid.Empty then
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
@ -196,22 +198,22 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
| Ok m -> | Ok m ->
let! user = let! user =
if m.IsNew then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
else ctx.db.TryUserById m.UserId else ctx.db.TryUserById (idFromShort UserId m.UserId)
let saltedUser = let saltedUser =
match user with match user with
| Some u -> | Some u ->
match u.salt with match u.Salt with
| None when m.Password <> "" -> | None when m.Password <> "" ->
// Generate salt so that a new password hash can be generated // Generate salt so that a new password hash can be generated
Some { u with salt = Some (Guid.NewGuid ()) } Some { u with Salt = Some (Guid.NewGuid ()) }
| _ -> | _ ->
// Leave the user with no salt, so prior hash can be validated/upgraded // Leave the user with no salt, so prior hash can be validated/upgraded
user user
| _ -> user | _ -> user
match saltedUser with match saltedUser with
| Some u -> | Some u ->
let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.Salt))
updatedUser |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry updatedUser |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -225,7 +227,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
return! redirectTo false $"/user/{flatGuid u.userId}/small-groups" next ctx return! redirectTo false $"/user/{shortGuid u.Id.Value}/small-groups" next ctx
else else
addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()] addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
return! redirectTo false "/users" next ctx return! redirectTo false "/users" next ctx
@ -237,30 +239,30 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
/// POST /user/small-groups/save /// POST /user/small-groups/save
let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m -> | Ok model ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.SmallGroups with match Seq.length model.SmallGroups with
| 0 -> | 0 ->
addError ctx s["You must select at least one group to assign"] addError ctx s["You must select at least one group to assign"]
return! redirectTo false $"/user/{flatGuid m.UserId}/small-groups" next ctx return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx
| _ -> | _ ->
match! ctx.db.TryUserByIdWithGroups m.UserId with match! ctx.db.TryUserByIdWithGroups (idFromShort UserId model.UserId) with
| Some user -> | Some user ->
let groups = let groups =
m.SmallGroups.Split ',' model.SmallGroups.Split ','
|> Array.map Guid.Parse |> Array.map (idFromShort SmallGroupId)
|> List.ofArray |> List.ofArray
user.smallGroups user.SmallGroups
|> Seq.filter (fun x -> not (groups |> List.exists (fun y -> y = x.smallGroupId))) |> Seq.filter (fun x -> not (groups |> List.exists (fun y -> y = x.SmallGroupId)))
|> ctx.db.UserGroupXref.RemoveRange |> ctx.db.UserGroupXref.RemoveRange
groups groups
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) |> Seq.filter (fun x -> not (user.SmallGroups |> Seq.exists (fun y -> y.SmallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x }) |> Seq.map (fun x -> { UserSmallGroup.empty with UserId = user.Id; SmallGroupId = x })
|> List.ofSeq |> List.ofSeq
|> List.iter ctx.db.AddEntry |> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully updated group permissions for {0}", m.UserName] addInfo ctx s["Successfully updated group permissions for {0}", model.UserName]
return! redirectTo false "/users" next ctx return! redirectTo false "/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
| Result.Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
@ -268,12 +270,13 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
/// GET /user/[user-id]/small-groups /// GET /user/[user-id]/small-groups
let smallGroups userId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let userId = UserId usrId
match! ctx.db.TryUserByIdWithGroups userId with match! ctx.db.TryUserByIdWithGroups userId with
| Some user -> | Some user ->
let! groups = ctx.db.GroupList () let! groups = ctx.db.GroupList ()
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq let curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx