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

Fix casing on view models

Browse Source 
- Light renaming / clean-up
- Update dependencies
This commit is contained in:
Daniel J. Summers 2022-07-13 18:26:19 -04:00
parent 47fb9884f1
commit e1bdad15f7
27 changed files with 1903 additions and 1734 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Directory.Build.props
View File

@ -1,9 +1,11 @@
<Project>
<PropertyGroup>
<AssemblyVersion>7.6.0.0</AssemblyVersion>
<FileVersion>7.6.0.0</FileVersion>
<TargetFramework>net6.0</TargetFramework>
<AssemblyVersion>8.0.0.0</AssemblyVersion>
<FileVersion>8.0.0.0</FileVersion>
<Authors>danieljsummers</Authors>
<Company>Bit Badger Solutions</Company>
<Version>7.6.0</Version>
<Version>8.0.0</Version>
<DebugType>Embedded</DebugType>
</PropertyGroup>
</Project>

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

@ -20,10 +20,11 @@ module private Helpers =
.ThenByDescending (fun req -> req.enteredDate)
/// Paginate a prayer request query
let paginate pageNbr pageSize (q : IQueryable<PrayerRequest>) =
q.Skip((pageNbr - 1) * pageSize).Take pageSize
let paginate (pageNbr : int) pageSize (q : IQueryable<PrayerRequest>) =
if pageNbr > 0 then q.Skip((pageNbr - 1) * pageSize).Take pageSize else q
open System
open System.Collections.Generic
open Microsoft.EntityFrameworkCore
open Microsoft.FSharpLu
@ -95,7 +96,7 @@ type AppDbContext with
this.PrayerRequests.Where(fun req -> req.smallGroupId = grp.smallGroupId)
|> function
| q when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
let asOf = DateTime (theDate.AddDays(-(float grp.preferences.daysToExpire)).Date.Ticks, DateTimeKind.Utc)
q.Where(fun req ->
( req.updatedDate > asOf
|| req.expiration = Manual

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

@ -642,18 +642,25 @@ with
and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
{ /// The Id of this small group
smallGroupId : SmallGroupId
/// The church to which this group belongs
churchId : ChurchId
/// The name of the group
name : string
/// The church to which this small group belongs
church : Church
/// The preferences for the request list
preferences : ListPreferences
/// The members of the group
members : ICollection<Member>
/// Prayer requests for this small group
prayerRequests : ICollection<PrayerRequest>
/// The users authorized to manage this group
users : ICollection<UserSmallGroup>
}
@ -699,10 +706,13 @@ with
and [<CLIMutable; NoComparison; NoEquality>] TimeZone =
{ /// The Id for this time zone (uses tzdata names)
timeZoneId : TimeZoneId
/// The description of this time zone
description : string
/// The order in which this timezone should be displayed
sortOrder : int
/// Whether this timezone is active
isActive : bool
}
@ -731,18 +741,25 @@ with
and [<CLIMutable; NoComparison; NoEquality>] User =
{ /// The Id of this user
userId : UserId
/// The first name of this user
firstName : string
/// The last name of this user
lastName : string
/// The e-mail address of the user
emailAddress : string
/// Whether this user is a PrayerTracker system administrator
isAdmin : bool
/// The user's hashed password
passwordHash : string
/// The salt for the user's hashed password
salt : Guid option
/// The small groups which this user is authorized
smallGroups : ICollection<UserSmallGroup>
}
@ -785,10 +802,13 @@ with
and [<CLIMutable; NoComparison; NoEquality>] UserSmallGroup =
{ /// The Id of the user who has access to the small group
userId : UserId
/// The Id of the small group to which the user has access
smallGroupId : SmallGroupId
/// The user who has access to the small group
user : User
/// The small group to which the user has access
smallGroup : SmallGroup
}

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

@ -15,8 +15,9 @@
<ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
<PackageReference Include="NodaTime" Version="3.0.5" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
<PackageReference Include="NodaTime" Version="3.1.0" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.5" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
</Project>

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

@ -7,356 +7,369 @@ open System
[<Tests>]
let asOfDateDisplayTests =
testList "AsOfDateDisplay" [
test "NoDisplay code is correct" {
Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\""
}
test "ShortDate code is correct" {
Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\""
}
test "LongDate code is correct" {
Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\""
}
test "fromCode N should return NoDisplay" {
Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay"
}
test "fromCode S should return ShortDate" {
Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate"
}
test "fromCode L should return LongDate" {
Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate"
}
test "fromCode X should raise" {
Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore)
"An unknown code should have raised an exception"
}
testList "AsOfDateDisplay" [
test "NoDisplay code is correct" {
Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\""
}
test "ShortDate code is correct" {
Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\""
}
test "LongDate code is correct" {
Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\""
}
test "fromCode N should return NoDisplay" {
Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay"
}
test "fromCode S should return ShortDate" {
Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate"
}
test "fromCode L should return LongDate" {
Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate"
}
test "fromCode X should raise" {
Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let churchTests =
testList "Church" [
test "empty is as expected" {
let mt = Church.empty
Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.name "" "The name 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.isFalse mt.hasInterface "The church should not show that it has an interface"
Expect.isNone mt.interfaceAddress "The interface address should not exist"
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"
}
testList "Church" [
test "empty is as expected" {
let mt = Church.empty
Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID"
Expect.equal mt.name "" "The name 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.isFalse mt.hasInterface "The church should not show that it has an interface"
Expect.isNone mt.interfaceAddress "The interface address should not exist"
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"
}
]
[<Tests>]
let emailFormatTests =
testList "EmailFormat" [
test "HtmlFormat code is correct" {
Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\""
}
test "PlainTextFormat code is correct" {
Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\""
}
test "fromCode H should return HtmlFormat" {
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
}
test "fromCode P should return ShortDate" {
Expect.equal (EmailFormat.fromCode "P") PlainTextFormat "\"P\" should have been converted to PlainTextFormat"
}
test "fromCode Z should raise" {
Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore) "An unknown code should have raised an exception"
}
testList "EmailFormat" [
test "HtmlFormat code is correct" {
Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\""
}
test "PlainTextFormat code is correct" {
Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\""
}
test "fromCode H should return HtmlFormat" {
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
}
test "fromCode P should return ShortDate" {
Expect.equal (EmailFormat.fromCode "P") PlainTextFormat
"\"P\" should have been converted to PlainTextFormat"
}
test "fromCode Z should raise" {
Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let expirationTests =
testList "Expiration" [
test "Automatic code is correct" {
Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\""
}
test "Manual code is correct" {
Expect.equal Manual.code "M" "The code for Manual should have been \"M\""
}
test "Forced code is correct" {
Expect.equal Forced.code "F" "The code for Forced should have been \"F\""
}
test "fromCode A should return Automatic" {
Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic"
}
test "fromCode M should return Manual" {
Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual"
}
test "fromCode F should return Forced" {
Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced"
}
test "fromCode V should raise" {
Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) "An unknown code should have raised an exception"
}
testList "Expiration" [
test "Automatic code is correct" {
Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\""
}
test "Manual code is correct" {
Expect.equal Manual.code "M" "The code for Manual should have been \"M\""
}
test "Forced code is correct" {
Expect.equal Forced.code "F" "The code for Forced should have been \"F\""
}
test "fromCode A should return Automatic" {
Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic"
}
test "fromCode M should return Manual" {
Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual"
}
test "fromCode F should return Forced" {
Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced"
}
test "fromCode V should raise" {
Expect.throws (fun () -> Expiration.fromCode "V" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let listPreferencesTests =
testList "ListPreferences" [
test "empty is as expected" {
let mt = ListPreferences.empty
Expect.equal mt.smallGroupId 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.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.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker"
Expect.equal mt.emailFromAddress "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" "The default list fonts were incorrect"
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.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.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.defaultEmailType HtmlFormat "The default e-mail type should have been HTML"
Expect.isFalse mt.isPublic "The isPublic flag should not have been set"
Expect.equal mt.timeZoneId "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 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"
}
testList "ListPreferences" [
test "empty is as expected" {
let mt = ListPreferences.empty
Expect.equal mt.smallGroupId 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.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.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker"
Expect.equal mt.emailFromAddress "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"
"The default list fonts were incorrect"
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.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.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.defaultEmailType HtmlFormat "The default e-mail type should have been HTML"
Expect.isFalse mt.isPublic "The isPublic flag should not have been set"
Expect.equal mt.timeZoneId "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 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"
}
]
[<Tests>]
let memberTests =
testList "Member" [
test "empty is as expected" {
let mt = Member.empty
Expect.equal mt.memberId 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.memberName "" "The member name 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.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
testList "Member" [
test "empty is as expected" {
let mt = Member.empty
Expect.equal mt.memberId 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.memberName "" "The member name 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.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
]
[<Tests>]
let prayerRequestTests =
testList "PrayerRequest" [
test "empty is as expected" {
let mt = PrayerRequest.empty
Expect.equal mt.prayerRequestId 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.userId 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.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.isNone mt.requestor "The requestor should not exist"
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.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.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
test "isExpired always returns false for expecting requests" {
let req = { PrayerRequest.empty with requestType = Expecting }
Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired"
}
test "isExpired always returns false for manually-expired requests" {
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"
}
test "isExpired always returns false for long term/recurring requests" {
let req = { PrayerRequest.empty with requestType = LongTermRequest }
Expect.isFalse (req.isExpired DateTime.Now 0) "A recurring/long-term request should never be considered expired"
}
test "isExpired always returns true for force-expired requests" {
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"
}
test "isExpired returns false for non-expired requests" {
let now = DateTime.Now
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"
}
test "isExpired returns true for expired requests" {
let now = DateTime.Now
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"
}
test "isExpired returns true for same-day expired requests" {
let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. }
Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired"
}
test "updateRequired returns false for expired requests" {
let req = { PrayerRequest.empty with expiration = Forced }
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" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = LongTermRequest
updatedDate = now.AddDays -14.
}
Expect.isFalse (req.updateRequired now 7 4)
"An active request updated 14 days ago should not require an update until 28 days"
}
test "updateRequired returns true when an update is required for an active request" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = LongTermRequest
updatedDate = now.AddDays -34.
}
Expect.isTrue (req.updateRequired now 7 4)
"An active request updated 34 days ago should require an update (past 28 days)"
}
testList "PrayerRequest" [
test "empty is as expected" {
let mt = PrayerRequest.empty
Expect.equal mt.prayerRequestId 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.userId 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.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.isNone mt.requestor "The requestor should not exist"
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.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.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
test "isExpired always returns false for expecting requests" {
let req = { PrayerRequest.empty with requestType = Expecting }
Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired"
}
test "isExpired always returns false for manually-expired requests" {
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"
}
test "isExpired always returns false for long term/recurring requests" {
let req = { PrayerRequest.empty with requestType = LongTermRequest }
Expect.isFalse (req.isExpired DateTime.Now 0)
"A recurring/long-term request should never be considered expired"
}
test "isExpired always returns true for force-expired requests" {
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"
}
test "isExpired returns false for non-expired requests" {
let now = DateTime.Now
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"
}
test "isExpired returns true for expired requests" {
let now = DateTime.Now
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"
}
test "isExpired returns true for same-day expired requests" {
let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. }
Expect.isTrue (req.isExpired now 7)
"A request entered a second before midnight should be considered expired"
}
test "updateRequired returns false for expired requests" {
let req = { PrayerRequest.empty with expiration = Forced }
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" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = LongTermRequest
updatedDate = now.AddDays -14.
}
Expect.isFalse (req.updateRequired now 7 4)
"An active request updated 14 days ago should not require an update until 28 days"
}
test "updateRequired returns true when an update is required for an active request" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = LongTermRequest
updatedDate = now.AddDays -34.
}
Expect.isTrue (req.updateRequired now 7 4)
"An active request updated 34 days ago should require an update (past 28 days)"
}
]
[<Tests>]
let prayerRequestTypeTests =
testList "PrayerRequestType" [
test "CurrentRequest code is correct" {
Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\""
}
test "LongTermRequest code is correct" {
Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\""
}
test "PraiseReport code is correct" {
Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\""
}
test "Expecting code is correct" {
Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\""
}
test "Announcement code is correct" {
Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\""
}
test "fromCode C should return CurrentRequest" {
Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest
"\"C\" should have been converted to CurrentRequest"
}
test "fromCode L should return LongTermRequest" {
Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest
"\"L\" should have been converted to LongTermRequest"
}
test "fromCode P should return PraiseReport" {
Expect.equal (PrayerRequestType.fromCode "P") PraiseReport "\"P\" should have been converted to PraiseReport"
}
test "fromCode E should return Expecting" {
Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting"
}
test "fromCode A should return Announcement" {
Expect.equal (PrayerRequestType.fromCode "A") Announcement "\"A\" should have been converted to Announcement"
}
test "fromCode R should raise" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore)
"An unknown code should have raised an exception"
}
testList "PrayerRequestType" [
test "CurrentRequest code is correct" {
Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\""
}
test "LongTermRequest code is correct" {
Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\""
}
test "PraiseReport code is correct" {
Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\""
}
test "Expecting code is correct" {
Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\""
}
test "Announcement code is correct" {
Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\""
}
test "fromCode C should return CurrentRequest" {
Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest
"\"C\" should have been converted to CurrentRequest"
}
test "fromCode L should return LongTermRequest" {
Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest
"\"L\" should have been converted to LongTermRequest"
}
test "fromCode P should return PraiseReport" {
Expect.equal (PrayerRequestType.fromCode "P") PraiseReport
"\"P\" should have been converted to PraiseReport"
}
test "fromCode E should return Expecting" {
Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting"
}
test "fromCode A should return Announcement" {
Expect.equal (PrayerRequestType.fromCode "A") Announcement
"\"A\" should have been converted to Announcement"
}
test "fromCode R should raise" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let requestSortTests =
testList "RequestSort" [
test "SortByDate code is correct" {
Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\""
}
test "SortByRequestor code is correct" {
Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\""
}
test "fromCode D should return SortByDate" {
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
}
test "fromCode R should return SortByRequestor" {
Expect.equal (RequestSort.fromCode "R") SortByRequestor "\"R\" should have been converted to SortByRequestor"
}
test "fromCode Q should raise" {
Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore) "An unknown code should have raised an exception"
}
testList "RequestSort" [
test "SortByDate code is correct" {
Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\""
}
test "SortByRequestor code is correct" {
Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\""
}
test "fromCode D should return SortByDate" {
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
}
test "fromCode R should return SortByRequestor" {
Expect.equal (RequestSort.fromCode "R") SortByRequestor
"\"R\" should have been converted to SortByRequestor"
}
test "fromCode Q should raise" {
Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let smallGroupTests =
testList "SmallGroup" [
let now = DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc)
let withFakeClock f () =
FakeClock (Instant.FromDateTimeUtc now) |> f
yield test "empty is as expected" {
let mt = SmallGroup.empty
Expect.equal mt.smallGroupId 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.name "" "The name should have been blank"
Expect.equal mt.church.churchId Guid.Empty "The church should have been an empty one"
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.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.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"
}
yield! testFixture withFakeClock [
"localTimeNow adjusts the time ahead of UTC",
fun clock ->
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" } }
Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours"
"localTimeNow adjusts the time behind UTC",
fun clock ->
Expect.isLessThan (SmallGroup.empty.localTimeNow clock) now
"UTC to America/Denver should have subtracted hours"
"localTimeNow returns UTC when the time zone is invalid",
fun clock ->
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "garbage" } }
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" {
Expect.throws (fun () -> (SmallGroup.empty.localTimeNow >> ignore) null)
"Should have raised an exception for null clock"
}
yield test "localDateNow returns the date portion" {
let now' = DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc)
let clock = FakeClock (Instant.FromDateTimeUtc now')
Expect.isLessThan (SmallGroup.empty.localDateNow clock) now.Date "The date should have been a day earlier"
}
testList "SmallGroup" [
let now = DateTime (2017, 5, 12, 12, 15, 0, DateTimeKind.Utc)
let withFakeClock f () =
FakeClock (Instant.FromDateTimeUtc now) |> f
yield test "empty is as expected" {
let mt = SmallGroup.empty
Expect.equal mt.smallGroupId 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.name "" "The name should have been blank"
Expect.equal mt.church.churchId Guid.Empty "The church should have been an empty one"
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.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.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"
}
yield! testFixture withFakeClock [
"localTimeNow adjusts the time ahead of UTC",
fun clock ->
let grp =
{ SmallGroup.empty with
preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" }
}
Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours"
"localTimeNow adjusts the time behind UTC",
fun clock ->
Expect.isLessThan (SmallGroup.empty.localTimeNow clock) now
"UTC to America/Denver should have subtracted hours"
"localTimeNow returns UTC when the time zone is invalid",
fun clock ->
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "garbage" } }
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" {
Expect.throws (fun () -> (SmallGroup.empty.localTimeNow >> ignore) null)
"Should have raised an exception for null clock"
}
yield test "localDateNow returns the date portion" {
let now' = DateTime (2017, 5, 12, 1, 15, 0, DateTimeKind.Utc)
let clock = FakeClock (Instant.FromDateTimeUtc now')
Expect.isLessThan (SmallGroup.empty.localDateNow clock) now.Date "The date should have been a day earlier"
}
]
[<Tests>]
let timeZoneTests =
testList "TimeZone" [
test "empty is as expected" {
let mt = TimeZone.empty
Expect.equal mt.timeZoneId "" "The time zone ID 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.isFalse mt.isActive "The is-active flag should not have been set"
}
testList "TimeZone" [
test "empty is as expected" {
let mt = TimeZone.empty
Expect.equal mt.timeZoneId "" "The time zone ID 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.isFalse mt.isActive "The is-active flag should not have been set"
}
]
[<Tests>]
let userTests =
testList "User" [
test "empty is as expected" {
let mt = User.empty
Expect.equal mt.userId 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.lastName "" "The last name should have been blank"
Expect.equal mt.emailAddress "" "The e-mail address should have been blank"
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.isNone mt.salt "The password salt should not exist"
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"
}
test "fullName concatenates first and last names" {
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"
}
testList "User" [
test "empty is as expected" {
let mt = User.empty
Expect.equal mt.userId 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.lastName "" "The last name should have been blank"
Expect.equal mt.emailAddress "" "The e-mail address should have been blank"
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.isNone mt.salt "The password salt should not exist"
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"
}
test "fullName concatenates first and last names" {
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"
}
]
[<Tests>]
let userSmallGroupTests =
testList "UserSmallGroup" [
test "empty is as expected" {
let mt = UserSmallGroup.empty
Expect.equal mt.userId 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.user.userId 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"
}
testList "UserSmallGroup" [
test "empty is as expected" {
let mt = UserSmallGroup.empty
Expect.equal mt.userId 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.user.userId 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"
}
]

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

@ -17,7 +17,8 @@
<ItemGroup>
<PackageReference Include="Expecto" Version="9.0.4" />
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
<PackageReference Include="NodaTime.Testing" Version="3.0.5" />
<PackageReference Include="NodaTime.Testing" Version="3.1.0" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
<ItemGroup>

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

@ -1,208 +1,214 @@
module PrayerTracker.UI.CommonFunctionsTests
open System.IO
open Expecto
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization
open PrayerTracker.Tests.TestLocalization
open PrayerTracker.Views
open System.IO
[<Tests>]
let iconSizedTests =
testList "iconSized" [
test "succeeds" {
let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons md-18\">tom-&-jerry</i>" "icon HTML not correct"
}
testList "iconSized" [
test "succeeds" {
let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode
Expect.equal ico """<i class="material-icons md-18">tom-&-jerry</i>""" "icon HTML not correct"
}
]
[<Tests>]
let iconTests =
testList "icon" [
test "succeeds" {
let ico = icon "bob-&-tom" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons\">bob-&-tom</i>" "icon HTML not correct"
}
testList "icon" [
test "succeeds" {
let ico = icon "bob-&-tom" |> renderHtmlNode
Expect.equal ico """<i class="material-icons">bob-&-tom</i>""" "icon HTML not correct"
}
]
[<Tests>]
let locStrTests =
testList "locStr" [
test "succeeds" {
let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode
Expect.equal enc "test&amp;" "string not encoded correctly"
}
testList "locStr" [
test "succeeds" {
let enc = locStr (LocalizedString ("test", "test&")) |> renderHtmlNode
Expect.equal enc "test&amp;" "string not encoded correctly"
}
]
[<Tests>]
let namedColorListTests =
testList "namedColorList" [
test "succeeds with default values" {
let expected =
[ "<select name=\"the-name\">"
"<option value=\"aqua\" style=\"background-color:aqua;color:black;\">aqua</option>"
"<option value=\"black\" style=\"background-color:black;color:white;\">black</option>"
"<option value=\"blue\" style=\"background-color:blue;color:white;\">blue</option>"
"<option value=\"fuchsia\" style=\"background-color:fuchsia;color:black;\">fuchsia</option>"
"<option value=\"gray\" style=\"background-color:gray;color:white;\">gray</option>"
"<option value=\"green\" style=\"background-color:green;color:white;\">green</option>"
"<option value=\"lime\" style=\"background-color:lime;color:black;\">lime</option>"
"<option value=\"maroon\" style=\"background-color:maroon;color:white;\">maroon</option>"
"<option value=\"navy\" style=\"background-color:navy;color:white;\">navy</option>"
"<option value=\"olive\" style=\"background-color:olive;color:white;\">olive</option>"
"<option value=\"purple\" style=\"background-color:purple;color:white;\">purple</option>"
"<option value=\"red\" style=\"background-color:red;color:black;\">red</option>"
"<option value=\"silver\" style=\"background-color:silver;color:black;\">silver</option>"
"<option value=\"teal\" style=\"background-color:teal;color:white;\">teal</option>"
"<option value=\"white\" style=\"background-color:white;color:black;\">white</option>"
"<option value=\"yellow\" style=\"background-color:yellow;color:black;\">yellow</option>"
"</select>"
]
|> String.concat ""
let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode
Expect.equal expected selectList "The default select list was not generated correctly"
}
test "succeeds with a selected value" {
let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode
Expect.stringContains selectList " selected>white</option>" "Selected option not generated correctly"
}
test "succeeds with extra attributes" {
let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode
Expect.stringStarts selectList "<select name=\"the-name\" id=\"myId\">" "Attributes not included correctly"
}
testList "namedColorList" [
test "succeeds with default values" {
let expected =
[ """<select name="the-name">"""
"""<option value="aqua" style="background-color:aqua;color:black;">aqua</option>"""
"""<option value="black" style="background-color:black;color:white;">black</option>"""
"""<option value="blue" style="background-color:blue;color:white;">blue</option>"""
"""<option value="fuchsia" style="background-color:fuchsia;color:black;">fuchsia</option>"""
"""<option value="gray" style="background-color:gray;color:white;">gray</option>"""
"""<option value="green" style="background-color:green;color:white;">green</option>"""
"""<option value="lime" style="background-color:lime;color:black;">lime</option>"""
"""<option value="maroon" style="background-color:maroon;color:white;">maroon</option>"""
"""<option value="navy" style="background-color:navy;color:white;">navy</option>"""
"""<option value="olive" style="background-color:olive;color:white;">olive</option>"""
"""<option value="purple" style="background-color:purple;color:white;">purple</option>"""
"""<option value="red" style="background-color:red;color:black;">red</option>"""
"""<option value="silver" style="background-color:silver;color:black;">silver</option>"""
"""<option value="teal" style="background-color:teal;color:white;">teal</option>"""
"""<option value="white" style="background-color:white;color:black;">white</option>"""
"""<option value="yellow" style="background-color:yellow;color:black;">yellow</option>"""
"</select>"
]
|> String.concat ""
let selectList = namedColorList "the-name" "" [] _s |> renderHtmlNode
Expect.equal expected selectList "The default select list was not generated correctly"
}
test "succeeds with a selected value" {
let selectList = namedColorList "the-name" "white" [] _s |> renderHtmlNode
Expect.stringContains selectList " selected>white</option>" "Selected option not generated correctly"
}
test "succeeds with extra attributes" {
let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode
Expect.stringStarts selectList """<select name="the-name" id="myId">""" "Attributes not included correctly"
}
]
[<Tests>]
let radioTests =
testList "radio" [
test "succeeds when not selected" {
let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"test\">"
"Unselected radio button not generated correctly"
}
test "succeeds when selected" {
let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"unit\" checked>"
"Selected radio button not generated correctly"
}
testList "radio" [
test "succeeds when not selected" {
let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode
Expect.equal rad """<input type="radio" name="a-name" id="anId" value="test">"""
"Unselected radio button not generated correctly"
}
test "succeeds when selected" {
let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode
Expect.equal rad """<input type="radio" name="a-name" id="anId" value="unit" checked>"""
"Selected radio button not generated correctly"
}
]
[<Tests>]
let rawLocTextTests =
testList "rawLocText" [
test "succeeds" {
use sw = new StringWriter ()
let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode
Expect.equal raw "test&" "string not written correctly"
}
testList "rawLocText" [
test "succeeds" {
use sw = new StringWriter ()
let raw = rawLocText sw (LocalizedHtmlString ("test", "test&")) |> renderHtmlNode
Expect.equal raw "test&" "string not written correctly"
}
]
[<Tests>]
let selectDefaultTests =
testList "selectDefault" [
test "succeeds" {
Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly"
}
testList "selectDefault" [
test "succeeds" {
Expect.equal (selectDefault "a&b") "— a&b —" "Default selection not generated correctly"
}
]
[<Tests>]
let selectListTests =
testList "selectList" [
test "succeeds with minimum options" {
let theList = selectList "a-list" "" [] [] |> renderHtmlNode
Expect.equal theList "<select name=\"a-list\" id=\"a-list\"></select>" "Empty select list not generated correctly"
}
test "succeeds with all options" {
let theList =
[ "tom", "Tom&"
"bob", "Bob"
"jan", "Jan"
]
|> selectList "the-list" "bob" [ _style "ugly" ]
|> renderHtmlNode
let expected =
[ "<select name=\"the-list\" id=\"the-list\" style=\"ugly\">"
"<option value=\"tom\">Tom&amp;</option>"
"<option value=\"bob\" selected>Bob</option>"
"<option value=\"jan\">Jan</option>"
"</select>"
]
|> String.concat ""
Expect.equal theList expected "Filled select list not generated correctly"
}
testList "selectList" [
test "succeeds with minimum options" {
let theList = selectList "a-list" "" [] [] |> renderHtmlNode
Expect.equal theList """<select name="a-list" id="a-list"></select>"""
"Empty select list not generated correctly"
}
test "succeeds with all options" {
let theList =
[ "tom", "Tom&"
"bob", "Bob"
"jan", "Jan"
]
|> selectList "the-list" "bob" [ _style "ugly" ]
|> renderHtmlNode
let expected =
[ """<select name="the-list" id="the-list" style="ugly">"""
"""<option value="tom">Tom&amp;</option>"""
"""<option value="bob" selected>Bob</option>"""
"""<option value="jan">Jan</option>"""
"""</select>"""
]
|> String.concat ""
Expect.equal theList expected "Filled select list not generated correctly"
}
]
[<Tests>]
let spaceTests =
testList "space" [
test "succeeds" {
Expect.equal (renderHtmlNode space) " " "space literal not correct"
}
testList "space" [
test "succeeds" {
Expect.equal (renderHtmlNode space) " " "space literal not correct"
}
]
[<Tests>]
let submitTests =
testList "submit" [
test "succeeds" {
let btn = submit [ _class "slick" ] "file-ico" _s.["a&b"] |> renderHtmlNode
Expect.equal
btn
"<button type=\"submit\" class=\"slick\"><i class=\"material-icons\">file-ico</i> &nbsp;a&amp;b</button>"
"Submit button not generated correctly"
}
testList "submit" [
test "succeeds" {
let btn = submit [ _class "slick" ] "file-ico" _s["a&b"] |> renderHtmlNode
Expect.equal
btn
"""<button type="submit" class="slick"><i class="material-icons">file-ico</i> &nbsp;a&amp;b</button>"""
"Submit button not generated correctly"
}
]
[<Tests>]
let tableSummaryTests =
testList "tableSummary" [
test "succeeds for no entries" {
let sum = tableSummary 0 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>No Entries to Display</small></div>"
"Summary for no items is incorrect"
}
test "succeeds for one entry" {
let sum = tableSummary 1 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 1 Entry</small></div>"
"Summary for one item is incorrect"
}
test "succeeds for many entries" {
let sum = tableSummary 5 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 5 Entries</small></div>"
"Summary for many items is incorrect"
}
testList "tableSummary" [
test "succeeds for no entries" {
let sum = tableSummary 0 _s |> renderHtmlNode
Expect.equal sum """<div class="pt-center-text"><small>No Entries to Display</small></div>"""
"Summary for no items is incorrect"
}
test "succeeds for one entry" {
let sum = tableSummary 1 _s |> renderHtmlNode
Expect.equal sum """<div class="pt-center-text"><small>Displaying 1 Entry</small></div>"""
"Summary for one item is incorrect"
}
test "succeeds for many entries" {
let sum = tableSummary 5 _s |> renderHtmlNode
Expect.equal sum """<div class="pt-center-text"><small>Displaying 5 Entries</small></div>"""
"Summary for many items is incorrect"
}
]
module TimeZones =
open PrayerTracker.Views.CommonFunctions.TimeZones
open PrayerTracker.Views.CommonFunctions.TimeZones
[<Tests>]
let nameTests =
testList "TimeZones.name" [
test "succeeds for US Eastern time" {
Expect.equal (name "America/New_York" _s |> string) "Eastern" "US Eastern time zone not returned correctly"
}
test "succeeds for US Central time" {
Expect.equal (name "America/Chicago" _s |> string) "Central" "US Central time zone not returned correctly"
}
test "succeeds for US Mountain time" {
Expect.equal (name "America/Denver" _s |> string) "Mountain" "US Mountain time zone not returned correctly"
}
test "succeeds for US Mountain (AZ) time" {
Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)"
"US Mountain (AZ) time zone not returned correctly"
}
test "succeeds for US Pacific time" {
Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" "US Pacific time zone not returned correctly"
}
test "succeeds for Central European time" {
Expect.equal (name "Europe/Berlin" _s |> string) "Central European"
"Central European time zone not returned correctly"
}
test "fails for unexpected time zone" {
Expect.equal (name "Wakanda" _s |> string) "Wakanda" "Unexpected time zone should have returned the original ID"
}
]
[<Tests>]
let nameTests =
testList "TimeZones.name" [
test "succeeds for US Eastern time" {
Expect.equal (name "America/New_York" _s |> string) "Eastern"
"US Eastern time zone not returned correctly"
}
test "succeeds for US Central time" {
Expect.equal (name "America/Chicago" _s |> string) "Central"
"US Central time zone not returned correctly"
}
test "succeeds for US Mountain time" {
Expect.equal (name "America/Denver" _s |> string) "Mountain"
"US Mountain time zone not returned correctly"
}
test "succeeds for US Mountain (AZ) time" {
Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)"
"US Mountain (AZ) time zone not returned correctly"
}
test "succeeds for US Pacific time" {
Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific"
"US Pacific time zone not returned correctly"
}
test "succeeds for Central European time" {
Expect.equal (name "Europe/Berlin" _s |> string) "Central European"
"Central European time zone not returned correctly"
}
test "fails for unexpected time zone" {
Expect.equal (name "Wakanda" _s |> string) "Wakanda"
"Unexpected time zone should have returned the original ID"
}
]

2
src/PrayerTracker.Tests/UI/UtilsTests.fs
View File

@ -136,7 +136,7 @@ module StringTests =
[<Tests>]
let stripTagsTests =
let testString = "<p class=\"testing\">Here is some text<br> <br />and some more</p>"
let testString = """<p class="testing">Here is some text<br> <br />and some more</p>"""
testList "stripTags" [
test "does nothing if all tags are allowed" {
Expect.equal (stripTags [ "p"; "br" ] testString) testString

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

File diff suppressed because it is too large Load Diff

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

@ -6,45 +6,50 @@ open PrayerTracker.ViewModels
/// View for the church edit page
let edit (m : EditChurch) ctx vi =
let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church"
let pageTitle = match m.IsNew with true -> "Add a New Church" | false -> "Edit Church"
let s = I18N.localizer.Force ()
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [
rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }"
]
csrfToken ctx
input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ]
input [ _type "hidden"; _name (nameof m.ChurchId); _value (flatGuid m.ChurchId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s["Church Name"] ]
input [ _type "text"; _name "name"; _id "name"; _required; _autofocus; _value m.name ]
input [ _type "text"; _name (nameof m.Name); _id "name"; _required; _autofocus; _value m.Name ]
]
div [ _class "pt-field" ] [
label [ _for "City"] [ locStr s["City"] ]
input [ _type "text"; _name "city"; _id "city"; _required; _value m.city ]
input [ _type "text"; _name (nameof m.City); _id "city"; _required; _value m.City ]
]
div [ _class "pt-field" ] [
label [ _for "ST" ] [ locStr s["State"] ]
input [ _type "text"; _name "st"; _id "st"; _required; _minlength "2"; _maxlength "2"; _value m.st ]
label [ _for "state" ] [ locStr s["State or Province"] ]
input [ _type "text"
_name (nameof m.State)
_id "state"
_required
_minlength "2"; _maxlength "2"
_value m.State ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"
_name "hasInterface"
_name (nameof m.HasInterface)
_id "hasInterface"
_value "True"
match m.hasInterface with Some x when x -> _checked | _ -> () ]
if defaultArg m.HasInterface false then _checked ]
label [ _for "hasInterface" ] [ locStr s["Has an interface with Virtual Prayer Room"] ]
]
]
div [ _class "pt-field-row pt-fadeable"; _id "divInterfaceAddress" ] [
div [ _class "pt-field" ] [
label [ _for "interfaceAddress" ] [ locStr s["VPR Interface URL"] ]
input
[ _type "url"; _name "interfaceAddress"; _id "interfaceAddress";
_value (match m.interfaceAddress with Some ia -> ia | None -> "")
]
input [ _type "url"
_name (nameof m.InterfaceAddress)
_id "interfaceAddress";
_value (defaultArg m.InterfaceAddress "") ]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save Church"] ]

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

@ -37,7 +37,7 @@ let error code vi =
_alt $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_title $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ]
str vi.version
str vi.Version
]
]
|> div []

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

@ -20,7 +20,7 @@ module Navigation =
let s = I18N.localizer.Force ()
let menuSpacer = rawText "&nbsp; "
let leftLinks = [
match m.user with
match m.User with
| Some u ->
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s["Requests"].Value; _title s["Requests"].Value ]
@ -56,7 +56,7 @@ module Navigation =
]
]
| None ->
match m.group with
match m.Group with
| Some _ ->
li [] [
a [ _href "/web/prayer-requests/view"
@ -91,9 +91,9 @@ module Navigation =
]
]
let rightLinks =
match m.group with
match m.Group with
| Some _ -> [
match m.user with
match m.User with
| Some _ ->
li [] [
a [ _href "/web/user/password"
@ -137,9 +137,9 @@ module Navigation =
rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/es" ] [ locStr s["Cambie a Español"] ]
]
match m.group with
match m.Group with
| Some g ->[
match m.user with
match m.User with
| Some u ->
span [ _class "u" ] [ locStr s["Currently Logged On"] ]
rawText "&nbsp; &nbsp;"
@ -151,7 +151,7 @@ module Navigation =
rawText "&nbsp; "
icon "group"
space
match m.user with
match m.User with
| Some _ -> a [ _href "/web/small-group" ] [ strong [] [ str g.name ] ]
| None -> strong [] [ str g.name ]
rawText " &nbsp;"
@ -190,9 +190,9 @@ let private htmlHead m pageTitle =
meta [ _charset "UTF-8" ]
title [] [ locStr pageTitle; titleSep; locStr s["PrayerTracker"] ]
yield! commonHead
for cssFile in m.style do
for cssFile in m.Style do
link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
for jsFile in m.script do
for jsFile in m.Script do
script [ _src $"/js/{jsFile}.js" ] []
]
@ -207,25 +207,25 @@ let private helpLink link =
/// Render the page title, and optionally a help link
let private renderPageTitle m pageTitle =
h2 [ _id "pt-page-title" ] [
match m.helpLink with Some link -> Help.fullLink (langCode ()) link |> helpLink | None -> ()
match m.HelpLink with Some link -> Help.fullLink (langCode ()) link |> helpLink | None -> ()
locStr pageTitle
]
/// Render the messages that may need to be displayed to the user
let private messages m =
let s = I18N.localizer.Force ()
m.messages
m.Messages
|> List.map (fun msg ->
table [ _class $"pt-msg {msg.level.ToLower ()}" ] [
table [ _class $"pt-msg {MessageLevel.toCssClass msg.Level}" ] [
tr [] [
td [] [
match msg.level with
| "Info" -> ()
match msg.Level with
| Info -> ()
| lvl ->
strong [] [ locStr s[lvl] ]
strong [] [ locStr s[MessageLevel.toString lvl] ]
rawText " &#xbb; "
rawText msg.text.Value
match msg.description with
rawText msg.Text.Value
match msg.Description with
| Some desc ->
br []
div [ _class "description" ] [ rawText desc.Value ]
@ -238,7 +238,7 @@ let private messages m =
let private htmlFooter m =
let s = I18N.localizer.Force ()
let imgText = sprintf "%O %O" s["PrayerTracker"] s["from Bit Badger Solutions"]
let resultTime = TimeSpan(DateTime.Now.Ticks - m.requestStart).TotalSeconds
let resultTime = TimeSpan(DateTime.Now.Ticks - m.RequestStart).TotalSeconds
footer [] [
div [ _id "pt-legal" ] [
a [ _href "/web/legal/privacy-policy" ] [ locStr s["Privacy Policy"] ]
@ -255,7 +255,7 @@ let private htmlFooter m =
div [ _id "pt-footer" ] [
a [ _href "/web/"; _style "line-height:28px;" ]
[ img [ _src $"""/img/%O{s["footer_en"]}.png"""; _alt imgText; _title imgText ] ]
str m.version
str m.Version
space
i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ]
[ str "schedule" ]

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

@ -13,35 +13,35 @@ open PrayerTracker.ViewModels
/// View for the prayer request edit page
let edit (m : EditRequest) today ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = if m.isNew () then "Add a New Request" else "Edit Request"
let pageTitle = if m.IsNew then "Add a New Request" else "Edit Request"
[ form [ _action "/web/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ]
input [ _type "hidden"; _name (nameof m.RequestId); _value (flatGuid m.RequestId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s["Request Type"] ]
label [ _for (nameof m.RequestType) ] [ locStr s["Request Type"] ]
ReferenceList.requestTypeList s
|> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" m.requestType [ _required; _autofocus ]
|> selectList (nameof m.RequestType) m.RequestType [ _required; _autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "requestor" ] [ locStr s["Requestor / Subject"] ]
input [ _type "text"
_name "requestor"
_name (nameof m.Requestor)
_id "requestor"
_value (match m.requestor with Some x -> x | None -> "") ]
_value (defaultArg m.Requestor "") ]
]
if m.isNew () then
if m.IsNew then
div [ _class "pt-field" ] [
label [ _for "enteredDate" ] [ locStr s["Date"] ]
input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ]
input [ _type "date"; _name (nameof m.EnteredDate); _id "enteredDate"; _placeholder today ]
]
else
div [ _class "pt-field" ] [
div [ _class "pt-checkbox-field" ] [
br []
input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ]
input [ _type "checkbox"; _name (nameof m.SkipDateUpdate); _id "skipDateUpdate"; _value "True" ]
label [ _for "skipDateUpdate" ] [ locStr s["Check to not update the date"] ]
br []
small [] [ em [] [ str (s["Typo Corrections"].Value.ToLower ()); rawText ", etc." ] ]
@ -51,11 +51,11 @@ let edit (m : EditRequest) today ctx vi =
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [] [ locStr s["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ())
ReferenceList.expirationList s (not m.IsNew)
|> List.map (fun exp ->
let radioId = $"expiration_{fst exp}"
span [ _class "text-nowrap" ] [
radio "expiration" radioId (fst exp) m.expiration
radio (nameof m.Expiration) radioId (fst exp) m.Expiration
label [ _for radioId ] [ locStr (snd exp) ]
rawText " &nbsp; &nbsp; "
])
@ -65,7 +65,7 @@ let edit (m : EditRequest) today ctx vi =
div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s["Request"] ]
textarea [ _name "text"; _id "text" ] [ str m.text ]
textarea [ _name (nameof m.Text); _id "text" ] [ str m.Text ]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save Request"] ]
@ -78,9 +78,9 @@ let edit (m : EditRequest) today ctx vi =
/// View for the request e-mail results page
let email m vi =
let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let prefs = m.listGroup.preferences
let addresses = String.Join (", ", m.recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>"))
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.SmallGroup.name}"""
let prefs = m.SmallGroup.preferences
let addresses = m.Recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>") |> String.concat ", "
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [
locStr s["The request list was sent to the following people, via individual e-mails"]
rawText ":"
@ -88,11 +88,11 @@ let email m vi =
small [] [ str addresses ]
]
span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ rawText (m.asHtml s) ]
div [ _class "pt-email-canvas" ] [ rawText (m.AsHtml s) ]
br []
br []
span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ]
div [ _class "pt-email-canvas" ] [ pre [] [ str (m.AsText s) ] ]
]
|> Layout.Content.standard
|> Layout.standard vi pageTitle
@ -101,7 +101,7 @@ let email m vi =
/// View for a small group's public prayer request list
let list (m : RequestList) vi =
[ br []
I18N.localizer.Force () |> (m.asHtml >> rawText)
I18N.localizer.Force () |> (m.AsHtml >> rawText)
]
|> Layout.Content.standard
|> Layout.standard vi "View Request List"
@ -154,24 +154,24 @@ let lists (groups : SmallGroup list) vi =
/// View for the prayer request maintenance page
let maintain m (ctx : HttpContext) vi =
let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Maintain"
use sw = new StringWriter ()
let raw = rawLocText sw
let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ())
let typs = ReferenceList.requestTypeList s |> Map.ofList
let maintain (m : MaintainRequests) (ctx : HttpContext) vi =
let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Maintain"
use sw = new StringWriter ()
let raw = rawLocText sw
let now = m.SmallGroup.localDateNow (ctx.GetService<IClock> ())
let types = ReferenceList.requestTypeList s |> Map.ofList
let updReq (req : PrayerRequest) =
if req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks then
if req.updateRequired now m.SmallGroup.preferences.daysToExpire m.SmallGroup.preferences.longTermUpdateWeeks then
"pt-request-update"
else ""
|> _class
let reqExp (req : PrayerRequest) =
_class (if req.isExpired now m.smallGroup.preferences.daysToExpire then "pt-request-expired" else "")
_class (if req.isExpired now m.SmallGroup.preferences.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
let requests =
m.requests
|> Seq.map (fun req ->
m.Requests
|> List.map (fun req ->
let reqId = flatGuid req.prayerRequestId
let reqText = htmlToPlainText req.text
let delAction = $"/web/prayer-request/{reqId}/delete"
@ -187,7 +187,7 @@ let maintain m (ctx : HttpContext) vi =
td [] [
a [ _href $"/web/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ]
[ icon "edit" ]
if req.isExpired now m.smallGroup.preferences.daysToExpire then
if req.isExpired now m.SmallGroup.preferences.daysToExpire then
a [ _href $"/web/prayer-request/{reqId}/restore"
_title l["Restore This Inactive Request"].Value ]
[ icon "visibility" ]
@ -202,7 +202,7 @@ let maintain m (ctx : HttpContext) vi =
td [ updReq req ] [
str (req.updatedDate.ToString(s["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture))
]
td [] [ locStr typs[req.requestType] ]
td [] [ locStr types[req.requestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
td [] [
match reqText.Length with
@ -218,7 +218,7 @@ let maintain m (ctx : HttpContext) vi =
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests/view"; _title s["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s["View Prayer Request List"] ]
match m.searchTerm with
match m.SearchTerm with
| Some _ ->
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests"; _title l["Clear Search Criteria"].Value ]
@ -229,7 +229,7 @@ let maintain m (ctx : HttpContext) vi =
input [ _type "text"
_name "search"
_placeholder l["Search requests..."].Value
_value (defaultArg m.searchTerm "")
_value (defaultArg m.SearchTerm "")
]
space
submit [] "search" s["Search"]
@ -253,54 +253,52 @@ let maintain m (ctx : HttpContext) vi =
]
div [ _class "pt-center-text" ] [
br []
match m.onlyActive with
match m.OnlyActive with
| Some true ->
raw l["Inactive requests are currently not shown"]
br []
a [ _href "/web/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ]
| _ ->
match Option.isSome m.onlyActive with
| true ->
if defaultArg m.OnlyActive false then
raw l["Inactive requests are currently shown"]
br []
a [ _href "/web/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ]
br []
br []
| false -> ()
let srch = [ match m.searchTerm with Some s -> "search", s | None -> () ]
let pg = defaultArg m.pageNbr 1
let url =
match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/web/prayer-requests%s"
let search = [ match m.SearchTerm with Some s -> "search", s | None -> () ]
let pg = defaultArg m.PageNbr 1
let url =
match m.OnlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/web/prayer-requests%s"
match pg with
| 1 -> ()
| _ ->
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch
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"] ]
rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with
match requests.Length = m.SmallGroup.preferences.pageSize with
| true ->
a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ]
a [ _href (makeUrl url (("page", string (pg + 1)) :: search)) ]
[ raw l["Next Page"]; space; icon "keyboard_arrow_right" ]
| false -> ()
]
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
]
|> Layout.Content.wide
|> Layout.standard vi (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
|> Layout.standard vi (match m.SearchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
/// View for the printable prayer request list
let print m version =
let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.SmallGroup.name}"""
let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}"""
article [] [
rawText (m.asHtml s)
rawText (m.AsHtml s)
br []
hr []
div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
div [ _style $"font-size:70%%;font-family:{m.SmallGroup.preferences.listFonts};" ] [
img [ _src $"""/img/{s["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;"
_alt imgAlt
@ -315,21 +313,21 @@ let print m version =
/// View for the prayer request list
let view m vi =
let s = I18N.localizer.Force ()
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.SmallGroup.name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = m.date.ToString "yyyy-MM-dd"
let dtString = m.Date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [
br []
a [ _class "pt-icon-link"
_href $"/web/prayer-requests/print/{dtString}"
_title s["View Printable"].Value
] [ icon "print"; rawText " &nbsp;"; locStr s["View Printable"] ]
if m.canEmail then
if m.CanEmail then
spacer
if m.date.DayOfWeek <> DayOfWeek.Sunday then
if m.Date.DayOfWeek <> DayOfWeek.Sunday then
let rec findSunday (date : DateTime) =
if date.DayOfWeek = DayOfWeek.Sunday then date else findSunday (date.AddDays 1.)
let sunday = findSunday m.date
let sunday = findSunday m.Date
a [ _class "pt-icon-link"
_href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s["List for Next Sunday"].Value ] [
@ -349,7 +347,7 @@ let view m vi =
]
]
br []
rawText (m.asHtml s)
rawText (m.AsHtml s)
]
|> Layout.Content.standard
|> Layout.standard vi pageTitle

5
src/PrayerTracker.UI/PrayerTracker.UI.fsproj
View File

@ -18,14 +18,15 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="MailKit" Version="2.15.0" />
<PackageReference Include="MailKit" Version="3.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
<ItemGroup>

3
src/PrayerTracker.UI/Resources/Common.es.resx
View File

@ -822,4 +822,7 @@
<data name="as of" xml:space="preserve">
<value>como de</value>
</data>
<data name="State or Province" xml:space="preserve">
<value>Estado o Provincia</value>
</data>
</root>

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

@ -10,13 +10,14 @@ open PrayerTracker.ViewModels
/// View for the announcement page
let announcement isAdmin ctx vi =
let s = I18N.localizer.Force ()
let m = { SendToClass = ""; Text = ""; AddToRequestList = None; RequestType = None }
let reqTypes = ReferenceList.requestTypeList s
[ form [ _action "/web/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s["Announcement Text"] ]
textarea [ _name "text"; _id "text"; _autofocus ] []
textarea [ _name (nameof m.Text); _id "text"; _autofocus ] []
]
]
if isAdmin then
@ -24,27 +25,27 @@ let announcement isAdmin ctx vi =
div [ _class "pt-field" ] [
label [] [ locStr s["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [
radio "sendToClass" "sendY" "Y" "Y"
radio (nameof m.SendToClass) "sendY" "Y" "Y"
label [ _for "sendY" ] [ locStr s["This Group"]; rawText " &nbsp; &nbsp; " ]
radio "sendToClass" "sendN" "N" "Y"
radio (nameof m.SendToClass) "sendN" "N" "Y"
label [ _for "sendN" ] [ locStr s["All {0} Users", s["PrayerTracker"]] ]
]
]
]
else input [ _type "hidden"; _name "sendToClass"; _value "Y" ]
else input [ _type "hidden"; _name (nameof m.SendToClass); _value "Y" ]
div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ]
input [ _type "checkbox"; _name (nameof m.AddToRequestList); _id "addToRequestList"; _value "True" ]
label [ _for "addToRequestList" ] [ locStr s["Add to Request List"] ]
]
]
div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [
div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s["Request Type"] ]
label [ _for (nameof m.RequestType) ] [ locStr s["Request Type"] ]
reqTypes
|> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" "Announcement" []
|> selectList (nameof m.RequestType) Announcement.code []
]
]
div [ _class "pt-field-row" ] [ submit [] "send" s["Send Announcement"] ]
@ -59,12 +60,12 @@ let announcement isAdmin ctx vi =
let announcementSent (m : Announcement) vi =
let s = I18N.localizer.Force ()
[ span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ rawText m.text ]
div [ _class "pt-email-canvas" ] [ rawText m.Text ]
br []
br []
span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ pre [] [ str (m.plainText ()) ] ]
]
div [ _class "pt-email-canvas" ] [ pre [] [ str m.PlainText ] ]
]
|> Layout.Content.standard
|> Layout.standard vi "Announcement Sent"
@ -72,24 +73,24 @@ let announcementSent (m : Announcement) vi =
/// View for the small group add/edit page
let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group" | false -> "Edit Group"
let pageTitle = if m.IsNew then "Add a New Group" else "Edit Group"
form [ _action "/web/small-group/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ]
input [ _type "hidden"; _name (nameof m.SmallGroupId); _value (flatGuid m.SmallGroupId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s["Group Name"] ]
input [ _type "text"; _name "name"; _id "name"; _value m.name; _required; _autofocus ]
input [ _type "text"; _name (nameof m.Name); _id "name"; _value m.Name; _required; _autofocus ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s["Church"] ]
label [ _for (nameof m.ChurchId) ] [ locStr s["Church"] ]
seq {
"", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name)
}
|> selectList "churchId" (flatGuid m.churchId) [ _required ]
|> selectList (nameof m.ChurchId) (flatGuid m.ChurchId) [ _required ]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save Group"] ]
@ -100,29 +101,29 @@ let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
/// View for the member edit page
let editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
let editMember (m : EditMember) (types : (string * LocalizedString) seq) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group Member" | false -> "Edit Group Member"
let pageTitle = if m.IsNew then "Add a New Group Member" else "Edit Group Member"
form [ _action "/web/small-group/member/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [ rawText "#memberName { width: 15rem; } #emailAddress { width: 20rem; }" ]
style [ _scoped ] [ rawText "#name { width: 15rem; } #email { width: 20rem; }" ]
csrfToken ctx
input [ _type "hidden"; _name "memberId"; _value (flatGuid m.memberId) ]
input [ _type "hidden"; _name (nameof m.MemberId); _value (flatGuid m.MemberId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "memberName" ] [ locStr s["Member Name"] ]
input [ _type "text"; _name "memberName"; _id "memberName"; _required; _autofocus; _value m.memberName ]
label [ _for "name" ] [ locStr s["Member Name"] ]
input [ _type "text"; _name (nameof m.Name); _id "name"; _required; _autofocus; _value m.Name ]
]
div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _required; _value m.emailAddress ]
label [ _for "email" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name (nameof m.Email); _id "email"; _required; _value m.Email ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "emailType" ] [ locStr s["E-mail Format"] ]
typs
label [ _for (nameof m.Format) ] [ locStr s["E-mail Format"] ]
types
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
|> selectList "emailType" m.emailType []
|> selectList (nameof m.Format) m.Format []
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save"] ]
@ -133,32 +134,36 @@ let editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
/// View for the small group log on page
let logOn (grps : SmallGroup list) grpId ctx vi =
let logOn (groups : SmallGroup list) grpId ctx vi =
let s = I18N.localizer.Force ()
let m = { SmallGroupId = System.Guid.Empty; Password = ""; RememberMe = None }
[ form [ _action "/web/small-group/log-on/submit"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s["Group"] ]
label [ _for (nameof m.SmallGroupId) ] [ locStr s["Group"] ]
seq {
match grps.Length with
match groups.Length with
| 0 -> "", s["There are no classes with passwords defined"].Value
| _ ->
"", selectDefault s["Select Group"].Value
yield!
grps
groups
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
}
|> selectList "smallGroupId" grpId [ _required ]
|> selectList (nameof m.SmallGroupId) grpId [ _required ]
]
div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _required;
input [ _type "password"
_name (nameof m.Password)
_id "password"
_required;
_placeholder (s["Case-Sensitive"].Value.ToLower ()) ]
]
]
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
input [ _type "checkbox"; _name (nameof m.RememberMe); _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br []
small [] [ em [] [ str (s["Requires Cookies"].Value.ToLower ()) ] ]
@ -172,10 +177,10 @@ let logOn (grps : SmallGroup list) grpId ctx vi =
/// View for the small group maintenance page
let maintain (grps : SmallGroup list) ctx vi =
let maintain (groups : SmallGroup list) ctx vi =
let s = I18N.localizer.Force ()
let grpTbl =
match grps with
match groups with
| [] -> space
| _ ->
table [ _class "pt-table pt-action-table" ] [
@ -187,7 +192,7 @@ let maintain (grps : SmallGroup list) ctx vi =
th [] [ locStr s["Time Zone"] ]
]
]
grps
groups
|> List.map (fun g ->
let grpId = flatGuid g.smallGroupId
let delAction = $"/web/small-group/{grpId}/delete"
@ -218,7 +223,7 @@ let maintain (grps : SmallGroup list) ctx vi =
br []
br []
]
tableSummary grps.Length s
tableSummary groups.Length s
grpTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
]
@ -227,10 +232,10 @@ let maintain (grps : SmallGroup list) ctx vi =
/// View for the member maintenance page
let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx vi =
let members (members : Member list) (emailTyps : Map<string, LocalizedString>) ctx vi =
let s = I18N.localizer.Force ()
let mbrTbl =
match mbrs with
match members with
| [] -> space
| _ ->
table [ _class "pt-table pt-action-table" ] [
@ -242,7 +247,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
th [] [ locStr s["Format"] ]
]
]
mbrs
members
|> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId
let delAction = $"/web/small-group/member/{mbrId}/delete"
@ -271,7 +276,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
br []
br []
]
tableSummary mbrs.Length s
tableSummary members.Length s
mbrTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
]
@ -283,7 +288,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
let overview m vi =
let s = I18N.localizer.Force ()
let linkSpacer = rawText "&nbsp; "
let typs = ReferenceList.requestTypeList s |> dict
let types = ReferenceList.requestTypeList s |> dict
article [ _class "pt-overview" ] [
section [] [
header [ _role "heading" ] [
@ -306,16 +311,16 @@ let overview m vi =
]
div [] [
p [ _class "pt-center-text" ] [
strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s["Active Requests"] ]
strong [] [ str (m.TotalActiveReqs.ToString "N0"); space; locStr s["Active Requests"] ]
]
hr []
for cat in m.activeReqsByCat do
for cat in m.ActiveReqsByType do
str (cat.Value.ToString "N0")
space
locStr typs[cat.Key]
locStr types[cat.Key]
br []
br []
str (m.allReqs.ToString "N0")
str (m.AllReqs.ToString "N0")
space
locStr s["Total Requests"]
hr []
@ -332,7 +337,7 @@ let overview m vi =
locStr s["Group Members"]
]
div [ _class "pt-center-text" ] [
strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s["Members"] ]
strong [] [ str (m.TotalMembers.ToString "N0"); space; locStr s["Members"] ]
hr []
a [ _href "/web/small-group/members" ] [ icon "email"; linkSpacer; locStr s["Maintain Group Members"] ]
]
@ -350,7 +355,8 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
use sw = new StringWriter ()
let raw = rawLocText sw
[ form [ _action "/web/small-group/preferences/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [ rawText "#expireDays, #daysToKeepNew, #longTermUpdateWeeks, #headingFontSize, #listFontSize, #pageSize { width: 3rem; } #emailFromAddress { width: 20rem; } #listFonts { width: 40rem; } @media screen and (max-width: 40rem) { #listFonts { width: 100%; } }" ]
style [ _scoped ]
[ rawText "#expireDays, #daysToKeepNew, #longTermUpdateWeeks, #headingFontSize, #listFontSize, #pageSize { width: 3rem; } #emailFromAddress { width: 20rem; } #fonts { width: 40rem; } @media screen and (max-width: 40rem) { #fonts { width: 100%; } }" ]
csrfToken ctx
fieldset [] [
legend [] [ strong [] [ icon "date_range"; rawText " &nbsp;"; locStr s["Dates"] ] ]
@ -358,24 +364,37 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [
label [ _for "expireDays" ] [ locStr s["Requests Expire After"] ]
span [] [
input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required
_autofocus; _value (string m.expireDays) ]
input [ _type "number"
_name (nameof m.ExpireDays)
_id "expireDays"
_min "1"; _max "30"
_required
_autofocus
_value (string m.ExpireDays) ]
space; str (s["Days"].Value.ToLower ())
]
]
div [ _class "pt-field" ] [
label [ _for "daysToKeepNew" ] [ locStr s["Requests “New” For"] ]
span [] [
input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30"
_required; _value (string m.daysToKeepNew) ]
input [ _type "number"
_name (nameof m.DaysToKeepNew)
_id "daysToKeepNew"
_min "1"; _max "30"
_required
_value (string m.DaysToKeepNew) ]
space; str (s["Days"].Value.ToLower ())
]
]
div [ _class "pt-field" ] [
label [ _for "longTermUpdateWeeks" ] [ locStr s["Long-Term Requests Alerted for Update"] ]
span [] [
input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1"
_max "30"; _required; _value (string m.longTermUpdateWeeks) ]
input [ _type "number"
_name (nameof m.LongTermUpdateWeeks)
_id "longTermUpdateWeeks"
_min "1"; _max "30"
_required
_value (string m.LongTermUpdateWeeks) ]
space; str (s["Weeks"].Value.ToLower ())
]
]
@ -383,10 +402,10 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
]
fieldset [] [
legend [] [ strong [] [ icon "sort"; rawText " &nbsp;"; locStr s["Request Sorting"] ] ]
radio "requestSort" "requestSort_D" "D" m.requestSort
radio (nameof m.RequestSort) "requestSort_D" "D" m.RequestSort
label [ _for "requestSort_D" ] [ locStr s["Sort by Last Updated Date"] ]
rawText " &nbsp; "
radio "requestSort" "requestSort_R" "R" m.requestSort
radio (nameof m.RequestSort) "requestSort_R" "R" m.RequestSort
label [ _for "requestSort_R" ] [ locStr s["Sort by Requestor Name"] ]
]
fieldset [] [
@ -394,17 +413,24 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "emailFromName" ] [ locStr s["From Name"] ]
input [ _type "text"; _name "emailFromName"; _id "emailFromName"; _required; _value m.emailFromName ]
input [ _type "text"
_name (nameof m.EmailFromName)
_id "emailFromName"
_required
_value m.EmailFromName ]
]
div [ _class "pt-field" ] [
label [ _for "emailFromAddress" ] [ locStr s["From Address"] ]
input [ _type "email"; _name "emailFromAddress"; _id "emailFromAddress"; _required
_value m.emailFromAddress ]
input [ _type "email"
_name (nameof m.EmailFromAddress)
_id "emailFromAddress"
_required
_value m.EmailFromAddress ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s["E-mail Format"] ]
label [ _for (nameof m.DefaultEmailType) ] [ locStr s["E-mail Format"] ]
seq {
"", selectDefault s["Select"].Value
yield!
@ -412,7 +438,7 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
|> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
}
|> selectList "defaultEmailType" m.defaultEmailType [ _required ]
|> selectList (nameof m.DefaultEmailType) m.DefaultEmailType [ _required ]
]
]
]
@ -422,19 +448,19 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Lines"] ]
span [] [
radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType
label [ _for "headingLineType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingLineColor" m.headingLineColor
[ _id "headingLineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s
radio (nameof m.LineColorType) "lineColorType_Name" "Name" m.LineColorType
label [ _for "lineColorType_Name" ] [ locStr s["Named Color"] ]
namedColorList (nameof m.LineColor) m.LineColor
[ _id "lineColor_Select"
if m.LineColor.StartsWith "#" then _disabled ] s
rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType
label [ _for "headingLineType_RGB" ] [ locStr s["Custom Color"] ]
radio (nameof m.LineColorType) "lineColorType_RGB" "RGB" m.LineColorType
label [ _for "lineColorType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color"
_name "headingLineColor"
_id "headingLineColor_Color"
_value m.headingLineColor
match m.headingLineColor.StartsWith "#" with true -> () | false -> _disabled ]
_name (nameof m.LineColor)
_id "lineColor_Color"
_value m.LineColor // TODO: convert to hex or skip if named
if not (m.LineColor.StartsWith "#") then _disabled ]
]
]
]
@ -442,19 +468,19 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Text"] ]
span [] [
radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType
label [ _for "headingTextType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingTextColor" m.headingTextColor
[ _id "headingTextColor_Select"
match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s
radio (nameof m.HeadingColorType) "headingColorType_Name" "Name" m.HeadingColorType
label [ _for "headingColorType_Name" ] [ locStr s["Named Color"] ]
namedColorList (nameof m.HeadingColor) m.HeadingColor
[ _id "headingColor_Select"
if m.HeadingColor.StartsWith "#" then _disabled ] s
rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType
label [ _for "headingTextType_RGB" ] [ locStr s["Custom Color"] ]
radio (nameof m.HeadingColorType) "headingColorType_RGB" "RGB" m.HeadingColorType
label [ _for "headingColorType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color"
_name "headingTextColor"
_id "headingTextColor_Color"
_value m.headingTextColor
match m.headingTextColor.StartsWith "#" with true -> () | false -> _disabled ]
_name (nameof m.HeadingColor)
_id "headingColor_Color"
_value m.HeadingColor // TODO: convert to hex or skip if named
if not (m.HeadingColor.StartsWith "#") then _disabled ]
]
]
]
@ -462,19 +488,27 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
fieldset [] [
legend [] [ strong [] [ icon "font_download"; rawText " &nbsp;"; locStr s["Fonts"] ] ]
div [ _class "pt-field" ] [
label [ _for "listFonts" ] [ locStr s["Fonts** for List"] ]
input [ _type "text"; _name "listFonts"; _id "listFonts"; _required; _value m.listFonts ]
label [ _for "fonts" ] [ locStr s["Fonts** for List"] ]
input [ _type "text"; _name (nameof m.Fonts); _id "fonts"; _required; _value m.Fonts ]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "headingFontSize" ] [ locStr s["Heading Text Size"] ]
input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24"
_required; _value (string m.headingFontSize) ]
input [ _type "number"
_name (nameof m.HeadingFontSize)
_id "headingFontSize"
_min "8"; _max "24"
_required
_value (string m.HeadingFontSize) ]
]
div [ _class "pt-field" ] [
label [ _for "listFontSize" ] [ locStr s["List Text Size"] ]
input [ _type "number"; _name "listFontSize"; _id "listFontSize"; _min "8"; _max "24"; _required
_value (string m.listFontSize) ]
input [ _type "number"
_name (nameof m.ListFontSize)
_id "listFontSize"
_min "8"; _max "24"
_required
_value (string m.ListFontSize) ]
]
]
]
@ -482,48 +516,54 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
legend [] [ strong [] [ icon "settings"; rawText " &nbsp;"; locStr s["Other Settings"] ] ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "timeZone" ] [ locStr s["Time Zone"] ]
label [ _for (nameof m.TimeZone) ] [ locStr s["Time Zone"] ]
seq {
"", selectDefault s["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
}
|> selectList "timeZone" m.timeZone [ _required ]
|> selectList (nameof m.TimeZone) m.TimeZone [ _required ]
]
]
div [ _class "pt-field" ] [
label [] [ locStr s["Request List Visibility"] ]
span [] [
radio "listVisibility" "viz_Public" (string RequestVisibility.``public``) (string m.listVisibility)
radio (nameof m.Visibility) "viz_Public" (string RequestVisibility.``public``) (string m.Visibility)
label [ _for "viz_Public" ] [ locStr s["Public"] ]
rawText " &nbsp;"
radio "listVisibility" "viz_Private" (string RequestVisibility.``private``)
(string m.listVisibility)
radio (nameof m.Visibility) "viz_Private" (string RequestVisibility.``private``)
(string m.Visibility)
label [ _for "viz_Private" ] [ locStr s["Private"] ]
rawText " &nbsp;"
radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected)
(string m.listVisibility)
radio (nameof m.Visibility) "viz_Password" (string RequestVisibility.passwordProtected)
(string m.Visibility)
label [ _for "viz_Password" ] [ locStr s["Password Protected"] ]
]
]
let classSuffix = if m.listVisibility = RequestVisibility.passwordProtected then " pt-show" else ""
let classSuffix = if m.Visibility = RequestVisibility.passwordProtected then " pt-show" else ""
div [ _id "divClassPassword"; _class $"pt-field-row pt-fadeable{classSuffix}" ] [
div [ _class "pt-field" ] [
label [ _for "groupPassword" ] [ locStr s["Group Password (Used to Read Online)"] ]
input [ _type "text"; _name "groupPassword"; _id "groupPassword";
_value (match m.groupPassword with Some x -> x | None -> "") ]
input [ _type "text"
_name (nameof m.GroupPassword)
_id "groupPassword"
_value (defaultArg m.GroupPassword "") ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "pageSize" ] [ locStr s["Page Size"] ]
input [ _type "number"; _name "pageSize"; _id "pageSize"; _min "10"; _max "255"; _required
_value (string m.pageSize) ]
input [ _type "number"
_name (nameof m.PageSize)
_id "pageSize"
_min "10"; _max "255"
_required
_value (string m.PageSize) ]
]
div [ _class "pt-field" ] [
label [ _for "asOfDate" ] [ locStr s["“As of” Date Display"] ]
label [ _for (nameof m.AsOfDate) ] [ locStr s["“As of” Date Display"] ]
ReferenceList.asOfDateList s
|> List.map (fun (code, desc) -> code, desc.Value)
|> selectList "asOfDate" m.asOfDate [ _required ]
|> selectList (nameof m.AsOfDate) m.AsOfDate [ _required ]
]
]
]

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

@ -7,11 +7,11 @@ open PrayerTracker.ViewModels
/// View for the group assignment page
let assignGroups m groups curGroups ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s • %A" m.userName s["Assign Groups"]
let pageTitle = sprintf "%s • %A" m.UserName s["Assign Groups"]
form [ _action "/web/user/small-groups/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
input [ _type "hidden"; _name "userName"; _value m.userName ]
input [ _type "hidden"; _name (nameof m.UserId); _value (flatGuid m.UserId) ]
input [ _type "hidden"; _name (nameof m.UserName); _value m.UserName ]
table [ _class "pt-table" ] [
thead [] [
tr [] [
@ -25,10 +25,10 @@ let assignGroups m groups curGroups ctx vi =
tr [] [
td [] [
input [ _type "checkbox"
_name "smallGroups"
_name (nameof m.SmallGroups)
_id inputId
_value grpId
match curGroups |> List.contains grpId with true -> _checked | false -> () ]
if List.contains grpId curGroups then _checked ]
]
td [] [ label [ _for inputId ] [ str grpName ] ]
])
@ -44,6 +44,7 @@ let assignGroups m groups curGroups ctx vi =
/// View for the password change page
let changePassword ctx vi =
let s = I18N.localizer.Force ()
let m = { OldPassword = ""; NewPassword = ""; NewPasswordConfirm = "" }
[ p [ _class "pt-center-text" ] [
locStr s["To change your password, enter your current password in the specified box below, then enter your new password twice."]
]
@ -55,17 +56,17 @@ let changePassword ctx vi =
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "oldPassword" ] [ locStr s["Current Password"] ]
input [ _type "password"; _name "oldPassword"; _id "oldPassword"; _required; _autofocus ]
input [ _type "password"; _name (nameof m.OldPassword); _id "oldPassword"; _required; _autofocus ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "newPassword" ] [ locStr s["New Password Twice"] ]
input [ _type "password"; _name "newPassword"; _id "newPassword"; _required ]
input [ _type "password"; _name (nameof m.NewPassword); _id "newPassword"; _required ]
]
div [ _class "pt-field" ] [
label [] [ rawText "&nbsp;" ]
input [ _type "password"; _name "newPasswordConfirm"; _id "newPasswordConfirm"; _required ]
input [ _type "password"; _name (nameof m.NewPasswordConfirm); _id "newPasswordConfirm"; _required ]
]
]
div [ _class "pt-field-row" ] [
@ -81,49 +82,57 @@ let changePassword ctx vi =
/// View for the edit user page
let edit (m : EditUser) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = if m.isNew () then "Add a New User" else "Edit User"
let pwPlaceholder = s[if m.isNew () then "" else "No change"].Value
let pageTitle = if m.IsNew then "Add a New User" else "Edit User"
let pwPlaceholder = s[if m.IsNew then "" else "No change"].Value
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns"
_onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s["The passwords do not match"]}')""" ] [
style [ _scoped ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #email { width: 20rem; } " ]
csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
input [ _type "hidden"; _name (nameof m.UserId); _value (flatGuid m.UserId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "firstName" ] [ locStr s["First Name"] ]
input [ _type "text"; _name "firstName"; _id "firstName"; _value m.firstName; _required; _autofocus ]
input [ _type "text"
_name (nameof m.FirstName)
_id "firstName"
_value m.FirstName
_required
_autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "lastName" ] [ locStr s["Last Name"] ]
input [ _type "text"; _name "lastName"; _id "lastName"; _value m.lastName; _required ]
input [ _type "text"; _name (nameof m.LastName); _id "lastName"; _value m.LastName; _required ]
]
div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required ]
label [ _for "email" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name (nameof m.Email); _id "email"; _value m.Email; _required ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _placeholder pwPlaceholder ]
input [ _type "password"; _name (nameof m.Password); _id "password"; _placeholder pwPlaceholder ]
]
div [ _class "pt-field" ] [
label [ _for "passwordConfirm" ] [ locStr s["Password Again"] ]
input [ _type "password"; _name "passwordConfirm"; _id "passwordConfirm"; _placeholder pwPlaceholder ]
input [ _type "password"
_name (nameof m.PasswordConfirm)
_id "passwordConfirm"
_placeholder pwPlaceholder ]
]
]
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"
_name "isAdmin"
_name (nameof m.IsAdmin)
_id "isAdmin"
_value "True"
match m.isAdmin with Some x when x -> _checked | _ -> () ]
if defaultArg m.IsAdmin false then _checked ]
label [ _for "isAdmin" ] [ locStr s["This user is a PrayerTracker administrator"] ]
]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save User"] ]
]
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ]
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string m.IsNew).ToLowerInvariant ()}))" ]
]
|> Layout.Content.standard
|> Layout.standard vi pageTitle
@ -133,33 +142,35 @@ let edit (m : EditUser) ctx vi =
let logOn (m : UserLogOn) groups ctx vi =
let s = I18N.localizer.Force ()
form [ _action "/web/user/log-on"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [ rawText "#emailAddress { width: 20rem; }" ]
style [ _scoped ] [ rawText "#email { width: 20rem; }" ]
csrfToken ctx
input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ]
input [ _type "hidden"; _name (nameof m.RedirectUrl); _value (defaultArg m.RedirectUrl "") ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "emailAddress"] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required
_autofocus ]
label [ _for "email"] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name (nameof m.Email); _id "email"; _value m.Email; _required; _autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _required;
input [ _type "password"
_name (nameof m.Password)
_id "password"
_required;
_placeholder (sprintf "(%s)" (s["Case-Sensitive"].Value.ToLower ())) ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s["Group"] ]
label [ _for (nameof m.SmallGroupId) ] [ locStr s["Group"] ]
seq {
"", selectDefault s["Select Group"].Value
yield! groups
}
|> selectList "smallGroupId" "" [ _required ]
|> selectList (nameof m.SmallGroupId) "" [ _required ]
]
]
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
input [ _type "checkbox"; _name (nameof m.RememberMe); _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br []
small [] [ em [] [ rawText "("; str (s["Requires Cookies"].Value.ToLower ()); rawText ")" ] ]

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

@ -32,12 +32,7 @@ module String =
let replaceFirst (needle : string) replacement (haystack : string) =
match haystack.IndexOf needle with
| -1 -> haystack
| idx ->
[ haystack[0..idx - 1]
replacement
haystack[idx + needle.Length..]
]
|> String.concat ""
| idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ]
open System.Text.RegularExpressions
@ -49,14 +44,15 @@ let stripTags allowedTags input =
let mutable output = input
for tag in stripHtmlExp.Matches input do
let htmlTag = tag.Value.ToLower ()
let isAllowed =
let shouldReplace =
allowedTags
|> List.fold (fun acc t ->
acc
|| htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf $"</{t}" = 0) false
if isAllowed then output <- String.replaceFirst tag.Value "" output
|> not
if shouldReplace then output <- String.replaceFirst tag.Value "" output
output
@ -88,9 +84,9 @@ let wordWrap charPerLine (input : string) =
remaining <- remaining[spaceIdx + 1..]
// Leftovers - yum!
match remaining.Length with 0 -> () | _ -> yield remaining
yield ""
}
|> Seq.fold (fun (acc : StringBuilder) -> acc.AppendLine) (StringBuilder ())
|> string
|> String.concat "\n"
/// Modify the text returned by CKEditor into the format we need for request and announcement text
let ckEditorToText (text : string) =

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

@ -43,19 +43,40 @@ module ReferenceList =
Announcement, s["Announcements"]
]
// fsharplint:disable RecordFieldNames MemberNames
/// A user message level
type MessageLevel =
/// An informational message to the user
| Info
/// A message with information the user should consider
| Warning
/// A message indicating that something went wrong
| Error
/// Support for the MessageLevel type
module MessageLevel =
/// Convert a message level to its string representation
let toString =
function
| Info -> "Info"
| Warning -> "WARNING"
| Error -> "ERROR"
let toCssClass level = (toString level).ToLowerInvariant ()
/// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>]
type UserMessage =
{ /// The type
level : string
Level : MessageLevel
/// The actual message
text : HtmlString
Text : HtmlString
/// The description (further information)
description : HtmlString option
Description : HtmlString option
}
/// Support for the UserMessage type
@ -63,23 +84,23 @@ module UserMessage =
/// Error message template
let error =
{ level = "ERROR"
text = HtmlString.Empty
description = None
{ Level = Error
Text = HtmlString.Empty
Description = None
}
/// Warning message template
let warning =
{ level = "WARNING"
text = HtmlString.Empty
description = None
{ Level = Warning
Text = HtmlString.Empty
Description = None
}
/// Info message template
let info =
{ level = "Info"
text = HtmlString.Empty
description = None
{ Level = Info
Text = HtmlString.Empty
Description = None
}
@ -89,28 +110,28 @@ open System
[<NoComparison; NoEquality>]
type AppViewInfo =
{ /// CSS files for the page
style : string list
Style : string list
/// JavaScript files for the page
script : string list
Script : string list
/// The link for help on this page
helpLink : string option
HelpLink : string option
/// Messages to be displayed to the user
messages : UserMessage list
Messages : UserMessage list
/// The current version of PrayerTracker
version : string
Version : string
/// The ticks when the request started
requestStart : int64
RequestStart : int64
/// The currently logged on user, if there is one
user : User option
User : User option
/// The currently logged on small group, if there is one
group : SmallGroup option
Group : SmallGroup option
}
/// Support for the AppViewInfo type
@ -118,14 +139,14 @@ module AppViewInfo =
/// A fresh version that can be populated to process the current request
let fresh =
{ style = []
script = []
helpLink = None
messages = []
version = ""
requestStart = DateTime.Now.Ticks
user = None
group = None
{ Style = []
Script = []
HelpLink = None
Messages = []
Version = ""
RequestStart = DateTime.Now.Ticks
User = None
Group = None
}
@ -133,34 +154,35 @@ module AppViewInfo =
[<CLIMutable; NoComparison; NoEquality>]
type Announcement =
{ /// Whether the announcement should be sent to the class or to PrayerTracker users
sendToClass : string
SendToClass : string
/// The text of the announcement
text : string
Text : string
/// Whether this announcement should be added to the "Announcements" of the prayer list
addToRequestList : bool option
AddToRequestList : bool option
/// The ID of the request type to which this announcement should be added
requestType : string option
RequestType : string option
}
with
/// The text of the announcement, in plain text
member this.plainText () = (htmlToPlainText >> wordWrap 74) this.text
member this.PlainText
with get () = (htmlToPlainText >> wordWrap 74) this.Text
/// Form for assigning small groups to a user
[<CLIMutable; NoComparison; NoEquality>]
type AssignGroups =
{ /// The Id of the user being assigned
userId : UserId
UserId : UserId
/// The full name of the user being assigned
userName : string
UserName : string
/// The Ids of the small groups to which the user is authorized
smallGroups : string
SmallGroups : string
}
/// Support for the AssignGroups type
@ -168,9 +190,9 @@ module AssignGroups =
/// Create an instance of this form from an existing user
let fromUser (u : User) =
{ userId = u.userId
userName = u.fullName
smallGroups = ""
{ UserId = u.userId
UserName = u.fullName
SmallGroups = ""
}
@ -178,11 +200,13 @@ module AssignGroups =
[<CLIMutable; NoComparison; NoEquality>]
type ChangePassword =
{ /// The user's current password
oldPassword : string
OldPassword : string
/// The user's new password
newPassword : string
NewPassword : string
/// The user's new password, confirmed
newPasswordConfirm : string
NewPasswordConfirm : string
}
@ -190,36 +214,37 @@ type ChangePassword =
[<CLIMutable; NoComparison; NoEquality>]
type EditChurch =
{ /// The Id of the church
churchId : ChurchId
ChurchId : ChurchId
/// The name of the church
name : string
Name : string
/// The city for the church
city : string
City : string
/// The state for the church
st : string
/// The state or province for the church
State : string
/// Whether the church has an active VPR interface
hasInterface : bool option
/// Whether the church has an active Virtual Prayer Room interface
HasInterface : bool option
/// The address for the interface
interfaceAddress : string option
InterfaceAddress : string option
}
with
/// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId
member this.IsNew
with get () = Guid.Empty = this.ChurchId
/// Populate a church from this form
member this.populateChurch (church : Church) =
member this.PopulateChurch (church : Church) =
{ church with
name = this.name
city = this.city
st = this.st
hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
name = this.Name
city = this.City
st = this.State
hasInterface = match this.HasInterface with Some x -> x | None -> false
interfaceAddress = match this.HasInterface with Some x when x -> this.InterfaceAddress | _ -> None
}
/// Support for the EditChurch type
@ -227,22 +252,22 @@ module EditChurch =
/// Create an instance from an existing church
let fromChurch (ch : Church) =
{ churchId = ch.churchId
name = ch.name
city = ch.city
st = ch.st
hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress
{ ChurchId = ch.churchId
Name = ch.name
City = ch.city
State = ch.st
HasInterface = match ch.hasInterface with true -> Some true | false -> None
InterfaceAddress = ch.interfaceAddress
}
/// An instance to use for adding churches
let empty =
{ churchId = Guid.Empty
name = ""
city = ""
st = ""
hasInterface = None
interfaceAddress = None
{ ChurchId = Guid.Empty
Name = ""
City = ""
State = ""
HasInterface = None
InterfaceAddress = None
}
@ -250,39 +275,40 @@ module EditChurch =
[<CLIMutable; NoComparison; NoEquality>]
type EditMember =
{ /// The Id for this small group member (not user-entered)
memberId : MemberId
MemberId : MemberId
/// The name of the member
memberName : string
Name : string
/// The e-mail address
emailAddress : string
Email : string
/// The e-mail format
emailType : string
Format : string
}
with
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
member this.IsNew
with get () = Guid.Empty = this.MemberId
/// Support for the EditMember type
module EditMember =
/// Create an instance from an existing member
let fromMember (m : Member) =
{ memberId = m.memberId
memberName = m.memberName
emailAddress = m.email
emailType = match m.format with Some f -> f | None -> ""
{ MemberId = m.memberId
Name = m.memberName
Email = m.email
Format = match m.format with Some f -> f | None -> ""
}
/// An empty instance
let empty =
{ memberId = Guid.Empty
memberName = ""
emailAddress = ""
emailType = ""
{ MemberId = Guid.Empty
Name = ""
Email = ""
Format = ""
}
@ -290,90 +316,90 @@ module EditMember =
[<CLIMutable; NoComparison; NoEquality>]
type EditPreferences =
{ /// The number of days after which requests are automatically expired
expireDays : int
ExpireDays : int
/// The number of days requests are considered "new"
daysToKeepNew : int
DaysToKeepNew : int
/// The number of weeks after which a long-term requests is flagged as requiring an update
longTermUpdateWeeks : int
LongTermUpdateWeeks : int
/// Whether to sort by updated date or requestor/subject
requestSort : string
RequestSort : string
/// The name from which e-mail will be sent
emailFromName : string
EmailFromName : string
/// The e-mail address from which e-mail will be sent
emailFromAddress : string
EmailFromAddress : string
/// The default e-mail type for this group
defaultEmailType : string
DefaultEmailType : string
/// Whether the heading line color uses named colors or R/G/B
headingLineType : string
LineColorType : string
/// The named color for the heading lines
headingLineColor : string
LineColor : string
/// Whether the heading text color uses named colors or R/G/B
headingTextType : string
HeadingColorType : string
/// The named color for the heading text
headingTextColor : string
HeadingColor : string
/// The fonts to use for the list
listFonts : string
Fonts : string
/// The font size for the heading text
headingFontSize : int
HeadingFontSize : int
/// The font size for the list text
listFontSize : int
ListFontSize : int
/// The time zone for the class
timeZone : string
TimeZone : string
/// The list visibility
listVisibility : int
Visibility : int
/// The small group password
groupPassword : string option
GroupPassword : string option
/// The page size for search / inactive requests
pageSize : int
PageSize : int
/// How the as-of date should be displayed
asOfDate : string
AsOfDate : string
}
with
/// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) =
member this.PopulatePreferences (prefs : ListPreferences) =
let isPublic, grpPw =
match this.listVisibility with
match this.Visibility with
| RequestVisibility.``public`` -> true, ""
| RequestVisibility.passwordProtected -> false, (defaultArg this.groupPassword "")
| RequestVisibility.passwordProtected -> false, (defaultArg this.GroupPassword "")
| RequestVisibility.``private``
| _ -> false, ""
{ prefs with
daysToExpire = this.expireDays
daysToKeepNew = this.daysToKeepNew
longTermUpdateWeeks = this.longTermUpdateWeeks
requestSort = RequestSort.fromCode this.requestSort
emailFromName = this.emailFromName
emailFromAddress = this.emailFromAddress
defaultEmailType = EmailFormat.fromCode this.defaultEmailType
lineColor = this.headingLineColor
headingColor = this.headingTextColor
listFonts = this.listFonts
headingFontSize = this.headingFontSize
textFontSize = this.listFontSize
timeZoneId = this.timeZone
daysToExpire = this.ExpireDays
daysToKeepNew = this.DaysToKeepNew
longTermUpdateWeeks = this.LongTermUpdateWeeks
requestSort = RequestSort.fromCode this.RequestSort
emailFromName = this.EmailFromName
emailFromAddress = this.EmailFromAddress
defaultEmailType = EmailFormat.fromCode this.DefaultEmailType
lineColor = this.LineColor
headingColor = this.HeadingColor
listFonts = this.Fonts
headingFontSize = this.HeadingFontSize
textFontSize = this.ListFontSize
timeZoneId = this.TimeZone
isPublic = isPublic
groupPassword = grpPw
pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate
pageSize = this.PageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.AsOfDate
}
/// Support for the EditPreferences type
@ -381,25 +407,25 @@ module EditPreferences =
/// Populate an edit form from existing preferences
let fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ expireDays = prefs.daysToExpire
daysToKeepNew = prefs.daysToKeepNew
longTermUpdateWeeks = prefs.longTermUpdateWeeks
requestSort = prefs.requestSort.code
emailFromName = prefs.emailFromName
emailFromAddress = prefs.emailFromAddress
defaultEmailType = prefs.defaultEmailType.code
headingLineType = setType prefs.lineColor
headingLineColor = prefs.lineColor
headingTextType = setType prefs.headingColor
headingTextColor = prefs.headingColor
listFonts = prefs.listFonts
headingFontSize = prefs.headingFontSize
listFontSize = prefs.textFontSize
timeZone = prefs.timeZoneId
groupPassword = Some prefs.groupPassword
pageSize = prefs.pageSize
asOfDate = prefs.asOfDateDisplay.code
listVisibility =
{ ExpireDays = prefs.daysToExpire
DaysToKeepNew = prefs.daysToKeepNew
LongTermUpdateWeeks = prefs.longTermUpdateWeeks
RequestSort = prefs.requestSort.code
EmailFromName = prefs.emailFromName
EmailFromAddress = prefs.emailFromAddress
DefaultEmailType = prefs.defaultEmailType.code
LineColorType = setType prefs.lineColor
LineColor = prefs.lineColor
HeadingColorType = setType prefs.headingColor
HeadingColor = prefs.headingColor
Fonts = prefs.listFonts
HeadingFontSize = prefs.headingFontSize
ListFontSize = prefs.textFontSize
TimeZone = prefs.timeZoneId
GroupPassword = Some prefs.groupPassword
PageSize = prefs.pageSize
AsOfDate = prefs.asOfDateDisplay.code
Visibility =
match true with
| _ when prefs.isPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
@ -411,53 +437,54 @@ module EditPreferences =
[<CLIMutable; NoComparison; NoEquality>]
type EditRequest =
{ /// The Id of the request
requestId : PrayerRequestId
RequestId : PrayerRequestId
/// The type of the request
requestType : string
RequestType : string
/// The date of the request
enteredDate : DateTime option
EnteredDate : DateTime option
/// Whether to update the date or not
skipDateUpdate : bool option
SkipDateUpdate : bool option
/// The requestor or subject
requestor : string option
Requestor : string option
/// How this request is expired
expiration : string
Expiration : string
/// The text of the request
text : string
Text : string
}
with
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
member this.IsNew
with get () = Guid.Empty = this.RequestId
/// Support for the EditRequest type
module EditRequest =
/// An empty instance to use for new requests
let empty =
{ requestId = Guid.Empty
requestType = CurrentRequest.code
enteredDate = None
skipDateUpdate = None
requestor = None
expiration = Automatic.code
text = ""
{ RequestId = Guid.Empty
RequestType = CurrentRequest.code
EnteredDate = None
SkipDateUpdate = None
Requestor = None
Expiration = Automatic.code
Text = ""
}
/// Create an instance from an existing request
let fromRequest req =
{ empty with
requestId = req.prayerRequestId
requestType = req.requestType.code
requestor = req.requestor
expiration = req.expiration.code
text = req.text
RequestId = req.prayerRequestId
RequestType = req.requestType.code
Requestor = req.requestor
Expiration = req.expiration.code
Text = req.text
}
@ -465,41 +492,42 @@ module EditRequest =
[<CLIMutable; NoComparison; NoEquality>]
type EditSmallGroup =
{ /// The Id of the small group
smallGroupId : SmallGroupId
SmallGroupId : SmallGroupId
/// The name of the small group
name : string
Name : string
/// The Id of the church to which this small group belongs
churchId : ChurchId
ChurchId : ChurchId
}
with
/// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId
member this.IsNew
with get () = Guid.Empty = this.SmallGroupId
/// Populate a small group from this form
member this.populateGroup (grp : SmallGroup) =
{ grp with
name = this.name
churchId = this.churchId
}
name = this.Name
churchId = this.ChurchId
}
/// Support for the EditSmallGroup type
module EditSmallGroup =
/// Create an instance from an existing small group
let fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId
name = g.name
churchId = g.churchId
{ SmallGroupId = g.smallGroupId
Name = g.name
ChurchId = g.churchId
}
/// An empty instance (used when adding a new group)
let empty =
{ smallGroupId = Guid.Empty
name = ""
churchId = Guid.Empty
{ SmallGroupId = Guid.Empty
Name = ""
ChurchId = Guid.Empty
}
@ -507,65 +535,66 @@ module EditSmallGroup =
[<CLIMutable; NoComparison; NoEquality>]
type EditUser =
{ /// The Id of the user
userId : UserId
UserId : UserId
/// The first name of the user
firstName : string
FirstName : string
/// The last name of the user
lastName : string
LastName : string
/// The e-mail address for the user
emailAddress : string
Email : string
/// The password for the user
password : string
Password : string
/// The password hash for the user a second time
passwordConfirm : string
PasswordConfirm : string
/// Is this user a PrayerTracker administrator?
isAdmin : bool option
IsAdmin : bool option
}
with
/// Is this a new user?
member this.isNew () = Guid.Empty = this.userId
member this.IsNew
with get () = Guid.Empty = this.UserId
/// Populate a user from the form
member this.populateUser (user : User) hasher =
member this.PopulateUser (user : User) hasher =
{ user with
firstName = this.firstName
lastName = this.lastName
emailAddress = this.emailAddress
isAdmin = match this.isAdmin with Some x -> x | None -> false
firstName = this.FirstName
lastName = this.LastName
emailAddress = this.Email
isAdmin = defaultArg this.IsAdmin false
}
|> function
| u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password }
| u when isNull this.Password || this.Password = "" -> u
| u -> { u with passwordHash = hasher this.Password }
/// Support for the EditUser type
module EditUser =
/// An empty instance
let empty =
{ userId = Guid.Empty
firstName = ""
lastName = ""
emailAddress = ""
password = ""
passwordConfirm = ""
isAdmin = None
{ UserId = Guid.Empty
FirstName = ""
LastName = ""
Email = ""
Password = ""
PasswordConfirm = ""
IsAdmin = None
}
/// Create an instance from an existing user
let fromUser (user : User) =
{ empty with
userId = user.userId
firstName = user.firstName
lastName = user.lastName
emailAddress = user.emailAddress
isAdmin = match user.isAdmin with true -> Some true | false -> None
UserId = user.userId
FirstName = user.firstName
LastName = user.lastName
Email = user.emailAddress
IsAdmin = if user.isAdmin then Some true else None
}
@ -573,13 +602,13 @@ module EditUser =
[<CLIMutable; NoComparison; NoEquality>]
type GroupLogOn =
{ /// The ID of the small group to which the user is logging on
smallGroupId : SmallGroupId
SmallGroupId : SmallGroupId
/// The password entered
password : string
Password : string
/// Whether to remember the login
rememberMe : bool option
RememberMe : bool option
}
/// Support for the GroupLogOn type
@ -587,9 +616,9 @@ module GroupLogOn =
/// An empty instance
let empty =
{ smallGroupId = Guid.Empty
password = ""
rememberMe = None
{ SmallGroupId = Guid.Empty
Password = ""
RememberMe = None
}
@ -597,19 +626,19 @@ module GroupLogOn =
[<NoComparison; NoEquality>]
type MaintainRequests =
{ /// The requests to be displayed
requests : PrayerRequest seq
Requests : PrayerRequest list
/// The small group to which the requests belong
smallGroup : SmallGroup
SmallGroup : SmallGroup
/// Whether only active requests are included
onlyActive : bool option
OnlyActive : bool option
/// The search term for the requests
searchTerm : string option
SearchTerm : string option
/// The page number of the results
pageNbr : int option
PageNbr : int option
}
/// Support for the MaintainRequests type
@ -617,11 +646,11 @@ module MaintainRequests =
/// An empty instance
let empty =
{ requests = Seq.empty
smallGroup = SmallGroup.empty
onlyActive = None
searchTerm = None
pageNbr = None
{ Requests = []
SmallGroup = SmallGroup.empty
OnlyActive = None
SearchTerm = None
PageNbr = None
}
@ -629,16 +658,16 @@ module MaintainRequests =
[<NoComparison; NoEquality>]
type Overview =
{ /// The total number of active requests
totalActiveReqs : int
TotalActiveReqs : int
/// The numbers of active requests by category
activeReqsByCat : Map<PrayerRequestType, int>
/// The numbers of active requests by request type
ActiveReqsByType : Map<PrayerRequestType, int>
/// A count of all requests
allReqs : int
AllReqs : int
/// A count of all members
totalMbrs : int
TotalMembers : int
}
@ -646,19 +675,19 @@ type Overview =
[<CLIMutable; NoComparison; NoEquality>]
type UserLogOn =
{ /// The e-mail address of the user
emailAddress : string
Email : string
/// The password entered
password : string
Password : string
/// The ID of the small group to which the user is logging on
smallGroupId : SmallGroupId
SmallGroupId : SmallGroupId
/// Whether to remember the login
rememberMe : bool option
RememberMe : bool option
/// The URL to which the user should be redirected once login is successful
redirectUrl : string option
RedirectUrl : string option
}
/// Support for the UserLogOn type
@ -666,11 +695,11 @@ module UserLogOn =
/// An empty instance
let empty =
{ emailAddress = ""
password = ""
smallGroupId = Guid.Empty
rememberMe = None
redirectUrl = None
{ Email = ""
Password = ""
SmallGroupId = Guid.Empty
RememberMe = None
RedirectUrl = None
}
@ -679,64 +708,64 @@ open Giraffe.ViewEngine
/// This represents a list of requests
type RequestList =
{ /// The prayer request list
requests : PrayerRequest list
Requests : PrayerRequest list
/// The date for which this list is being generated
date : DateTime
Date : DateTime
/// The small group to which this list belongs
listGroup : SmallGroup
SmallGroup : SmallGroup
/// Whether to show the class header
showHeader : bool
ShowHeader : bool
/// The list of recipients (populated if requests are e-mailed)
recipients : Member list
Recipients : Member list
/// Whether the user can e-mail this list
canEmail : bool
CanEmail : bool
}
with
/// Group requests by their type, along with the type and its localized string
member private this.requestsByType (s : IStringLocalizer) =
member this.RequestsByType (s : IStringLocalizer) =
ReferenceList.requestTypeList s
|> List.map (fun (typ, name) -> typ, name, this.requests |> List.filter (fun req -> req.requestType = typ))
|> List.map (fun (typ, name) ->
let sort =
match this.SmallGroup.preferences.requestSort with
| SortByDate -> Seq.sortByDescending (fun req -> req.updatedDate)
| SortByRequestor -> Seq.sortBy (fun req -> req.requestor)
let reqs =
this.Requests
|> Seq.ofList
|> Seq.filter (fun req -> req.requestType = typ)
|> sort
|> List.ofSeq
typ, name, reqs)
|> List.filter (fun (_, _, reqs) -> not (List.isEmpty reqs))
/// Get the requests for a specified type
member this.requestsInCategory cat =
let reqs =
this.requests
|> Seq.ofList
|> Seq.filter (fun req -> req.requestType = cat)
match this.listGroup.preferences.requestSort with
| SortByDate -> reqs |> Seq.sortByDescending (fun req -> req.updatedDate)
| SortByRequestor -> reqs |> Seq.sortBy (fun req -> req.requestor)
|> List.ofSeq
/// Is this request new?
member this.isNew (req : PrayerRequest) =
(this.date - req.updatedDate).Days <= this.listGroup.preferences.daysToKeepNew
member this.IsNew (req : PrayerRequest) =
(this.Date - req.updatedDate).Days <= this.SmallGroup.preferences.daysToKeepNew
/// Generate this list as HTML
member this.asHtml (s : IStringLocalizer) =
let prefs = this.listGroup.preferences
member this.AsHtml (s : IStringLocalizer) =
let prefs = this.SmallGroup.preferences
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}" ] [
span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
strong [] [ str s["Prayer Requests"].Value ]
]
br []
span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
strong [] [ str this.listGroup.name ]
strong [] [ str this.SmallGroup.name ]
br []
str (this.date.ToString s["MMMM d, yyyy"].Value)
str (this.Date.ToString s["MMMM d, yyyy"].Value)
]
]
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;" ] [
table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [
tr [] [
@ -748,7 +777,7 @@ with
]
reqs
|> 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;" ] [
match req.requestor with
| Some r when r <> "" ->
@ -776,25 +805,25 @@ with
|> RenderView.AsString.htmlNodes
/// Generate this list as plain text
member this.asText (s : IStringLocalizer) =
member this.AsText (s : IStringLocalizer) =
seq {
this.listGroup.name
this.SmallGroup.name
s["Prayer Requests"].Value
this.date.ToString s["MMMM d, yyyy"].Value
this.Date.ToString s["MMMM d, yyyy"].Value
" "
for _, name, reqs in this.requestsByType s do
for _, name, reqs in this.RequestsByType s do
let dashes = String.replicate (name.Value.Length + 4) "-"
dashes
$" {name.Value.ToUpper ()}"
dashes
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 -> ""
match this.listGroup.preferences.asOfDateDisplay with
match this.SmallGroup.preferences.asOfDateDisplay with
| NoDisplay -> ""
| _ ->
let dt =
match this.listGroup.preferences.asOfDateDisplay with
match this.SmallGroup.preferences.asOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString ()
| _ -> ""

14
src/PrayerTracker/Church.fs
View File

@ -70,17 +70,17 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m ->
let! church =
if m.isNew () then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () })
else ctx.db.TryChurchById m.churchId
if m.IsNew then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () })
else ctx.db.TryChurchById m.ChurchId
match church with
| Some ch ->
m.populateChurch ch
|> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
m.PopulateChurch ch
|> (if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} church “{1}”", act, m.name]
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} church “{1}”", act, m.Name]
return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}

18
src/PrayerTracker/CommonFunctions.fs
View File

@ -85,11 +85,11 @@ let viewInfo (ctx : HttpContext) startTicks =
HttpOnly = true))
| None -> ()
{ AppViewInfo.fresh with
version = appVersion
messages = msg
requestStart = startTicks
user = ctx.Session.user
group = ctx.Session.smallGroup
Version = appVersion
Messages = msg
RequestStart = startTicks
User = ctx.Session.user
Group = ctx.Session.smallGroup
}
/// The view is the last parameter, so it can be composed
@ -130,19 +130,19 @@ let htmlString (x : LocalizedString) =
/// Add an error message to the session
let addError ctx msg =
addUserMessage ctx { UserMessage.error with text = htmlLocString msg }
addUserMessage ctx { UserMessage.error with Text = htmlLocString msg }
/// Add an informational message to the session
let addInfo ctx msg =
addUserMessage ctx { UserMessage.info with text = htmlLocString msg }
addUserMessage ctx { UserMessage.info with Text = htmlLocString msg }
/// Add an informational HTML message to the session
let addHtmlInfo ctx msg =
addUserMessage ctx { UserMessage.info with text = htmlString msg }
addUserMessage ctx { UserMessage.info with Text = htmlString msg }
/// Add a warning message to the session
let addWarning ctx msg =
addUserMessage ctx { UserMessage.warning with text = htmlLocString msg }
addUserMessage ctx { UserMessage.warning with Text = htmlLocString msg }
/// A level of required access

14
src/PrayerTracker/Email.fs
View File

@ -21,7 +21,7 @@ let getConnection () = task {
/// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj =
let msg = MimeMessage ()
let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress))
msg.Subject <- subj
msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress))
@ -40,7 +40,7 @@ let createHtmlMessage grp subj body (s : IStringLocalizer) =
]
|> String.concat ""
let msg = createMessage grp subj
msg.Body <- TextPart (TextFormat.Html, Text = bodyText)
msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg
/// Create a plain-text-format e-mail message
@ -54,13 +54,13 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
]
|> String.concat ""
let msg = createMessage grp subj
msg.Body <- TextPart (TextFormat.Plain, Text = bodyText)
msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
msg
/// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
let htmlMsg = createHtmlMessage grp subj html s
let plainTextMsg = createTextMessage grp subj text s
use htmlMsg = createHtmlMessage grp subj html s
use plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do
let emailType =
@ -71,10 +71,10 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
match emailType with
| HtmlFormat ->
htmlMsg.To.Add emailTo
do! client.SendAsync htmlMsg
let! _ = client.SendAsync htmlMsg
htmlMsg.To.Clear ()
| PlainTextFormat ->
plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg
let! _ = client.SendAsync plainTextMsg
plainTextMsg.To.Clear ()
}

98
src/PrayerTracker/PrayerRequest.fs
View File

@ -16,8 +16,8 @@ let private findRequest (ctx : HttpContext) reqId = task {
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s["The prayer request you tried to access is not assigned to your group"]
return Error (redirectTo false "/web/unauthorized")
| None -> return Error fourOhFour
return Result.Error (redirectTo false "/web/unauthorized")
| None -> return Result.Error fourOhFour
}
/// Generate a list of requests for the given date
@ -27,12 +27,12 @@ let private generateRequestList ctx date = task {
let listDate = match date with Some d -> d | None -> grp.localDateNow clock
let! reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
return
{ requests = reqs |> List.ofSeq
date = listDate
listGroup = grp
showHeader = true
canEmail = ctx.Session.user |> Option.isSome
recipients = []
{ Requests = reqs
Date = listDate
SmallGroup = grp
ShowHeader = true
CanEmail = Option.isSome ctx.Session.user
Recipients = []
}
}
@ -50,7 +50,7 @@ let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fu
let now = grp.localDateNow (ctx.GetService<IClock> ())
if reqId = Guid.Empty then
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
|> renderHtml next ctx
else
@ -59,18 +59,18 @@ let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fu
let s = Views.I18N.localizer.Force ()
if req.isExpired now grp.preferences.daysToExpire then
{ UserMessage.warning with
text = htmlLocString s["This request is expired."]
description =
Text = htmlLocString s["This request is expired."]
Description =
s["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
s["Expire Immediately"], s["Check to not update the date"]]
|> (htmlLocString >> Some)
}
|> addUserMessage ctx
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.fromRequest req) "" ctx
|> renderHtml next ctx
| Error e -> return! e next ctx
| Result.Error e -> return! e next ctx
}
@ -84,11 +84,11 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients
grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
(list.asHtml s) (list.asText s) s
grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.Date].Value
(list.AsHtml s) (list.AsText s) s
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.email { list with recipients = recipients }
|> Views.PrayerRequest.email { list with Recipients = recipients }
|> renderHtml next ctx
}
@ -102,7 +102,7 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["The prayer request was deleted successfully"]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
| Result.Error e -> return! e next ctx
}
@ -115,7 +115,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
| Result.Error e -> return! e next ctx
}
@ -129,12 +129,12 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.list
{ requests = reqs
date = grp.localDateNow clock
listGroup = grp
showHeader = true
canEmail = ctx.Session.user |> Option.isSome
recipients = []
{ Requests = reqs
Date = grp.localDateNow clock
SmallGroup = grp
ShowHeader = true
CanEmail = Option.isSome ctx.Session.user
Recipients = []
}
|> renderHtml next ctx
| Some _ ->
@ -165,29 +165,29 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
let pageNbr =
match ctx.GetQueryStringValue "page" with
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Error _ -> 1
| Result.Error _ -> 1
let! m = backgroundTask {
match ctx.GetQueryStringValue "search" with
| Ok search ->
let! reqs = ctx.db.SearchRequestsForSmallGroup grp search pageNbr
return
{ MaintainRequests.empty with
requests = reqs
searchTerm = Some search
pageNbr = Some pageNbr
Requests = reqs
SearchTerm = Some search
PageNbr = Some pageNbr
}
| Error _ ->
| Result.Error _ ->
let! reqs = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
return
{ MaintainRequests.empty with
requests = reqs
onlyActive = Some onlyActive
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
Requests = reqs
OnlyActive = Some onlyActive
PageNbr = if onlyActive then None else Some pageNbr
}
}
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
{ viewInfo ctx startTicks with HelpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with SmallGroup = grp } ctx
|> renderHtml next ctx
}
@ -210,7 +210,7 @@ let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> tas
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
| Result.Error e -> return! e next ctx
}
@ -219,38 +219,38 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ct
match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m ->
let! req =
if m.isNew () then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
else ctx.db.TryRequestById m.requestId
if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
else ctx.db.TryRequestById m.RequestId
match req with
| Some pr ->
let upd8 =
{ pr with
requestType = PrayerRequestType.fromCode m.requestType
requestor = match m.requestor with Some x when x.Trim () = "" -> None | x -> x
text = ckEditorToText m.text
expiration = Expiration.fromCode m.expiration
requestType = PrayerRequestType.fromCode m.RequestType
requestor = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x
text = ckEditorToText m.Text
expiration = Expiration.fromCode m.Expiration
}
let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ())
match m.isNew () with
match m.IsNew with
| true ->
let dt = match m.enteredDate with Some x -> x | None -> now
let dt = defaultArg m.EnteredDate now
{ upd8 with
smallGroupId = grp.smallGroupId
userId = (currentUser ctx).userId
enteredDate = dt
updatedDate = dt
}
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
| false when defaultArg m.SkipDateUpdate false -> upd8
| 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 s = Views.I18N.localizer.Force ()
let act = if m.isNew () then "Added" else "Updated"
addInfo ctx s["Successfully {0} prayer request", s.[act].Value.ToLower ()]
let act = if m.IsNew then "Added" else "Updated"
addInfo ctx s["Successfully {0} prayer request", s[act].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -260,6 +260,6 @@ let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx ->
let! list = generateRequestList ctx (parseListDate date)
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.view { list with showHeader = false }
|> Views.PrayerRequest.view { list with ShowHeader = false }
|> renderHtml next ctx
}

10
src/PrayerTracker/PrayerTracker.fsproj
View File

@ -1,7 +1,9 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<OutputType>Exe</OutputType>
<PublishSingleFile>True</PublishSingleFile>
<SelfContained>False</SelfContained>
</PropertyGroup>
<ItemGroup>
@ -23,9 +25,9 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.5" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
<ItemGroup>

104
src/PrayerTracker/SmallGroup.fs
View File

@ -21,7 +21,7 @@ let private setGroupCookie (ctx : HttpContext) pwHash =
/// GET /small-group/announcement
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
|> renderHtml next ctx
@ -31,13 +31,13 @@ let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=>
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupById groupId with
| Some grp ->
let! reqs = ctx.db.CountRequestsBySmallGroup groupId
let! usrs = ctx.db.CountUsersBySmallGroup groupId
let! reqs = ctx.db.CountRequestsBySmallGroup groupId
let! users = ctx.db.CountUsersBySmallGroup groupId
ctx.db.RemoveEntry grp
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs]
grp.name, reqs, users]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
}
@ -82,18 +82,18 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=>
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
if memberId = Guid.Empty then
return!
viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|> Views.SmallGroup.editMember EditMember.empty types ctx
|> renderHtml next ctx
else
match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
|> renderHtml next ctx
| Some _
| None -> return! fourOhFour next ctx
@ -102,12 +102,12 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=>
/// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
let startTicks = DateTime.Now.Ticks
let! groups = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx
{ viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|> Views.SmallGroup.logOn groups grpId ctx
|> renderHtml next ctx
}
@ -117,28 +117,26 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with
match! ctx.db.TryGroupLogOnByPassword m.SmallGroupId m.Password with
| Some grp ->
ctx.Session.smallGroup <- Some grp
match m.rememberMe with
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
| _ -> ()
if defaultArg m.RememberMe false then (setGroupCookie ctx << sha1Hash) m.Password
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx
| None ->
addError ctx s["Password incorrect - login unsuccessful"]
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx
| Error e -> return! bindError e next ctx
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.SmallGroupId}" next ctx
| Result.Error e -> return! bindError e next ctx
}
/// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.AllGroups ()
let! groups = ctx.db.AllGroups ()
return!
viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx
|> Views.SmallGroup.maintain groups ctx
|> renderHtml next ctx
}
@ -148,11 +146,11 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx
let s = Views.I18N.localizer.Force ()
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
let! members = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members mbrs typs ctx
{ viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members members types ctx
|> renderHtml next ctx
}
@ -165,10 +163,10 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let m =
{ totalActiveReqs = List.length reqs
allReqs = reqCount
totalMbrs = mbrCount
activeReqsByCat =
{ TotalActiveReqs = List.length reqs
AllReqs = reqCount
TotalMembers = mbrCount
ActiveReqsByType =
(reqs
|> Seq.ofList
|> Seq.map (fun req -> req.requestType)
@ -188,7 +186,7 @@ let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
let startTicks = DateTime.Now.Ticks
let! tzs = ctx.db.AllTimeZones ()
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
|> renderHtml next ctx
}
@ -200,22 +198,22 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
| Ok m ->
let s = Views.I18N.localizer.Force ()
let! group =
if m.isNew () then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
else ctx.db.TryGroupById m.smallGroupId
if m.IsNew then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
else ctx.db.TryGroupById m.SmallGroupId
match group with
| Some grp ->
m.populateGroup grp
|> function
| grp when m.isNew () ->
| grp when m.IsNew ->
ctx.db.AddEntry grp
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync ()
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.name]
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.Name]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -225,25 +223,25 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun n
| Ok m ->
let grp = currentGroup ctx
let! mMbr =
if m.isNew () then
if m.IsNew then
Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId })
else ctx.db.TryMemberById m.memberId
else ctx.db.TryMemberById m.MemberId
match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
{ mbr with
memberName = m.memberName
email = m.emailAddress
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
memberName = m.Name
email = m.Email
format = match m.Format with "" | null -> None | _ -> Some m.Format
}
|> (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 s = Views.I18N.localizer.Force ()
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/web/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -256,7 +254,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
// database values, not the then out-of-sync session ones.
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
| Some grp ->
let prefs = m.populatePreferences grp.preferences
let prefs = m.PopulatePreferences grp.preferences
ctx.db.UpdateEntry prefs
let! _ = ctx.db.SaveChangesAsync ()
// Refresh session instance
@ -265,7 +263,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
addInfo ctx s["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -279,7 +277,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
let now = grp.localTimeNow (ctx.GetService<IClock> ())
let s = Views.I18N.localizer.Force ()
// Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text
let requestText = ckEditorToText m.Text
let htmlText =
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
[ rawText requestText ]
@ -287,7 +285,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails
let! recipients =
match m.sendToClass with
match m.SendToClass with
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers ()
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
@ -296,7 +294,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
(now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s
// Add to the request list if desired
match m.sendToClass, m.addToRequestList with
match m.SendToClass, m.AddToRequestList with
| "N", _
| _, None -> ()
| _, Some x when not x -> ()
@ -305,7 +303,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
prayerRequestId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
userId = usr.userId
requestType = (Option.get >> PrayerRequestType.fromCode) m.requestType
requestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType
text = requestText
enteredDate = now
updatedDate = now
@ -315,14 +313,14 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
()
// Tell 'em what they've won, Johnny!
let toWhom =
match m.sendToClass with
match m.SendToClass with
| "N" -> s["{0} users", s["PrayerTracker"]].Value
| _ -> s["Group Members"].Value.ToLower ()
let andAdded = match m.addToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
let andAdded = match m.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
return!
viewInfo ctx startTicks
|> Views.SmallGroup.announcementSent { m with text = htmlText }
|> Views.SmallGroup.announcementSent { m with Text = htmlText }
|> renderHtml next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}

76
src/PrayerTracker/User.fs
View File

@ -23,18 +23,18 @@ let private setUserCookie (ctx : HttpContext) pwHash =
/// 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
let private findUserByPassword m (db : AppDbContext) = task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
match! db.TryUserByEmailAndGroup m.Email m.SmallGroupId with
| Some u when Option.isSome u.salt ->
// Already upgraded; match = success
let pwHash = pbkdf2Hash (Option.get u.salt) m.password
let pwHash = pbkdf2Hash (Option.get u.salt) m.Password
if u.passwordHash = pwHash then
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
else return None, ""
| Some u when u.passwordHash = sha1Hash m.password ->
| Some u when u.passwordHash = sha1Hash m.Password ->
// Not upgraded, but password is good; upgrade 'em!
// Upgrade 'em!
let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password
let pwHash = pbkdf2Hash salt m.Password
let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
@ -54,16 +54,16 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> f
match dbUsr with
| Some usr ->
// 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
| _ -> Task.FromResult None
match user with
| Some _ when m.newPassword = m.newPasswordConfirm ->
| Some _ when m.NewPassword = m.NewPasswordConfirm ->
match dbUsr with
| Some usr ->
// Generate new salt whenever the password is changed
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 ()
// 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
@ -76,7 +76,7 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> f
| None ->
addError ctx s["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -99,26 +99,26 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSR
| Ok m ->
let s = Views.I18N.localizer.Force ()
let! usr, pwHash = findUserByPassword m ctx.db
let! grp = ctx.db.TryGroupById m.smallGroupId
let! grp = ctx.db.TryGroupById m.SmallGroupId
let nextUrl =
match usr with
| Some _ ->
ctx.Session.user <- usr
ctx.Session.smallGroup <- grp
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
if defaultArg m.RememberMe false then setUserCookie ctx pwHash
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
match m.redirectUrl with
match m.RedirectUrl with
| None -> "/web/small-group"
| Some x when x = "" -> "/web/small-group"
| Some x -> x
| _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.error with
text = htmlLocString s["Invalid credentials - log on unsuccessful"]
description =
Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
Description =
[ s["This is likely due to one of the following reasons"].Value
":<ul><li>"
s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value
s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.Email].Value
"</li><li>"
s["The password entered does not match the password for the given e-mail address."].Value
"</li><li>"
@ -132,7 +132,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSR
|> addUserMessage ctx
"/web/user/log-on"
return! redirectTo false nextUrl next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -167,8 +167,8 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
addWarning ctx s["The page you requested requires authentication; please log on below."]
| None -> ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx
{ viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with RedirectUrl = url } groups ctx
|> renderHtml next ctx
}
@ -186,7 +186,7 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
/// GET /user/password
let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.changePassword }
{ viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.changePassword }
|> Views.User.changePassword ctx
|> renderHtml next ctx
@ -196,13 +196,13 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
match! ctx.TryBindFormAsync<EditUser> () with
| Ok m ->
let! user =
if m.isNew () then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
else ctx.db.TryUserById m.userId
if m.IsNew then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
else ctx.db.TryUserById m.UserId
let saltedUser =
match user with
| Some u ->
match u.salt with
| None when m.password <> "" ->
| None when m.Password <> "" ->
// Generate salt so that a new password hash can be generated
Some { u with salt = Some (Guid.NewGuid ()) }
| _ ->
@ -211,15 +211,15 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
| _ -> user
match saltedUser with
| Some u ->
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
if m.isNew () then
if m.IsNew then
let h = CommonFunctions.htmlString
{ UserMessage.info with
text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
description =
Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
Description =
h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName]
|> Some
@ -230,7 +230,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -239,31 +239,31 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun
match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with
match Seq.length m.SmallGroups with
| 0 ->
addError ctx s["You must select at least one group to assign"]
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
return! redirectTo false $"/web/user/{flatGuid m.UserId}/small-groups" next ctx
| _ ->
match! ctx.db.TryUserByIdWithGroups m.userId with
match! ctx.db.TryUserByIdWithGroups m.UserId with
| Some user ->
let grps =
m.smallGroups.Split ','
let groups =
m.SmallGroups.Split ','
|> Array.map Guid.Parse
|> List.ofArray
user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> Seq.filter (fun x -> not (groups |> List.exists (fun y -> y = x.smallGroupId)))
|> ctx.db.UserGroupXref.RemoveRange
grps
groups
|> Seq.ofList
|> 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 })
|> List.ofSeq
|> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully updated group permissions for {0}", m.userName]
addInfo ctx s["Successfully updated group permissions for {0}", m.UserName]
return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
| Result.Error e -> return! bindError e next ctx
}
@ -272,11 +272,11 @@ let smallGroups userId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx
let startTicks = DateTime.Now.Ticks
match! ctx.db.TryUserByIdWithGroups userId with
| Some user ->
let! grps = ctx.db.GroupList ()
let! groups = ctx.db.GroupList ()
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return!
viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}

6
src/PrayerTracker/wwwroot/js/app.js
View File

@ -210,8 +210,8 @@ const PT = {
*/
toggleType(name) {
const isNamed = document.getElementById(`${name}Type_Name`)
const named = document.getElementById(`${name}Color_Select`)
const custom = document.getElementById(`${name}Color_Color`)
const named = document.getElementById(`${name}_Select`)
const custom = document.getElementById(`${name}_Color`)
if (isNamed.checked) {
custom.disabled = true
named.disabled = false
@ -244,7 +244,7 @@ const PT = {
PT.smallGroup.preferences.checkVisibility)
})
PT.smallGroup.preferences.checkVisibility()
;['headingLine', 'headingText'].map(name => {
;['lineColor', 'headingColor'].map(name => {
document.getElementById(`${name}Type_Name`).addEventListener('click', () => {
PT.smallGroup.preferences.toggleType(name)
})