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

Version 8 #43

Merged
danieljsummers merged 37 commits from version-8 into main 2022-08-19 19:08:31 +00:00
Conversation 0 Commits 37 Files Changed 58 +1903 -1734
27 changed files with 1903 additions and 1734 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit e1bdad15f7 - Show all commits

8
src/Directory.Build.props
View File

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

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

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

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

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

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

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

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

@ -61,10 +61,12 @@ let emailFormatTests =
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
} }
test "fromCode P should return ShortDate" { test "fromCode P should return ShortDate" {
Expect.equal (EmailFormat.fromCode "P") PlainTextFormat "\"P\" should have been converted to PlainTextFormat" Expect.equal (EmailFormat.fromCode "P") PlainTextFormat
"\"P\" should have been converted to PlainTextFormat"
} }
test "fromCode Z should raise" { test "fromCode Z should raise" {
Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore) "An unknown code should have raised an exception" Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore)
"An unknown code should have raised an exception"
} }
] ]
@ -90,7 +92,8 @@ let expirationTests =
Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced" Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced"
} }
test "fromCode V should raise" { test "fromCode V should raise" {
Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) "An unknown code should have raised an exception" Expect.throws (fun () -> Expiration.fromCode "V" |> ignore)
"An unknown code should have raised an exception"
} }
] ]
@ -106,7 +109,8 @@ let listPreferencesTests =
Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker"
Expect.equal mt.emailFromAddress "prayer@djs-consulting.com" Expect.equal mt.emailFromAddress "prayer@djs-consulting.com"
"The default e-mail from address should have been prayer@djs-consulting.com" "The default e-mail from address should have been prayer@djs-consulting.com"
Expect.equal mt.listFonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" "The default list fonts were incorrect" 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.headingColor "maroon" "The default heading text color should have been maroon"
Expect.equal mt.lineColor "navy" "The default heding line color should have been navy" Expect.equal mt.lineColor "navy" "The default heding line color should have been navy"
Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16" Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16"
@ -164,7 +168,8 @@ let prayerRequestTests =
} }
test "isExpired always returns false for long term/recurring requests" { test "isExpired always returns false for long term/recurring requests" {
let req = { PrayerRequest.empty with requestType = LongTermRequest } let req = { PrayerRequest.empty with requestType = LongTermRequest }
Expect.isFalse (req.isExpired DateTime.Now 0) "A recurring/long-term request should never be considered expired" 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" { test "isExpired always returns true for force-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced } let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced }
@ -183,7 +188,8 @@ let prayerRequestTests =
test "isExpired returns true for same-day expired requests" { test "isExpired returns true for same-day expired requests" {
let now = DateTime.Now let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. } let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. }
Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired" Expect.isTrue (req.isExpired now 7)
"A request entered a second before midnight should be considered expired"
} }
test "updateRequired returns false for expired requests" { test "updateRequired returns false for expired requests" {
let req = { PrayerRequest.empty with expiration = Forced } let req = { PrayerRequest.empty with expiration = Forced }
@ -238,13 +244,15 @@ let prayerRequestTypeTests =
"\"L\" should have been converted to LongTermRequest" "\"L\" should have been converted to LongTermRequest"
} }
test "fromCode P should return PraiseReport" { test "fromCode P should return PraiseReport" {
Expect.equal (PrayerRequestType.fromCode "P") PraiseReport "\"P\" should have been converted to PraiseReport" Expect.equal (PrayerRequestType.fromCode "P") PraiseReport
"\"P\" should have been converted to PraiseReport"
} }
test "fromCode E should return Expecting" { test "fromCode E should return Expecting" {
Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting" Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting"
} }
test "fromCode A should return Announcement" { test "fromCode A should return Announcement" {
Expect.equal (PrayerRequestType.fromCode "A") Announcement "\"A\" should have been converted to Announcement" Expect.equal (PrayerRequestType.fromCode "A") Announcement
"\"A\" should have been converted to Announcement"
} }
test "fromCode R should raise" { test "fromCode R should raise" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore) Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore)
@ -265,10 +273,12 @@ let requestSortTests =
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
} }
test "fromCode R should return SortByRequestor" { test "fromCode R should return SortByRequestor" {
Expect.equal (RequestSort.fromCode "R") SortByRequestor "\"R\" should have been converted to SortByRequestor" Expect.equal (RequestSort.fromCode "R") SortByRequestor
"\"R\" should have been converted to SortByRequestor"
} }
test "fromCode Q should raise" { test "fromCode Q should raise" {
Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore) "An unknown code should have raised an exception" Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore)
"An unknown code should have raised an exception"
} }
] ]
@ -294,7 +304,10 @@ let smallGroupTests =
yield! testFixture withFakeClock [ yield! testFixture withFakeClock [
"localTimeNow adjusts the time ahead of UTC", "localTimeNow adjusts the time ahead of UTC",
fun clock -> fun clock ->
let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" } } 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" Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours"
"localTimeNow adjusts the time behind UTC", "localTimeNow adjusts the time behind UTC",
fun clock -> fun clock ->

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

@ -17,7 +17,8 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="9.0.4" /> <PackageReference Include="Expecto" Version="9.0.4" />
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" /> <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>
<ItemGroup> <ItemGroup>

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

@ -1,12 +1,12 @@
module PrayerTracker.UI.CommonFunctionsTests module PrayerTracker.UI.CommonFunctionsTests
open System.IO
open Expecto open Expecto
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Microsoft.AspNetCore.Mvc.Localization open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open PrayerTracker.Tests.TestLocalization open PrayerTracker.Tests.TestLocalization
open PrayerTracker.Views open PrayerTracker.Views
open System.IO
[<Tests>] [<Tests>]
@ -14,7 +14,7 @@ let iconSizedTests =
testList "iconSized" [ testList "iconSized" [
test "succeeds" { test "succeeds" {
let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode let ico = iconSized 18 "tom-&-jerry" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons md-18\">tom-&-jerry</i>" "icon HTML not correct" Expect.equal ico """<i class="material-icons md-18">tom-&-jerry</i>""" "icon HTML not correct"
} }
] ]
@ -23,7 +23,7 @@ let iconTests =
testList "icon" [ testList "icon" [
test "succeeds" { test "succeeds" {
let ico = icon "bob-&-tom" |> renderHtmlNode let ico = icon "bob-&-tom" |> renderHtmlNode
Expect.equal ico "<i class=\"material-icons\">bob-&-tom</i>" "icon HTML not correct" Expect.equal ico """<i class="material-icons">bob-&-tom</i>""" "icon HTML not correct"
} }
] ]
@ -41,23 +41,23 @@ let namedColorListTests =
testList "namedColorList" [ testList "namedColorList" [
test "succeeds with default values" { test "succeeds with default values" {
let expected = let expected =
[ "<select name=\"the-name\">" [ """<select name="the-name">"""
"<option value=\"aqua\" style=\"background-color:aqua;color:black;\">aqua</option>" """<option value="aqua" style="background-color:aqua;color:black;">aqua</option>"""
"<option value=\"black\" style=\"background-color:black;color:white;\">black</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="blue" style="background-color:blue;color:white;">blue</option>"""
"<option value=\"fuchsia\" style=\"background-color:fuchsia;color:black;\">fuchsia</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="gray" style="background-color:gray;color:white;">gray</option>"""
"<option value=\"green\" style=\"background-color:green;color:white;\">green</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="lime" style="background-color:lime;color:black;">lime</option>"""
"<option value=\"maroon\" style=\"background-color:maroon;color:white;\">maroon</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="navy" style="background-color:navy;color:white;">navy</option>"""
"<option value=\"olive\" style=\"background-color:olive;color:white;\">olive</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="purple" style="background-color:purple;color:white;">purple</option>"""
"<option value=\"red\" style=\"background-color:red;color:black;\">red</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="silver" style="background-color:silver;color:black;">silver</option>"""
"<option value=\"teal\" style=\"background-color:teal;color:white;\">teal</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="white" style="background-color:white;color:black;">white</option>"""
"<option value=\"yellow\" style=\"background-color:yellow;color:black;\">yellow</option>" """<option value="yellow" style="background-color:yellow;color:black;">yellow</option>"""
"</select>" "</select>"
] ]
|> String.concat "" |> String.concat ""
@ -70,7 +70,7 @@ let namedColorListTests =
} }
test "succeeds with extra attributes" { test "succeeds with extra attributes" {
let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode let selectList = namedColorList "the-name" "" [ _id "myId" ] _s |> renderHtmlNode
Expect.stringStarts selectList "<select name=\"the-name\" id=\"myId\">" "Attributes not included correctly" Expect.stringStarts selectList """<select name="the-name" id="myId">""" "Attributes not included correctly"
} }
] ]
@ -79,12 +79,12 @@ let radioTests =
testList "radio" [ testList "radio" [
test "succeeds when not selected" { test "succeeds when not selected" {
let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode let rad = radio "a-name" "anId" "test" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"test\">" Expect.equal rad """<input type="radio" name="a-name" id="anId" value="test">"""
"Unselected radio button not generated correctly" "Unselected radio button not generated correctly"
} }
test "succeeds when selected" { test "succeeds when selected" {
let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode let rad = radio "a-name" "anId" "unit" "unit" |> renderHtmlNode
Expect.equal rad "<input type=\"radio\" name=\"a-name\" id=\"anId\" value=\"unit\" checked>" Expect.equal rad """<input type="radio" name="a-name" id="anId" value="unit" checked>"""
"Selected radio button not generated correctly" "Selected radio button not generated correctly"
} }
] ]
@ -112,7 +112,8 @@ let selectListTests =
testList "selectList" [ testList "selectList" [
test "succeeds with minimum options" { test "succeeds with minimum options" {
let theList = selectList "a-list" "" [] [] |> renderHtmlNode let theList = selectList "a-list" "" [] [] |> renderHtmlNode
Expect.equal theList "<select name=\"a-list\" id=\"a-list\"></select>" "Empty select list not generated correctly" Expect.equal theList """<select name="a-list" id="a-list"></select>"""
"Empty select list not generated correctly"
} }
test "succeeds with all options" { test "succeeds with all options" {
let theList = let theList =
@ -123,11 +124,11 @@ let selectListTests =
|> selectList "the-list" "bob" [ _style "ugly" ] |> selectList "the-list" "bob" [ _style "ugly" ]
|> renderHtmlNode |> renderHtmlNode
let expected = let expected =
[ "<select name=\"the-list\" id=\"the-list\" style=\"ugly\">" [ """<select name="the-list" id="the-list" style="ugly">"""
"<option value=\"tom\">Tom&amp;</option>" """<option value="tom">Tom&amp;</option>"""
"<option value=\"bob\" selected>Bob</option>" """<option value="bob" selected>Bob</option>"""
"<option value=\"jan\">Jan</option>" """<option value="jan">Jan</option>"""
"</select>" """</select>"""
] ]
|> String.concat "" |> String.concat ""
Expect.equal theList expected "Filled select list not generated correctly" Expect.equal theList expected "Filled select list not generated correctly"
@ -147,10 +148,10 @@ let spaceTests =
let submitTests = let submitTests =
testList "submit" [ testList "submit" [
test "succeeds" { test "succeeds" {
let btn = submit [ _class "slick" ] "file-ico" _s.["a&b"] |> renderHtmlNode let btn = submit [ _class "slick" ] "file-ico" _s["a&b"] |> renderHtmlNode
Expect.equal Expect.equal
btn btn
"<button type=\"submit\" class=\"slick\"><i class=\"material-icons\">file-ico</i> &nbsp;a&amp;b</button>" """<button type="submit" class="slick"><i class="material-icons">file-ico</i> &nbsp;a&amp;b</button>"""
"Submit button not generated correctly" "Submit button not generated correctly"
} }
] ]
@ -160,17 +161,17 @@ let tableSummaryTests =
testList "tableSummary" [ testList "tableSummary" [
test "succeeds for no entries" { test "succeeds for no entries" {
let sum = tableSummary 0 _s |> renderHtmlNode let sum = tableSummary 0 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>No Entries to Display</small></div>" Expect.equal sum """<div class="pt-center-text"><small>No Entries to Display</small></div>"""
"Summary for no items is incorrect" "Summary for no items is incorrect"
} }
test "succeeds for one entry" { test "succeeds for one entry" {
let sum = tableSummary 1 _s |> renderHtmlNode let sum = tableSummary 1 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 1 Entry</small></div>" Expect.equal sum """<div class="pt-center-text"><small>Displaying 1 Entry</small></div>"""
"Summary for one item is incorrect" "Summary for one item is incorrect"
} }
test "succeeds for many entries" { test "succeeds for many entries" {
let sum = tableSummary 5 _s |> renderHtmlNode let sum = tableSummary 5 _s |> renderHtmlNode
Expect.equal sum "<div class=\"pt-center-text\"><small>Displaying 5 Entries</small></div>" Expect.equal sum """<div class="pt-center-text"><small>Displaying 5 Entries</small></div>"""
"Summary for many items is incorrect" "Summary for many items is incorrect"
} }
] ]
@ -183,26 +184,31 @@ module TimeZones =
let nameTests = let nameTests =
testList "TimeZones.name" [ testList "TimeZones.name" [
test "succeeds for US Eastern time" { test "succeeds for US Eastern time" {
Expect.equal (name "America/New_York" _s |> string) "Eastern" "US Eastern time zone not returned correctly" Expect.equal (name "America/New_York" _s |> string) "Eastern"
"US Eastern time zone not returned correctly"
} }
test "succeeds for US Central time" { test "succeeds for US Central time" {
Expect.equal (name "America/Chicago" _s |> string) "Central" "US Central time zone not returned correctly" Expect.equal (name "America/Chicago" _s |> string) "Central"
"US Central time zone not returned correctly"
} }
test "succeeds for US Mountain time" { test "succeeds for US Mountain time" {
Expect.equal (name "America/Denver" _s |> string) "Mountain" "US Mountain time zone not returned correctly" Expect.equal (name "America/Denver" _s |> string) "Mountain"
"US Mountain time zone not returned correctly"
} }
test "succeeds for US Mountain (AZ) time" { test "succeeds for US Mountain (AZ) time" {
Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)" Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)"
"US Mountain (AZ) time zone not returned correctly" "US Mountain (AZ) time zone not returned correctly"
} }
test "succeeds for US Pacific time" { test "succeeds for US Pacific time" {
Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" "US Pacific time zone not returned correctly" Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific"
"US Pacific time zone not returned correctly"
} }
test "succeeds for Central European time" { test "succeeds for Central European time" {
Expect.equal (name "Europe/Berlin" _s |> string) "Central European" Expect.equal (name "Europe/Berlin" _s |> string) "Central European"
"Central European time zone not returned correctly" "Central European time zone not returned correctly"
} }
test "fails for unexpected time zone" { test "fails for unexpected time zone" {
Expect.equal (name "Wakanda" _s |> string) "Wakanda" "Unexpected time zone should have returned the original ID" 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>] [<Tests>]
let stripTagsTests = 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" [ testList "stripTags" [
test "does nothing if all tags are allowed" { test "does nothing if all tags are allowed" {
Expect.equal (stripTags [ "p"; "br" ] testString) testString Expect.equal (stripTags [ "p"; "br" ] testString) testString

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

@ -1,12 +1,12 @@
module PrayerTracker.UI.ViewModelsTests module PrayerTracker.UI.ViewModelsTests
open System
open Expecto open Expecto
open Microsoft.AspNetCore.Html open Microsoft.AspNetCore.Html
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.Tests.TestLocalization open PrayerTracker.Tests.TestLocalization
open PrayerTracker.Utils open PrayerTracker.Utils
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
/// Filter function that filters nothing /// Filter function that filters nothing
@ -49,15 +49,18 @@ module ReferenceListTests =
test "excludes immediate expiration if not required" { test "excludes immediate expiration if not required" {
let exps = ReferenceList.expirationList _s false let exps = ReferenceList.expirationList _s false
Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned" Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned"
Expect.exists exps (fun (exp, _) -> exp = Automatic.code) "The option for automatic expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Automatic.code)
"The option for automatic expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found"
} }
test "includes immediate expiration if required" { test "includes immediate expiration if required" {
let exps = ReferenceList.expirationList _s true let exps = ReferenceList.expirationList _s true
Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned" Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned"
Expect.exists exps (fun (exp, _) -> exp = Automatic.code) "The option for automatic expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Automatic.code)
"The option for automatic expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found"
Expect.exists exps (fun (exp, _) -> exp = Forced.code) "The option for immediate expiration was not found" Expect.exists exps (fun (exp, _) -> exp = Forced.code)
"The option for immediate expiration was not found"
} }
] ]
@ -69,35 +72,36 @@ module ReferenceListTests =
yield! testFixture withList [ yield! testFixture withList [
yield "returns 5 types", yield "returns 5 types",
fun typs -> Expect.hasCountOf typs 5u countAll "There should have been 5 request types returned" fun typs -> Expect.hasCountOf typs 5u countAll "There should have been 5 request types returned"
yield! [ CurrentRequest; LongTermRequest; PraiseReport; Expecting; Announcement ] yield!
[ CurrentRequest; LongTermRequest; PraiseReport; Expecting; Announcement ]
|> List.map (fun typ -> |> List.map (fun typ ->
sprintf "contains \"%O\"" typ, $"contains \"%O{typ}\"",
fun typs -> fun typs ->
Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ)) Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ))
(sprintf "The \"%O\" option was not found" typ)) $"""The "%O{typ}" option was not found""")
] ]
] ]
[<Tests>] [<Tests>]
let announcementTests = let announcementTests =
let empty = { sendToClass = "N"; text = "<p>unit testing</p>"; addToRequestList = None; requestType = None } let empty = { SendToClass = "N"; Text = "<p>unit testing</p>"; AddToRequestList = None; RequestType = None }
testList "Announcement" [ testList "Announcement" [
test "plainText strips HTML" { test "plainText strips HTML" {
let ann = { empty with text = "<p>unit testing</p>" } let ann = { empty with Text = "<p>unit testing</p>" }
Expect.equal (ann.plainText ()) "unit testing" "Plain text should have stripped HTML" Expect.equal ann.PlainText "unit testing" "Plain text should have stripped HTML"
} }
test "plainText wraps at 74 characters" { test "plainText wraps at 74 characters" {
let ann = { empty with text = String.replicate 80 "x" } let ann = { empty with Text = String.replicate 80 "x" }
let txt = (ann.plainText ()).Split "\n" let txt = ann.PlainText.Split "\n"
Expect.hasCountOf txt 3u countAll "There should have been two lines of plain text returned" Expect.hasCountOf txt 3u countAll "There should have been two lines of plain text returned"
Expect.stringHasLength txt.[0] 74 "The first line should have been wrapped at 74 characters" Expect.stringHasLength txt[0] 74 "The first line should have been wrapped at 74 characters"
Expect.stringHasLength txt.[1] 6 "The second line should have had the remaining 6 characters" Expect.stringHasLength txt[1] 6 "The second line should have had the remaining 6 characters"
Expect.stringHasLength txt.[2] 0 "The third line should have been blank" Expect.stringHasLength txt[2] 0 "The third line should have been blank"
} }
test "plainText wraps at 74 characters and strips HTML" { test "plainText wraps at 74 characters and strips HTML" {
let ann = { empty with text = sprintf "<strong>%s</strong>" (String.replicate 80 "z") } let ann = { empty with Text = sprintf "<strong>%s</strong>" (String.replicate 80 "z") }
let txt = ann.plainText () let txt = ann.PlainText
Expect.stringStarts txt "zzz" "HTML should have been stripped from the front of the plain text" Expect.stringStarts txt "zzz" "HTML should have been stripped from the front of the plain text"
Expect.equal (txt.ToCharArray ()).[74] '\n' "The text should have been broken at 74 characters" Expect.equal (txt.ToCharArray ()).[74] '\n' "The text should have been broken at 74 characters"
} }
@ -108,14 +112,14 @@ let appViewInfoTests =
testList "AppViewInfo" [ testList "AppViewInfo" [
test "fresh is constructed properly" { test "fresh is constructed properly" {
let vi = AppViewInfo.fresh let vi = AppViewInfo.fresh
Expect.isEmpty vi.style "There should have been no styles set" Expect.isEmpty vi.Style "There should have been no styles set"
Expect.isEmpty vi.script "There should have been no scripts set" Expect.isEmpty vi.Script "There should have been no scripts set"
Expect.isNone vi.helpLink "The help link should have been set to none" Expect.isNone vi.HelpLink "The help link should have been set to none"
Expect.isEmpty vi.messages "There should have been no messages set" Expect.isEmpty vi.Messages "There should have been no messages set"
Expect.equal vi.version "" "The version should have been blank" Expect.equal vi.Version "" "The version should have been blank"
Expect.isGreaterThan vi.requestStart DateTime.MinValue.Ticks "The request start time should have been set" Expect.isGreaterThan vi.RequestStart DateTime.MinValue.Ticks "The request start time should have been set"
Expect.isNone vi.user "There should not have been a user" Expect.isNone vi.User "There should not have been a user"
Expect.isNone vi.group "There should not have been a small group" Expect.isNone vi.Group "There should not have been a small group"
} }
] ]
@ -125,9 +129,9 @@ let assignGroupsTests =
test "fromUser populates correctly" { test "fromUser populates correctly" {
let usr = { User.empty with userId = Guid.NewGuid (); firstName = "Alice"; lastName = "Bob" } let usr = { User.empty with userId = Guid.NewGuid (); firstName = "Alice"; lastName = "Bob" }
let asg = AssignGroups.fromUser usr let asg = AssignGroups.fromUser usr
Expect.equal asg.userId usr.userId "The user ID was not filled correctly" Expect.equal asg.UserId usr.userId "The user ID was not filled correctly"
Expect.equal asg.userName usr.fullName "The user name was not filled correctly" Expect.equal asg.UserName usr.fullName "The user name was not filled correctly"
Expect.equal asg.smallGroups "" "The small group string was not filled correctly" Expect.equal asg.SmallGroups "" "The small group string was not filled correctly"
} }
] ]
@ -145,14 +149,14 @@ let editChurchTests =
interfaceAddress = Some "https://test-dem-units.test" interfaceAddress = Some "https://test-dem-units.test"
} }
let edit = EditChurch.fromChurch church let edit = EditChurch.fromChurch church
Expect.equal edit.churchId church.churchId "The church ID was not filled correctly" Expect.equal edit.ChurchId church.churchId "The church ID was not filled correctly"
Expect.equal edit.name church.name "The church name was not filled correctly" Expect.equal edit.Name church.name "The church name was not filled correctly"
Expect.equal edit.city church.city "The church's city was not filled correctly" Expect.equal edit.City church.city "The church's city was not filled correctly"
Expect.equal edit.st church.st "The church's state was not filled correctly" Expect.equal edit.State church.st "The church's state was not filled correctly"
Expect.isSome edit.hasInterface "The church should show that it has an interface" Expect.isSome edit.HasInterface "The church should show that it has an interface"
Expect.equal edit.hasInterface (Some true) "The hasInterface flag should be true" Expect.equal edit.HasInterface (Some true) "The hasInterface flag should be true"
Expect.isSome edit.interfaceAddress "The interface address should exist" Expect.isSome edit.InterfaceAddress "The interface address should exist"
Expect.equal edit.interfaceAddress church.interfaceAddress "The interface address was not filled correctly" Expect.equal edit.InterfaceAddress church.interfaceAddress "The interface address was not filled correctly"
} }
test "fromChurch populates correctly when interface does not exist" { test "fromChurch populates correctly when interface does not exist" {
let edit = let edit =
@ -163,51 +167,51 @@ let editChurchTests =
city = "Testlandia" city = "Testlandia"
st = "UT" st = "UT"
} }
Expect.isNone edit.hasInterface "The church should not show that it has an interface" Expect.isNone edit.HasInterface "The church should not show that it has an interface"
Expect.isNone edit.interfaceAddress "The interface address should not exist" Expect.isNone edit.InterfaceAddress "The interface address should not exist"
} }
test "empty is as expected" { test "empty is as expected" {
let edit = EditChurch.empty let edit = EditChurch.empty
Expect.equal edit.churchId Guid.Empty "The church ID should be the empty GUID" Expect.equal edit.ChurchId Guid.Empty "The church ID should be the empty GUID"
Expect.equal edit.name "" "The church name should be blank" Expect.equal edit.Name "" "The church name should be blank"
Expect.equal edit.city "" "The church's city should be blank" Expect.equal edit.City "" "The church's city should be blank"
Expect.equal edit.st "" "The church's state should be blank" Expect.equal edit.State "" "The church's state should be blank"
Expect.isNone edit.hasInterface "The church should not show that it has an interface" Expect.isNone edit.HasInterface "The church should not show that it has an interface"
Expect.isNone edit.interfaceAddress "The interface address should not exist" Expect.isNone edit.InterfaceAddress "The interface address should not exist"
} }
test "isNew works on a new church" { test "isNew works on a new church" {
Expect.isTrue (EditChurch.empty.isNew ()) "An empty GUID should be flagged as a new church" Expect.isTrue EditChurch.empty.IsNew "An empty GUID should be flagged as a new church"
} }
test "isNew works on an existing church" { test "isNew works on an existing church" {
Expect.isFalse ({ EditChurch.empty with churchId = Guid.NewGuid () }.isNew ()) Expect.isFalse { EditChurch.empty with ChurchId = Guid.NewGuid () }.IsNew
"A non-empty GUID should not be flagged as a new church" "A non-empty GUID should not be flagged as a new church"
} }
test "populateChurch works correctly when an interface exists" { test "populateChurch works correctly when an interface exists" {
let edit = let edit =
{ EditChurch.empty with { EditChurch.empty with
churchId = Guid.NewGuid () ChurchId = Guid.NewGuid ()
name = "Test Baptist Church" Name = "Test Baptist Church"
city = "Testerville" City = "Testerville"
st = "TE" State = "TE"
hasInterface = Some true HasInterface = Some true
interfaceAddress = Some "https://test.units" InterfaceAddress = Some "https://test.units"
} }
let church = edit.populateChurch Church.empty let church = edit.PopulateChurch Church.empty
Expect.notEqual church.churchId edit.churchId "The church ID should not have been modified" Expect.notEqual church.churchId edit.ChurchId "The church ID should not have been modified"
Expect.equal church.name edit.name "The church name was not updated correctly" Expect.equal church.name edit.Name "The church name was not updated correctly"
Expect.equal church.city edit.city "The church's city was not updated correctly" Expect.equal church.city edit.City "The church's city was not updated correctly"
Expect.equal church.st edit.st "The church's state was not updated correctly" Expect.equal church.st edit.State "The church's state was not updated correctly"
Expect.isTrue church.hasInterface "The church should show that it has an interface" Expect.isTrue church.hasInterface "The church should show that it has an interface"
Expect.isSome church.interfaceAddress "The interface address should exist" Expect.isSome church.interfaceAddress "The interface address should exist"
Expect.equal church.interfaceAddress edit.interfaceAddress "The interface address was not updated correctly" Expect.equal church.interfaceAddress edit.InterfaceAddress "The interface address was not updated correctly"
} }
test "populateChurch works correctly when an interface does not exist" { test "populateChurch works correctly when an interface does not exist" {
let church = let church =
{ EditChurch.empty with { EditChurch.empty with
name = "Test Baptist Church" Name = "Test Baptist Church"
city = "Testerville" City = "Testerville"
st = "TE" State = "TE"
}.populateChurch Church.empty }.PopulateChurch Church.empty
Expect.isFalse church.hasInterface "The church should show that it has an interface" Expect.isFalse church.hasInterface "The church should show that it has an interface"
Expect.isNone church.interfaceAddress "The interface address should exist" Expect.isNone church.interfaceAddress "The interface address should exist"
} }
@ -224,27 +228,27 @@ let editMemberTests =
email = "test_units@example.com" email = "test_units@example.com"
} }
let edit = EditMember.fromMember mbr let edit = EditMember.fromMember mbr
Expect.equal edit.memberId mbr.memberId "The member ID was not filled correctly" Expect.equal edit.MemberId mbr.memberId "The member ID was not filled correctly"
Expect.equal edit.memberName mbr.memberName "The member name was not filled correctly" Expect.equal edit.Name mbr.memberName "The member name was not filled correctly"
Expect.equal edit.emailAddress mbr.email "The e-mail address was not filled correctly" Expect.equal edit.Email mbr.email "The e-mail address was not filled correctly"
Expect.equal edit.emailType "" "The e-mail type should have been blank for group default" Expect.equal edit.Format "" "The e-mail format should have been blank for group default"
} }
test "fromMember populates with specific format" { test "fromMember populates with specific format" {
let edit = EditMember.fromMember { Member.empty with format = Some HtmlFormat.code } let edit = EditMember.fromMember { Member.empty with format = Some HtmlFormat.code }
Expect.equal edit.emailType HtmlFormat.code "The e-mail type was not filled correctly" Expect.equal edit.Format HtmlFormat.code "The e-mail format was not filled correctly"
} }
test "empty is as expected" { test "empty is as expected" {
let edit = EditMember.empty let edit = EditMember.empty
Expect.equal edit.memberId Guid.Empty "The member ID should have been an empty GUID" Expect.equal edit.MemberId Guid.Empty "The member ID should have been an empty GUID"
Expect.equal edit.memberName "" "The member name should have been blank" Expect.equal edit.Name "" "The member name should have been blank"
Expect.equal edit.emailAddress "" "The e-mail address should have been blank" Expect.equal edit.Email "" "The e-mail address should have been blank"
Expect.equal edit.emailType "" "The e-mail type should have been blank" Expect.equal edit.Format "" "The e-mail format should have been blank"
} }
test "isNew works for a new member" { test "isNew works for a new member" {
Expect.isTrue (EditMember.empty.isNew ()) "An empty GUID should be flagged as a new member" Expect.isTrue EditMember.empty.IsNew "An empty GUID should be flagged as a new member"
} }
test "isNew works for an existing member" { test "isNew works for an existing member" {
Expect.isFalse ({ EditMember.empty with memberId = Guid.NewGuid () }.isNew ()) Expect.isFalse { EditMember.empty with MemberId = Guid.NewGuid () }.IsNew
"A non-empty GUID should not be flagged as a new member" "A non-empty GUID should not be flagged as a new member"
} }
] ]
@ -255,43 +259,49 @@ let editPreferencesTests =
test "fromPreferences succeeds for named colors and private list" { test "fromPreferences succeeds for named colors and private list" {
let prefs = ListPreferences.empty let prefs = ListPreferences.empty
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.expireDays prefs.daysToExpire "The expiration days were not filled correctly" Expect.equal edit.ExpireDays prefs.daysToExpire "The expiration days were not filled correctly"
Expect.equal edit.daysToKeepNew prefs.daysToKeepNew "The days to keep new were not filled correctly" Expect.equal edit.DaysToKeepNew prefs.daysToKeepNew "The days to keep new were not filled correctly"
Expect.equal edit.longTermUpdateWeeks prefs.longTermUpdateWeeks "The weeks for update were not filled correctly" Expect.equal edit.LongTermUpdateWeeks prefs.longTermUpdateWeeks
Expect.equal edit.requestSort prefs.requestSort.code "The request sort was not filled correctly" "The weeks for update were not filled correctly"
Expect.equal edit.emailFromName prefs.emailFromName "The e-mail from name was not filled correctly" Expect.equal edit.RequestSort prefs.requestSort.code "The request sort was not filled correctly"
Expect.equal edit.emailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly" Expect.equal edit.EmailFromName prefs.emailFromName "The e-mail from name was not filled correctly"
Expect.equal edit.defaultEmailType prefs.defaultEmailType.code "The default e-mail type was not filled correctly" Expect.equal edit.EmailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly"
Expect.equal edit.headingLineType "Name" "The heading line color type was not derived correctly" Expect.equal edit.DefaultEmailType prefs.defaultEmailType.code
Expect.equal edit.headingLineColor prefs.lineColor "The heading line color was not filled correctly" "The default e-mail type was not filled correctly"
Expect.equal edit.headingTextType "Name" "The heading text color type was not derived correctly" Expect.equal edit.LineColorType "Name" "The heading line color type was not derived correctly"
Expect.equal edit.headingTextColor prefs.headingColor "The heading text color was not filled correctly" Expect.equal edit.LineColor prefs.lineColor "The heading line color was not filled correctly"
Expect.equal edit.listFonts prefs.listFonts "The list fonts were not filled correctly" Expect.equal edit.HeadingColorType "Name" "The heading text color type was not derived correctly"
Expect.equal edit.headingFontSize prefs.headingFontSize "The heading font size was not filled correctly" Expect.equal edit.HeadingColor prefs.headingColor "The heading text color was not filled correctly"
Expect.equal edit.listFontSize prefs.textFontSize "The list text font size was not filled correctly" Expect.equal edit.Fonts prefs.listFonts "The list fonts were not filled correctly"
Expect.equal edit.timeZone prefs.timeZoneId "The time zone was not filled correctly" Expect.equal edit.HeadingFontSize prefs.headingFontSize "The heading font size was not filled correctly"
Expect.isSome edit.groupPassword "The group password should have been set" Expect.equal edit.ListFontSize prefs.textFontSize "The list text font size was not filled correctly"
Expect.equal edit.groupPassword (Some prefs.groupPassword) "The group password was not filled correctly" Expect.equal edit.TimeZone prefs.timeZoneId "The time zone was not filled correctly"
Expect.equal edit.listVisibility RequestVisibility.``private`` "The list visibility was not derived correctly" Expect.isSome edit.GroupPassword "The group password should have been set"
Expect.equal edit.GroupPassword (Some prefs.groupPassword) "The group password was not filled correctly"
Expect.equal edit.Visibility RequestVisibility.``private``
"The list visibility was not derived correctly"
Expect.equal edit.PageSize prefs.pageSize "The page size was not filled correctly"
Expect.equal edit.AsOfDate prefs.asOfDateDisplay.code "The as-of date display was not filled correctly"
} }
test "fromPreferences succeeds for RGB line color and password-protected list" { test "fromPreferences succeeds for RGB line color and password-protected list" {
let prefs = { ListPreferences.empty with lineColor = "#ff0000"; groupPassword = "pw" } let prefs = { ListPreferences.empty with lineColor = "#ff0000"; groupPassword = "pw" }
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.headingLineType "RGB" "The heading line color type was not derived correctly" Expect.equal edit.LineColorType "RGB" "The heading line color type was not derived correctly"
Expect.equal edit.headingLineColor prefs.lineColor "The heading line color was not filled correctly" Expect.equal edit.LineColor prefs.lineColor "The heading line color was not filled correctly"
Expect.isSome edit.groupPassword "The group password should have been set" Expect.isSome edit.GroupPassword "The group password should have been set"
Expect.equal edit.groupPassword (Some prefs.groupPassword) "The group password was not filled correctly" Expect.equal edit.GroupPassword (Some prefs.groupPassword) "The group password was not filled correctly"
Expect.equal edit.listVisibility RequestVisibility.passwordProtected Expect.equal edit.Visibility RequestVisibility.passwordProtected
"The list visibility was not derived correctly" "The list visibility was not derived correctly"
} }
test "fromPreferences succeeds for RGB text color and public list" { test "fromPreferences succeeds for RGB text color and public list" {
let prefs = { ListPreferences.empty with headingColor = "#0000ff"; isPublic = true } let prefs = { ListPreferences.empty with headingColor = "#0000ff"; isPublic = true }
let edit = EditPreferences.fromPreferences prefs let edit = EditPreferences.fromPreferences prefs
Expect.equal edit.headingTextType "RGB" "The heading text color type was not derived correctly" Expect.equal edit.HeadingColorType "RGB" "The heading text color type was not derived correctly"
Expect.equal edit.headingTextColor prefs.headingColor "The heading text color was not filled correctly" Expect.equal edit.HeadingColor prefs.headingColor "The heading text color was not filled correctly"
Expect.isSome edit.groupPassword "The group password should have been set" Expect.isSome edit.GroupPassword "The group password should have been set"
Expect.equal edit.groupPassword (Some "") "The group password was not filled correctly" Expect.equal edit.GroupPassword (Some "") "The group password was not filled correctly"
Expect.equal edit.listVisibility RequestVisibility.``public`` "The list visibility was not derived correctly" Expect.equal edit.Visibility RequestVisibility.``public``
"The list visibility was not derived correctly"
} }
] ]
@ -300,13 +310,13 @@ let editRequestTests =
testList "EditRequest" [ testList "EditRequest" [
test "empty is as expected" { test "empty is as expected" {
let mt = EditRequest.empty let mt = EditRequest.empty
Expect.equal mt.requestId Guid.Empty "The request ID should be an empty GUID" Expect.equal mt.RequestId Guid.Empty "The request ID should be an empty GUID"
Expect.equal mt.requestType CurrentRequest.code "The request type should have been \"Current\"" Expect.equal mt.RequestType CurrentRequest.code "The request type should have been \"Current\""
Expect.isNone mt.enteredDate "The entered date should have been None" Expect.isNone mt.EnteredDate "The entered date should have been None"
Expect.isNone mt.skipDateUpdate "The \"skip date update\" flag should have been None" Expect.isNone mt.SkipDateUpdate """The "skip date update" flag should have been None"""
Expect.isNone mt.requestor "The requestor should have been None" Expect.isNone mt.Requestor "The requestor should have been None"
Expect.equal mt.expiration Automatic.code "The expiration should have been \"A\" (Automatic)" Expect.equal mt.Expiration Automatic.code """The expiration should have been "A" (Automatic)"""
Expect.equal mt.text "" "The text should have been blank" Expect.equal mt.Text "" "The text should have been blank"
} }
test "fromRequest succeeds" { test "fromRequest succeeds" {
let req = let req =
@ -318,17 +328,17 @@ let editRequestTests =
text = "the text" text = "the text"
} }
let edit = EditRequest.fromRequest req let edit = EditRequest.fromRequest req
Expect.equal edit.requestId req.prayerRequestId "The request ID was not filled correctly" Expect.equal edit.RequestId req.prayerRequestId "The request ID was not filled correctly"
Expect.equal edit.requestType req.requestType.code "The request type was not filled correctly" Expect.equal edit.RequestType req.requestType.code "The request type was not filled correctly"
Expect.equal edit.requestor req.requestor "The requestor was not filled correctly" Expect.equal edit.Requestor req.requestor "The requestor was not filled correctly"
Expect.equal edit.expiration Manual.code "The expiration was not filled correctly" Expect.equal edit.Expiration Manual.code "The expiration was not filled correctly"
Expect.equal edit.text req.text "The text was not filled correctly" Expect.equal edit.Text req.text "The text was not filled correctly"
} }
test "isNew works for a new request" { test "isNew works for a new request" {
Expect.isTrue (EditRequest.empty.isNew ()) "An empty GUID should be flagged as a new request" Expect.isTrue EditRequest.empty.IsNew "An empty GUID should be flagged as a new request"
} }
test "isNew works for an existing request" { test "isNew works for an existing request" {
Expect.isFalse ({ EditRequest.empty with requestId = Guid.NewGuid () }.isNew ()) Expect.isFalse { EditRequest.empty with RequestId = Guid.NewGuid () }.IsNew
"A non-empty GUID should not be flagged as a new request" "A non-empty GUID should not be flagged as a new request"
} }
] ]
@ -344,32 +354,32 @@ let editSmallGroupTests =
churchId = Guid.NewGuid () churchId = Guid.NewGuid ()
} }
let edit = EditSmallGroup.fromGroup grp let edit = EditSmallGroup.fromGroup grp
Expect.equal edit.smallGroupId grp.smallGroupId "The small group ID was not filled correctly" Expect.equal edit.SmallGroupId grp.smallGroupId "The small group ID was not filled correctly"
Expect.equal edit.name grp.name "The name was not filled correctly" Expect.equal edit.Name grp.name "The name was not filled correctly"
Expect.equal edit.churchId grp.churchId "The church ID was not filled correctly" Expect.equal edit.ChurchId grp.churchId "The church ID was not filled correctly"
} }
test "empty is as expected" { test "empty is as expected" {
let mt = EditSmallGroup.empty let mt = EditSmallGroup.empty
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID"
Expect.equal mt.name "" "The name should be blank" Expect.equal mt.Name "" "The name should be blank"
Expect.equal mt.churchId Guid.Empty "The church ID should be an empty GUID" Expect.equal mt.ChurchId Guid.Empty "The church ID should be an empty GUID"
} }
test "isNew works for a new small group" { test "isNew works for a new small group" {
Expect.isTrue (EditSmallGroup.empty.isNew ()) "An empty GUID should be flagged as a new small group" Expect.isTrue EditSmallGroup.empty.IsNew "An empty GUID should be flagged as a new small group"
} }
test "isNew works for an existing small group" { test "isNew works for an existing small group" {
Expect.isFalse ({ EditSmallGroup.empty with smallGroupId = Guid.NewGuid () }.isNew ()) Expect.isFalse { EditSmallGroup.empty with SmallGroupId = Guid.NewGuid () }.IsNew
"A non-empty GUID should not be flagged as a new small group" "A non-empty GUID should not be flagged as a new small group"
} }
test "populateGroup succeeds" { test "populateGroup succeeds" {
let edit = let edit =
{ EditSmallGroup.empty with { EditSmallGroup.empty with
name = "test name" Name = "test name"
churchId = Guid.NewGuid () ChurchId = Guid.NewGuid ()
} }
let grp = edit.populateGroup SmallGroup.empty let grp = edit.populateGroup SmallGroup.empty
Expect.equal grp.name edit.name "The name was not populated correctly" Expect.equal grp.name edit.Name "The name was not populated correctly"
Expect.equal grp.churchId edit.churchId "The church ID was not populated correctly" Expect.equal grp.churchId edit.ChurchId "The church ID was not populated correctly"
} }
] ]
@ -378,13 +388,13 @@ let editUserTests =
testList "EditUser" [ testList "EditUser" [
test "empty is as expected" { test "empty is as expected" {
let mt = EditUser.empty let mt = EditUser.empty
Expect.equal mt.userId Guid.Empty "The user ID should be an empty GUID" Expect.equal mt.UserId Guid.Empty "The user ID should be an empty GUID"
Expect.equal mt.firstName "" "The first name should be blank" Expect.equal mt.FirstName "" "The first name should be blank"
Expect.equal mt.lastName "" "The last name should be blank" Expect.equal mt.LastName "" "The last name should be blank"
Expect.equal mt.emailAddress "" "The e-mail address should be blank" Expect.equal mt.Email "" "The e-mail address should be blank"
Expect.equal mt.password "" "The password should be blank" Expect.equal mt.Password "" "The password should be blank"
Expect.equal mt.passwordConfirm "" "The confirmed password should be blank" Expect.equal mt.PasswordConfirm "" "The confirmed password should be blank"
Expect.isNone mt.isAdmin "The isAdmin flag should be None" Expect.isNone mt.IsAdmin "The IsAdmin flag should be None"
} }
test "fromUser succeeds" { test "fromUser succeeds" {
let usr = let usr =
@ -395,35 +405,35 @@ let editUserTests =
emailAddress = "a@b.c" emailAddress = "a@b.c"
} }
let edit = EditUser.fromUser usr let edit = EditUser.fromUser usr
Expect.equal edit.userId usr.userId "The user ID was not filled correctly" Expect.equal edit.UserId usr.userId "The user ID was not filled correctly"
Expect.equal edit.firstName usr.firstName "The first name was not filled correctly" Expect.equal edit.FirstName usr.firstName "The first name was not filled correctly"
Expect.equal edit.lastName usr.lastName "The last name was not filled correctly" Expect.equal edit.LastName usr.lastName "The last name was not filled correctly"
Expect.equal edit.emailAddress usr.emailAddress "The e-mail address was not filled correctly" Expect.equal edit.Email usr.emailAddress "The e-mail address was not filled correctly"
Expect.isNone edit.isAdmin "The isAdmin flag was not filled correctly" Expect.isNone edit.IsAdmin "The IsAdmin flag was not filled correctly"
} }
test "isNew works for a new user" { test "isNew works for a new user" {
Expect.isTrue (EditUser.empty.isNew ()) "An empty GUID should be flagged as a new user" Expect.isTrue EditUser.empty.IsNew "An empty GUID should be flagged as a new user"
} }
test "isNew works for an existing user" { test "isNew works for an existing user" {
Expect.isFalse ({ EditUser.empty with userId = Guid.NewGuid () }.isNew ()) Expect.isFalse { EditUser.empty with UserId = Guid.NewGuid () }.IsNew
"A non-empty GUID should not be flagged as a new user" "A non-empty GUID should not be flagged as a new user"
} }
test "populateUser succeeds" { test "populateUser succeeds" {
let edit = let edit =
{ EditUser.empty with { EditUser.empty with
firstName = "name" FirstName = "name"
lastName = "eman" LastName = "eman"
emailAddress = "n@m.e" Email = "n@m.e"
isAdmin = Some true IsAdmin = Some true
password = "testpw" Password = "testpw"
} }
let hasher = fun x -> x + "+" let hasher = fun x -> x + "+"
let usr = edit.populateUser User.empty hasher let usr = edit.PopulateUser User.empty hasher
Expect.equal usr.firstName edit.firstName "The first name was not populated correctly" Expect.equal usr.firstName edit.FirstName "The first name was not populated correctly"
Expect.equal usr.lastName edit.lastName "The last name was not populated correctly" Expect.equal usr.lastName edit.LastName "The last name was not populated correctly"
Expect.equal usr.emailAddress edit.emailAddress "The e-mail address was not populated correctly" Expect.equal usr.emailAddress edit.Email "The e-mail address was not populated correctly"
Expect.isTrue usr.isAdmin "The isAdmin flag was not populated correctly" Expect.isTrue usr.isAdmin "The isAdmin flag was not populated correctly"
Expect.equal usr.passwordHash (hasher edit.password) "The password hash was not populated correctly" Expect.equal usr.passwordHash (hasher edit.Password) "The password hash was not populated correctly"
} }
] ]
@ -432,9 +442,9 @@ let groupLogOnTests =
testList "GroupLogOn" [ testList "GroupLogOn" [
test "empty is as expected" { test "empty is as expected" {
let mt = GroupLogOn.empty let mt = GroupLogOn.empty
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID"
Expect.equal mt.password "" "The password should be blank" Expect.equal mt.Password "" "The password should be blank"
Expect.isNone mt.rememberMe "Remember Me should be None" Expect.isNone mt.RememberMe "Remember Me should be None"
} }
] ]
@ -443,11 +453,34 @@ let maintainRequestsTests =
testList "MaintainRequests" [ testList "MaintainRequests" [
test "empty is as expected" { test "empty is as expected" {
let mt = MaintainRequests.empty let mt = MaintainRequests.empty
Expect.isEmpty mt.requests "The requests for the model should have been empty" Expect.isEmpty mt.Requests "The requests for the model should have been empty"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" Expect.equal mt.SmallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
Expect.isNone mt.onlyActive "The only active flag should have been None" Expect.isNone mt.OnlyActive "The only active flag should have been None"
Expect.isNone mt.searchTerm "The search term should have been None" Expect.isNone mt.SearchTerm "The search term should have been None"
Expect.isNone mt.pageNbr "The page number should have been None" Expect.isNone mt.PageNbr "The page number should have been None"
}
]
[<Tests>]
let messageLevelTests =
testList "MessageLevel" [
test "toString for Info is as expected" {
Expect.equal (MessageLevel.toString Info) "Info" """The string value of "Info" is incorrect"""
}
test "toString for Warning is as expected" {
Expect.equal (MessageLevel.toString Warning) "WARNING" """The string value of "Warning" is incorrect"""
}
test "toString for Error is as expected" {
Expect.equal (MessageLevel.toString Error) "ERROR" """The string value of "Error" is incorrect"""
}
test "toCssClass for Info is as expected" {
Expect.equal (MessageLevel.toCssClass Info) "info" """The string value of "Info" is incorrect"""
}
test "toCssClass for Warning is as expected" {
Expect.equal (MessageLevel.toCssClass Warning) "warning" """The string value of "Warning" is incorrect"""
}
test "toCssClass for Error is as expected" {
Expect.equal (MessageLevel.toCssClass Error) "error" """The string value of "Error" is incorrect"""
} }
] ]
@ -455,7 +488,7 @@ let maintainRequestsTests =
let requestListTests = let requestListTests =
testList "RequestList" [ testList "RequestList" [
let withRequestList f () = let withRequestList f () =
{ requests = [ { Requests = [
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = CurrentRequest requestType = CurrentRequest
requestor = Some "Zeb" requestor = Some "Zeb"
@ -474,169 +507,178 @@ let requestListTests =
updatedDate = DateTime.Today updatedDate = DateTime.Today
} }
] ]
date = DateTime.Today Date = DateTime.Today
listGroup = SmallGroup.empty SmallGroup = SmallGroup.empty
showHeader = false ShowHeader = false
recipients = [] Recipients = []
canEmail = false CanEmail = false
} }
|> f |> f
yield! testFixture withRequestList [ yield! testFixture withRequestList [
"asHtml succeeds without header or as-of date", "AsHtml succeeds without header or as-of date",
fun reqList -> fun reqList ->
let htmlList = { reqList with listGroup = { reqList.listGroup with name = "Test HTML Group" } } let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" } }
let html = htmlList.asHtml _s let html = htmlList.AsHtml _s
Expect.equal -1 (html.IndexOf "Test HTML Group") "The small group name should not have existed (no header)" Expect.equal -1 (html.IndexOf "Test HTML Group")
"The small group name should not have existed (no header)"
let curReqHeading = let curReqHeading =
[ "<table style=\"font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;page-break-inside:avoid;\">" [ """<table style="font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;page-break-inside:avoid;">"""
"<tr>" "<tr>"
"<td style=\"font-size:16pt;color:maroon;padding:3px 0;border-top:solid 3px navy;border-bottom:solid 3px navy;font-weight:bold;\">" """<td style="font-size:16pt;color:maroon;padding:3px 0;border-top:solid 3px navy;border-bottom:solid 3px navy;font-weight:bold;">"""
"&nbsp; &nbsp; Current Requests&nbsp; &nbsp; </td></tr></table>" "&nbsp; &nbsp; Current Requests&nbsp; &nbsp; </td></tr></table>"
] ]
|> String.concat "" |> String.concat ""
Expect.stringContains html curReqHeading "Heading for category \"Current Requests\" not found" Expect.stringContains html curReqHeading """Heading for category "Current Requests" not found"""
let curReqHtml = let curReqHtml =
[ "<ul>" [ "<ul>"
"<li style=\"list-style-type:circle;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;\">" """<li style="list-style-type:circle;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;">"""
"<strong>Zeb</strong> &mdash; zyx</li>" "<strong>Zeb</strong> &mdash; zyx</li>"
"<li style=\"list-style-type:disc;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;\">" """<li style="list-style-type:disc;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;">"""
"<strong>Aaron</strong> &mdash; abc</li></ul>" "<strong>Aaron</strong> &mdash; abc</li></ul>"
] ]
|> String.concat "" |> String.concat ""
Expect.stringContains html curReqHtml "Expected HTML for \"Current Requests\" requests not found" Expect.stringContains html curReqHtml """Expected HTML for "Current Requests" requests not found"""
let praiseHeading = let praiseHeading =
[ "<table style=\"font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;page-break-inside:avoid;\">" [ """<table style="font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;page-break-inside:avoid;">"""
"<tr>" "<tr>"
"<td style=\"font-size:16pt;color:maroon;padding:3px 0;border-top:solid 3px navy;border-bottom:solid 3px navy;font-weight:bold;\">" """<td style="font-size:16pt;color:maroon;padding:3px 0;border-top:solid 3px navy;border-bottom:solid 3px navy;font-weight:bold;">"""
"&nbsp; &nbsp; Praise Reports&nbsp; &nbsp; </td></tr></table>" "&nbsp; &nbsp; Praise Reports&nbsp; &nbsp; </td></tr></table>"
] ]
|> String.concat "" |> String.concat ""
Expect.stringContains html praiseHeading "Heading for category \"Praise Reports\" not found" Expect.stringContains html praiseHeading """Heading for category "Praise Reports" not found"""
let praiseHtml = let praiseHtml =
[ "<ul>" [ "<ul>"
"<li style=\"list-style-type:circle;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;\">" """<li style="list-style-type:circle;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif;font-size:12pt;padding-bottom:.25em;">"""
"nmo</li></ul>" "nmo</li></ul>"
] ]
|> String.concat "" |> String.concat ""
Expect.stringContains html praiseHtml "Expected HTML for \"Praise Reports\" requests not found" Expect.stringContains html praiseHtml """Expected HTML for "Praise Reports" requests not found"""
"asHtml succeeds with header", "AsHtml succeeds with header",
fun reqList -> fun reqList ->
let htmlList = let htmlList =
{ reqList with { reqList with
listGroup = { reqList.listGroup with name = "Test HTML Group" } SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" }
showHeader = true ShowHeader = true
} }
let html = htmlList.asHtml _s let html = htmlList.AsHtml _s
let lstHeading = let lstHeading =
[ "<div style=\"text-align:center;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif\">" [ """<div style="text-align:center;font-family:Century Gothic,Tahoma,Luxi Sans,sans-serif">"""
"<span style=\"font-size:16pt;\"><strong>Prayer Requests</strong></span><br>" """<span style="font-size:16pt;"><strong>Prayer Requests</strong></span><br>"""
"<span style=\"font-size:12pt;\"><strong>Test HTML Group</strong><br>" """<span style="font-size:12pt;"><strong>Test HTML Group</strong><br>"""
htmlList.date.ToString "MMMM d, yyyy" htmlList.Date.ToString "MMMM d, yyyy"
"</span></div><br>" "</span></div><br>"
] ]
|> String.concat "" |> String.concat ""
Expect.stringContains html lstHeading "Expected HTML for the list heading not found" Expect.stringContains html lstHeading "Expected HTML for the list heading not found"
// spot check; without header test tests this exhaustively // spot check; without header test tests this exhaustively
Expect.stringContains html "<strong>Zeb</strong> &mdash; zyx</li>" "Expected requests not found" Expect.stringContains html "<strong>Zeb</strong> &mdash; zyx</li>" "Expected requests not found"
"asHtml succeeds with short as-of date", "AsHtml succeeds with short as-of date",
fun reqList -> fun reqList ->
let htmlList = let htmlList =
{ reqList with { reqList with
listGroup = SmallGroup =
{ reqList.listGroup with { reqList.SmallGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate } preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate }
} }
} }
let html = htmlList.asHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.requests.[0].updatedDate.ToShortDateString () htmlList.Requests[0].updatedDate.ToShortDateString ()
|> sprintf "<strong>Zeb</strong> &mdash; zyx<i style=\"font-size:9.60pt\">&nbsp; (as of %s)</i>" |> sprintf """<strong>Zeb</strong> &mdash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>"""
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains html expected "Expected short as-of date not found" Expect.stringContains html expected "Expected short as-of date not found"
"asHtml succeeds with long as-of date", "AsHtml succeeds with long as-of date",
fun reqList -> fun reqList ->
let htmlList = let htmlList =
{ reqList with { reqList with
listGroup = SmallGroup =
{ reqList.listGroup with { reqList.SmallGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate } preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate }
} }
} }
let html = htmlList.asHtml _s let html = htmlList.AsHtml _s
let expected = let expected =
htmlList.requests.[0].updatedDate.ToLongDateString () htmlList.Requests[0].updatedDate.ToLongDateString ()
|> sprintf "<strong>Zeb</strong> &mdash; zyx<i style=\"font-size:9.60pt\">&nbsp; (as of %s)</i>" |> sprintf """<strong>Zeb</strong> &mdash; zyx<i style="font-size:9.60pt">&nbsp; (as of %s)</i>"""
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains html expected "Expected long as-of date not found" Expect.stringContains html expected "Expected long as-of date not found"
"asText succeeds with no as-of date", "AsText succeeds with no as-of date",
fun reqList -> fun reqList ->
let textList = { reqList with listGroup = { reqList.listGroup with name = "Test Group" } } let textList = { reqList with SmallGroup = { reqList.SmallGroup with name = "Test Group" } }
let text = textList.asText _s let text = textList.AsText _s
Expect.stringContains text (textList.listGroup.name + "\n") "Small group name not found" Expect.stringContains text $"{textList.SmallGroup.name}\n" "Small group name not found"
Expect.stringContains text "Prayer Requests\n" "List heading not found" Expect.stringContains text "Prayer Requests\n" "List heading not found"
Expect.stringContains text ((textList.date.ToString "MMMM d, yyyy") + "\n \n") "List date not found" Expect.stringContains text ((textList.Date.ToString "MMMM d, yyyy") + "\n \n") "List date not found"
Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n" Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n"
"Heading for category \"Current Requests\" not found" """Heading for category "Current Requests" not found"""
Expect.stringContains text " + Zeb - zyx\n" "First request not found" Expect.stringContains text " + Zeb - zyx\n" "First request not found"
Expect.stringContains text " - Aaron - abc\n \n" "Second request not found; should have been end of category" Expect.stringContains text " - Aaron - abc\n \n"
"Second request not found; should have been end of category"
Expect.stringContains text "------------------\n PRAISE REPORTS\n------------------\n" Expect.stringContains text "------------------\n PRAISE REPORTS\n------------------\n"
"Heading for category \"Praise Reports\" not found" """Heading for category "Praise Reports" not found"""
Expect.stringContains text " + nmo\n \n" "Last request not found" Expect.stringContains text " + nmo\n \n" "Last request not found"
"asText succeeds with short as-of date", "AsText succeeds with short as-of date",
fun reqList -> fun reqList ->
let textList = let textList =
{ reqList with { reqList with
listGroup = SmallGroup =
{ reqList.listGroup with { reqList.SmallGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate } preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate }
} }
} }
let text = textList.asText _s let text = textList.AsText _s
let expected = let expected =
textList.requests.[0].updatedDate.ToShortDateString () textList.Requests[0].updatedDate.ToShortDateString ()
|> sprintf " + Zeb - zyx (as of %s)" |> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains text expected "Expected short as-of date not found" Expect.stringContains text expected "Expected short as-of date not found"
"asText succeeds with long as-of date", "AsText succeeds with long as-of date",
fun reqList -> fun reqList ->
let textList = let textList =
{ reqList with { reqList with
listGroup = SmallGroup =
{ reqList.listGroup with { reqList.SmallGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate } preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate }
} }
} }
let text = textList.asText _s let text = textList.AsText _s
let expected = let expected =
textList.requests.[0].updatedDate.ToLongDateString () textList.Requests[0].updatedDate.ToLongDateString ()
|> sprintf " + Zeb - zyx (as of %s)" |> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should // spot check; if one request has it, they all should
Expect.stringContains text expected "Expected long as-of date not found" Expect.stringContains text expected "Expected long as-of date not found"
"isNew succeeds for both old and new requests", "IsNew succeeds for both old and new requests",
fun reqList -> fun reqList ->
let reqs = reqList.requestsInCategory CurrentRequest let allReqs = reqList.RequestsByType _s
let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest)
Expect.hasCountOf reqs 2u countAll "There should have been two requests" Expect.hasCountOf reqs 2u countAll "There should have been two requests"
Expect.isTrue (reqList.isNew (List.head reqs)) "The first request should have been new" Expect.isTrue (reqList.IsNew (List.head reqs)) "The first request should have been new"
Expect.isFalse (reqList.isNew (List.last reqs)) "The second request should not have been new" Expect.isFalse (reqList.IsNew (List.last reqs)) "The second request should not have been new"
"requestsInCategory succeeds when requests exist", "RequestsByType succeeds",
fun reqList -> fun reqList ->
let reqs = reqList.requestsInCategory CurrentRequest let allReqs = reqList.RequestsByType _s
Expect.hasLength allReqs 2 "There should have been two types of request groupings"
let maybeCurrent = allReqs |> List.tryFind (fun (typ, _, _) -> typ = CurrentRequest)
Expect.isSome maybeCurrent "There should have been current requests"
let _, _, reqs = Option.get maybeCurrent
Expect.hasCountOf reqs 2u countAll "There should have been two requests" Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs let first = List.head reqs
Expect.equal first.text "zyx" "The requests should be sorted by updated date descending" Expect.equal first.text "zyx" "The requests should be sorted by updated date descending"
"requestsInCategory succeeds when requests do not exist", Expect.isTrue (allReqs |> List.exists (fun (typ, _, _) -> typ = PraiseReport))
fun reqList -> "There should have been praise reports"
Expect.isEmpty (reqList.requestsInCategory Announcement) "There should have been no \"Announcement\" requests" Expect.isFalse (allReqs |> List.exists (fun (typ, _, _) -> typ = Announcement))
"requestsInCategory succeeds and sorts by requestor", "There should not have been announcements"
"RequestsByType succeeds and sorts by requestor",
fun reqList -> fun reqList ->
let newList = let newList =
{ reqList with { reqList with
listGroup = SmallGroup =
{ reqList.listGroup with { reqList.SmallGroup with
preferences = { reqList.listGroup.preferences with requestSort = SortByRequestor } preferences = { reqList.SmallGroup.preferences with requestSort = SortByRequestor }
} }
} }
let reqs = newList.requestsInCategory CurrentRequest let allReqs = newList.RequestsByType _s
let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest)
Expect.hasCountOf reqs 2u countAll "There should have been two requests" Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs let first = List.head reqs
Expect.equal first.text "abc" "The requests should be sorted by requestor" Expect.equal first.text "abc" "The requests should be sorted by requestor"
@ -648,11 +690,11 @@ let userLogOnTests =
testList "UserLogOn" [ testList "UserLogOn" [
test "empty is as expected" { test "empty is as expected" {
let mt = UserLogOn.empty let mt = UserLogOn.empty
Expect.equal mt.emailAddress "" "The e-mail address should be blank" Expect.equal mt.Email "" "The e-mail address should be blank"
Expect.equal mt.password "" "The password should be blank" Expect.equal mt.Password "" "The password should be blank"
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should be an empty GUID" Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID"
Expect.isNone mt.rememberMe "Remember Me should be None" Expect.isNone mt.RememberMe "Remember Me should be None"
Expect.isNone mt.redirectUrl "Redirect URL should be None" Expect.isNone mt.RedirectUrl "Redirect URL should be None"
} }
] ]
@ -661,20 +703,20 @@ let userMessageTests =
testList "UserMessage" [ testList "UserMessage" [
test "Error is constructed properly" { test "Error is constructed properly" {
let msg = UserMessage.error let msg = UserMessage.error
Expect.equal msg.level "ERROR" "Incorrect message level" Expect.equal msg.Level Error "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.Text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.Description "Description should have been None"
} }
test "Warning is constructed properly" { test "Warning is constructed properly" {
let msg = UserMessage.warning let msg = UserMessage.warning
Expect.equal msg.level "WARNING" "Incorrect message level" Expect.equal msg.Level Warning "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.Text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.Description "Description should have been None"
} }
test "Info is constructed properly" { test "Info is constructed properly" {
let msg = UserMessage.info let msg = UserMessage.info
Expect.equal msg.level "Info" "Incorrect message level" Expect.equal msg.Level Info "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.Text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.Description "Description should have been None"
} }
] ]

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

@ -6,45 +6,50 @@ open PrayerTracker.ViewModels
/// View for the church edit page /// View for the church edit page
let edit (m : EditChurch) ctx vi = 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 () let s = I18N.localizer.Force ()
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [ [ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [ style [ _scoped ] [
rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }"
] ]
csrfToken ctx 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s["Church Name"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "City"] [ locStr s["City"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "ST" ] [ locStr s["State"] ] label [ _for "state" ] [ locStr s["State or Province"] ]
input [ _type "text"; _name "st"; _id "st"; _required; _minlength "2"; _maxlength "2"; _value m.st ] 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-field-row" ] [
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox" input [ _type "checkbox"
_name "hasInterface" _name (nameof m.HasInterface)
_id "hasInterface" _id "hasInterface"
_value "True" _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"] ] 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-row pt-fadeable"; _id "divInterfaceAddress" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "interfaceAddress" ] [ locStr s["VPR Interface URL"] ] label [ _for "interfaceAddress" ] [ locStr s["VPR Interface URL"] ]
input input [ _type "url"
[ _type "url"; _name "interfaceAddress"; _id "interfaceAddress"; _name (nameof m.InterfaceAddress)
_value (match m.interfaceAddress with Some ia -> ia | None -> "") _id "interfaceAddress";
] _value (defaultArg m.InterfaceAddress "") ]
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save Church"] ] 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"]}""" _alt $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_title $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}""" _title $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ] _style "vertical-align:text-bottom;" ]
str vi.version str vi.Version
] ]
] ]
|> div [] |> div []

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

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

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

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

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

@ -18,14 +18,15 @@
</ItemGroup> </ItemGroup>
<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="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.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

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

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

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

@ -10,13 +10,14 @@ open PrayerTracker.ViewModels
/// View for the announcement page /// View for the announcement page
let announcement isAdmin ctx vi = let announcement isAdmin ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let m = { SendToClass = ""; Text = ""; AddToRequestList = None; RequestType = None }
let reqTypes = ReferenceList.requestTypeList s let reqTypes = ReferenceList.requestTypeList s
[ form [ _action "/web/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [ [ form [ _action "/web/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [ div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s["Announcement Text"] ] label [ _for "text" ] [ locStr s["Announcement Text"] ]
textarea [ _name "text"; _id "text"; _autofocus ] [] textarea [ _name (nameof m.Text); _id "text"; _autofocus ] []
] ]
] ]
if isAdmin then if isAdmin then
@ -24,27 +25,27 @@ let announcement isAdmin ctx vi =
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s["Send Announcement to"]; rawText ":" ] label [] [ locStr s["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [ 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; " ] 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"]] ] 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-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
div [ _class "pt-checkbox-field" ] [ 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"] ] label [ _for "addToRequestList" ] [ locStr s["Add to Request List"] ]
] ]
] ]
div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [ div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s["Request Type"] ] label [ _for (nameof m.RequestType) ] [ locStr s["Request Type"] ]
reqTypes reqTypes
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" "Announcement" [] |> selectList (nameof m.RequestType) Announcement.code []
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "send" s["Send Announcement"] ] div [ _class "pt-field-row" ] [ submit [] "send" s["Send Announcement"] ]
@ -59,11 +60,11 @@ let announcement isAdmin ctx vi =
let announcementSent (m : Announcement) vi = let announcementSent (m : Announcement) vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ] [ 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 []
br [] br []
span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ] 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.Content.standard
|> Layout.standard vi "Announcement Sent" |> Layout.standard vi "Announcement Sent"
@ -72,24 +73,24 @@ let announcementSent (m : Announcement) vi =
/// View for the small group add/edit page /// View for the small group add/edit page
let edit (m : EditSmallGroup) (churches : Church list) ctx vi = let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
let s = I18N.localizer.Force () 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" ] [ form [ _action "/web/small-group/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s["Group Name"] ] 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s["Church"] ] label [ _for (nameof m.ChurchId) ] [ locStr s["Church"] ]
seq { seq {
"", selectDefault s["Select Church"].Value "", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name) yield! churches |> List.map (fun c -> 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"] ] 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 /// 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 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" ] [ 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 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "memberName" ] [ locStr s["Member Name"] ] label [ _for "name" ] [ locStr s["Member Name"] ]
input [ _type "text"; _name "memberName"; _id "memberName"; _required; _autofocus; _value m.memberName ] input [ _type "text"; _name (nameof m.Name); _id "name"; _required; _autofocus; _value m.Name ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ] label [ _for "email" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _required; _value m.emailAddress ] input [ _type "email"; _name (nameof m.Email); _id "email"; _required; _value m.Email ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailType" ] [ locStr s["E-mail Format"] ] label [ _for (nameof m.Format) ] [ locStr s["E-mail Format"] ]
typs types
|> Seq.map (fun typ -> fst typ, (snd typ).Value) |> 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"] ] 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 /// 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 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" ] [ [ form [ _action "/web/small-group/log-on/submit"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s["Group"] ] label [ _for (nameof m.SmallGroupId) ] [ locStr s["Group"] ]
seq { seq {
match grps.Length with match groups.Length with
| 0 -> "", s["There are no classes with passwords defined"].Value | 0 -> "", s["There are no classes with passwords defined"].Value
| _ -> | _ ->
"", selectDefault s["Select Group"].Value "", selectDefault s["Select Group"].Value
yield! yield!
grps groups
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}") |> 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" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ] 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 ()) ] _placeholder (s["Case-Sensitive"].Value.ToLower ()) ]
] ]
] ]
div [ _class "pt-checkbox-field" ] [ 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"] ] label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br [] br []
small [] [ em [] [ str (s["Requires Cookies"].Value.ToLower ()) ] ] 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 /// 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 s = I18N.localizer.Force ()
let grpTbl = let grpTbl =
match grps with match groups with
| [] -> space | [] -> space
| _ -> | _ ->
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
@ -187,7 +192,7 @@ let maintain (grps : SmallGroup list) ctx vi =
th [] [ locStr s["Time Zone"] ] th [] [ locStr s["Time Zone"] ]
] ]
] ]
grps groups
|> List.map (fun g -> |> List.map (fun g ->
let grpId = flatGuid g.smallGroupId let grpId = flatGuid g.smallGroupId
let delAction = $"/web/small-group/{grpId}/delete" let delAction = $"/web/small-group/{grpId}/delete"
@ -218,7 +223,7 @@ let maintain (grps : SmallGroup list) ctx vi =
br [] br []
br [] br []
] ]
tableSummary grps.Length s tableSummary groups.Length s
grpTbl grpTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ] 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 /// 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 s = I18N.localizer.Force ()
let mbrTbl = let mbrTbl =
match mbrs with match members with
| [] -> space | [] -> space
| _ -> | _ ->
table [ _class "pt-table pt-action-table" ] [ 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"] ] th [] [ locStr s["Format"] ]
] ]
] ]
mbrs members
|> List.map (fun mbr -> |> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId let mbrId = flatGuid mbr.memberId
let delAction = $"/web/small-group/member/{mbrId}/delete" let delAction = $"/web/small-group/member/{mbrId}/delete"
@ -271,7 +276,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
br [] br []
br [] br []
] ]
tableSummary mbrs.Length s tableSummary members.Length s
mbrTbl mbrTbl
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ] 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 overview m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let linkSpacer = rawText "&nbsp; " let linkSpacer = rawText "&nbsp; "
let typs = ReferenceList.requestTypeList s |> dict let types = ReferenceList.requestTypeList s |> dict
article [ _class "pt-overview" ] [ article [ _class "pt-overview" ] [
section [] [ section [] [
header [ _role "heading" ] [ header [ _role "heading" ] [
@ -306,16 +311,16 @@ let overview m vi =
] ]
div [] [ div [] [
p [ _class "pt-center-text" ] [ 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 [] hr []
for cat in m.activeReqsByCat do for cat in m.ActiveReqsByType do
str (cat.Value.ToString "N0") str (cat.Value.ToString "N0")
space space
locStr typs[cat.Key] locStr types[cat.Key]
br [] br []
br [] br []
str (m.allReqs.ToString "N0") str (m.AllReqs.ToString "N0")
space space
locStr s["Total Requests"] locStr s["Total Requests"]
hr [] hr []
@ -332,7 +337,7 @@ let overview m vi =
locStr s["Group Members"] locStr s["Group Members"]
] ]
div [ _class "pt-center-text" ] [ 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 [] hr []
a [ _href "/web/small-group/members" ] [ icon "email"; linkSpacer; locStr s["Maintain Group Members"] ] 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 () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ form [ _action "/web/small-group/preferences/save"; _method "post"; _class "pt-center-columns" ] [ [ 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 csrfToken ctx
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "date_range"; rawText " &nbsp;"; locStr s["Dates"] ] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "expireDays" ] [ locStr s["Requests Expire After"] ] label [ _for "expireDays" ] [ locStr s["Requests Expire After"] ]
span [] [ span [] [
input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required input [ _type "number"
_autofocus; _value (string m.expireDays) ] _name (nameof m.ExpireDays)
_id "expireDays"
_min "1"; _max "30"
_required
_autofocus
_value (string m.ExpireDays) ]
space; str (s["Days"].Value.ToLower ()) space; str (s["Days"].Value.ToLower ())
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "daysToKeepNew" ] [ locStr s["Requests “New” For"] ] label [ _for "daysToKeepNew" ] [ locStr s["Requests “New” For"] ]
span [] [ span [] [
input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30" input [ _type "number"
_required; _value (string m.daysToKeepNew) ] _name (nameof m.DaysToKeepNew)
_id "daysToKeepNew"
_min "1"; _max "30"
_required
_value (string m.DaysToKeepNew) ]
space; str (s["Days"].Value.ToLower ()) space; str (s["Days"].Value.ToLower ())
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "longTermUpdateWeeks" ] [ locStr s["Long-Term Requests Alerted for Update"] ] label [ _for "longTermUpdateWeeks" ] [ locStr s["Long-Term Requests Alerted for Update"] ]
span [] [ span [] [
input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1" input [ _type "number"
_max "30"; _required; _value (string m.longTermUpdateWeeks) ] _name (nameof m.LongTermUpdateWeeks)
_id "longTermUpdateWeeks"
_min "1"; _max "30"
_required
_value (string m.LongTermUpdateWeeks) ]
space; str (s["Weeks"].Value.ToLower ()) space; str (s["Weeks"].Value.ToLower ())
] ]
] ]
@ -383,10 +402,10 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "sort"; rawText " &nbsp;"; locStr s["Request Sorting"] ] ] 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"] ] label [ _for "requestSort_D" ] [ locStr s["Sort by Last Updated Date"] ]
rawText " &nbsp; " 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"] ] label [ _for "requestSort_R" ] [ locStr s["Sort by Requestor Name"] ]
] ]
fieldset [] [ fieldset [] [
@ -394,17 +413,24 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailFromName" ] [ locStr s["From Name"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "emailFromAddress" ] [ locStr s["From Address"] ] label [ _for "emailFromAddress" ] [ locStr s["From Address"] ]
input [ _type "email"; _name "emailFromAddress"; _id "emailFromAddress"; _required input [ _type "email"
_value m.emailFromAddress ] _name (nameof m.EmailFromAddress)
_id "emailFromAddress"
_required
_value m.EmailFromAddress ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s["E-mail Format"] ] label [ _for (nameof m.DefaultEmailType) ] [ locStr s["E-mail Format"] ]
seq { seq {
"", selectDefault s["Select"].Value "", selectDefault s["Select"].Value
yield! yield!
@ -412,7 +438,7 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
|> Seq.skip 1 |> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value) |> 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" ] [ div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Lines"] ] label [ _class "pt-center-text" ] [ locStr s["Color of Heading Lines"] ]
span [] [ span [] [
radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType radio (nameof m.LineColorType) "lineColorType_Name" "Name" m.LineColorType
label [ _for "headingLineType_Name" ] [ locStr s["Named Color"] ] label [ _for "lineColorType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingLineColor" m.headingLineColor namedColorList (nameof m.LineColor) m.LineColor
[ _id "headingLineColor_Select" [ _id "lineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s if m.LineColor.StartsWith "#" then _disabled ] s
rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType radio (nameof m.LineColorType) "lineColorType_RGB" "RGB" m.LineColorType
label [ _for "headingLineType_RGB" ] [ locStr s["Custom Color"] ] label [ _for "lineColorType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color" input [ _type "color"
_name "headingLineColor" _name (nameof m.LineColor)
_id "headingLineColor_Color" _id "lineColor_Color"
_value m.headingLineColor _value m.LineColor // TODO: convert to hex or skip if named
match m.headingLineColor.StartsWith "#" with true -> () | false -> _disabled ] if not (m.LineColor.StartsWith "#") then _disabled ]
] ]
] ]
] ]
@ -442,19 +468,19 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Text"] ] label [ _class "pt-center-text" ] [ locStr s["Color of Heading Text"] ]
span [] [ span [] [
radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType radio (nameof m.HeadingColorType) "headingColorType_Name" "Name" m.HeadingColorType
label [ _for "headingTextType_Name" ] [ locStr s["Named Color"] ] label [ _for "headingColorType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingTextColor" m.headingTextColor namedColorList (nameof m.HeadingColor) m.HeadingColor
[ _id "headingTextColor_Select" [ _id "headingColor_Select"
match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s if m.HeadingColor.StartsWith "#" then _disabled ] s
rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType radio (nameof m.HeadingColorType) "headingColorType_RGB" "RGB" m.HeadingColorType
label [ _for "headingTextType_RGB" ] [ locStr s["Custom Color"] ] label [ _for "headingColorType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color" input [ _type "color"
_name "headingTextColor" _name (nameof m.HeadingColor)
_id "headingTextColor_Color" _id "headingColor_Color"
_value m.headingTextColor _value m.HeadingColor // TODO: convert to hex or skip if named
match m.headingTextColor.StartsWith "#" with true -> () | false -> _disabled ] if not (m.HeadingColor.StartsWith "#") then _disabled ]
] ]
] ]
] ]
@ -462,19 +488,27 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "font_download"; rawText " &nbsp;"; locStr s["Fonts"] ] ] legend [] [ strong [] [ icon "font_download"; rawText " &nbsp;"; locStr s["Fonts"] ] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "listFonts" ] [ locStr s["Fonts** for List"] ] label [ _for "fonts" ] [ locStr s["Fonts** for List"] ]
input [ _type "text"; _name "listFonts"; _id "listFonts"; _required; _value m.listFonts ] input [ _type "text"; _name (nameof m.Fonts); _id "fonts"; _required; _value m.Fonts ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "headingFontSize" ] [ locStr s["Heading Text Size"] ] label [ _for "headingFontSize" ] [ locStr s["Heading Text Size"] ]
input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24" input [ _type "number"
_required; _value (string m.headingFontSize) ] _name (nameof m.HeadingFontSize)
_id "headingFontSize"
_min "8"; _max "24"
_required
_value (string m.HeadingFontSize) ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "listFontSize" ] [ locStr s["List Text Size"] ] label [ _for "listFontSize" ] [ locStr s["List Text Size"] ]
input [ _type "number"; _name "listFontSize"; _id "listFontSize"; _min "8"; _max "24"; _required input [ _type "number"
_value (string m.listFontSize) ] _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"] ] ] legend [] [ strong [] [ icon "settings"; rawText " &nbsp;"; locStr s["Other Settings"] ] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "timeZone" ] [ locStr s["Time Zone"] ] label [ _for (nameof m.TimeZone) ] [ locStr s["Time Zone"] ]
seq { seq {
"", selectDefault s["Select"].Value "", selectDefault s["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value) yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
} }
|> selectList "timeZone" m.timeZone [ _required ] |> selectList (nameof m.TimeZone) m.TimeZone [ _required ]
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s["Request List Visibility"] ] label [] [ locStr s["Request List Visibility"] ]
span [] [ 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"] ] label [ _for "viz_Public" ] [ locStr s["Public"] ]
rawText " &nbsp;" rawText " &nbsp;"
radio "listVisibility" "viz_Private" (string RequestVisibility.``private``) radio (nameof m.Visibility) "viz_Private" (string RequestVisibility.``private``)
(string m.listVisibility) (string m.Visibility)
label [ _for "viz_Private" ] [ locStr s["Private"] ] label [ _for "viz_Private" ] [ locStr s["Private"] ]
rawText " &nbsp;" rawText " &nbsp;"
radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected) radio (nameof m.Visibility) "viz_Password" (string RequestVisibility.passwordProtected)
(string m.listVisibility) (string m.Visibility)
label [ _for "viz_Password" ] [ locStr s["Password Protected"] ] 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 [ _id "divClassPassword"; _class $"pt-field-row pt-fadeable{classSuffix}" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "groupPassword" ] [ locStr s["Group Password (Used to Read Online)"] ] label [ _for "groupPassword" ] [ locStr s["Group Password (Used to Read Online)"] ]
input [ _type "text"; _name "groupPassword"; _id "groupPassword"; input [ _type "text"
_value (match m.groupPassword with Some x -> x | None -> "") ] _name (nameof m.GroupPassword)
_id "groupPassword"
_value (defaultArg m.GroupPassword "") ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "pageSize" ] [ locStr s["Page Size"] ] label [ _for "pageSize" ] [ locStr s["Page Size"] ]
input [ _type "number"; _name "pageSize"; _id "pageSize"; _min "10"; _max "255"; _required input [ _type "number"
_value (string m.pageSize) ] _name (nameof m.PageSize)
_id "pageSize"
_min "10"; _max "255"
_required
_value (string m.PageSize) ]
] ]
div [ _class "pt-field" ] [ 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 ReferenceList.asOfDateList s
|> List.map (fun (code, desc) -> code, desc.Value) |> 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 /// View for the group assignment page
let assignGroups m groups curGroups ctx vi = let assignGroups m groups curGroups ctx vi =
let s = I18N.localizer.Force () 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" ] [ form [ _action "/web/user/small-groups/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ] input [ _type "hidden"; _name (nameof m.UserId); _value (flatGuid m.UserId) ]
input [ _type "hidden"; _name "userName"; _value m.userName ] input [ _type "hidden"; _name (nameof m.UserName); _value m.UserName ]
table [ _class "pt-table" ] [ table [ _class "pt-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
@ -25,10 +25,10 @@ let assignGroups m groups curGroups ctx vi =
tr [] [ tr [] [
td [] [ td [] [
input [ _type "checkbox" input [ _type "checkbox"
_name "smallGroups" _name (nameof m.SmallGroups)
_id inputId _id inputId
_value grpId _value grpId
match curGroups |> List.contains grpId with true -> _checked | false -> () ] if List.contains grpId curGroups then _checked ]
] ]
td [] [ label [ _for inputId ] [ str grpName ] ] td [] [ label [ _for inputId ] [ str grpName ] ]
]) ])
@ -44,6 +44,7 @@ let assignGroups m groups curGroups ctx vi =
/// View for the password change page /// View for the password change page
let changePassword ctx vi = let changePassword ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let m = { OldPassword = ""; NewPassword = ""; NewPasswordConfirm = "" }
[ p [ _class "pt-center-text" ] [ [ 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."] 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "oldPassword" ] [ locStr s["Current Password"] ] 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "newPassword" ] [ locStr s["New Password Twice"] ] 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" ] [ div [ _class "pt-field" ] [
label [] [ rawText "&nbsp;" ] 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" ] [ div [ _class "pt-field-row" ] [
@ -81,49 +82,57 @@ let changePassword ctx vi =
/// View for the edit user page /// View for the edit user page
let edit (m : EditUser) ctx vi = let edit (m : EditUser) ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = if m.isNew () then "Add a New User" else "Edit User" 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 pwPlaceholder = s[if m.IsNew then "" else "No change"].Value
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns" [ 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"]}')""" ] [ _onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s["The passwords do not match"]}')""" ] [
style [ _scoped ] style [ _scoped ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ] [ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #email { width: 20rem; } " ]
csrfToken ctx 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "firstName" ] [ locStr s["First Name"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "lastName" ] [ locStr s["Last Name"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ] label [ _for "email" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required ] input [ _type "email"; _name (nameof m.Email); _id "email"; _value m.Email; _required ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "passwordConfirm" ] [ locStr s["Password Again"] ] 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" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox" input [ _type "checkbox"
_name "isAdmin" _name (nameof m.IsAdmin)
_id "isAdmin" _id "isAdmin"
_value "True" _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"] ] label [ _for "isAdmin" ] [ locStr s["This user is a PrayerTracker administrator"] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save User"] ] 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.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard vi pageTitle
@ -133,33 +142,35 @@ let edit (m : EditUser) ctx vi =
let logOn (m : UserLogOn) groups ctx vi = let logOn (m : UserLogOn) groups ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
form [ _action "/web/user/log-on"; _method "post"; _class "pt-center-columns" ] [ 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 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-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress"] [ locStr s["E-mail Address"] ] label [ _for "email"] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required input [ _type "email"; _name (nameof m.Email); _id "email"; _value m.Email; _required; _autofocus ]
_autofocus ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s["Password"] ] 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 ())) ] _placeholder (sprintf "(%s)" (s["Case-Sensitive"].Value.ToLower ())) ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s["Group"] ] label [ _for (nameof m.SmallGroupId) ] [ locStr s["Group"] ]
seq { seq {
"", selectDefault s["Select Group"].Value "", selectDefault s["Select Group"].Value
yield! groups yield! groups
} }
|> selectList "smallGroupId" "" [ _required ] |> selectList (nameof m.SmallGroupId) "" [ _required ]
] ]
] ]
div [ _class "pt-checkbox-field" ] [ 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"] ] label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br [] br []
small [] [ em [] [ rawText "("; str (s["Requires Cookies"].Value.ToLower ()); rawText ")" ] ] 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) = let replaceFirst (needle : string) replacement (haystack : string) =
match haystack.IndexOf needle with match haystack.IndexOf needle with
| -1 -> haystack | -1 -> haystack
| idx -> | idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ]
[ haystack[0..idx - 1]
replacement
haystack[idx + needle.Length..]
]
|> String.concat ""
open System.Text.RegularExpressions open System.Text.RegularExpressions
@ -49,14 +44,15 @@ let stripTags allowedTags input =
let mutable output = input let mutable output = input
for tag in stripHtmlExp.Matches input do for tag in stripHtmlExp.Matches input do
let htmlTag = tag.Value.ToLower () let htmlTag = tag.Value.ToLower ()
let isAllowed = let shouldReplace =
allowedTags allowedTags
|> List.fold (fun acc t -> |> List.fold (fun acc t ->
acc acc
|| htmlTag.IndexOf $"<{t}>" = 0 || htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf $"<{t} " = 0 || htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf $"</{t}" = 0) false || 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 output
@ -88,9 +84,9 @@ let wordWrap charPerLine (input : string) =
remaining <- remaining[spaceIdx + 1..] remaining <- remaining[spaceIdx + 1..]
// Leftovers - yum! // Leftovers - yum!
match remaining.Length with 0 -> () | _ -> yield remaining match remaining.Length with 0 -> () | _ -> yield remaining
yield ""
} }
|> Seq.fold (fun (acc : StringBuilder) -> acc.AppendLine) (StringBuilder ()) |> String.concat "\n"
|> string
/// Modify the text returned by CKEditor into the format we need for request and announcement text /// Modify the text returned by CKEditor into the format we need for request and announcement text
let ckEditorToText (text : string) = let ckEditorToText (text : string) =

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

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

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 match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m -> | Ok m ->
let! church = let! church =
if m.isNew () then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () })
else ctx.db.TryChurchById m.churchId else ctx.db.TryChurchById m.ChurchId
match church with match church with
| Some ch -> | Some ch ->
m.populateChurch ch m.PopulateChurch ch
|> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry) |> (if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
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} church “{1}”", act, m.name] addInfo ctx s["Successfully {0} church “{1}”", act, m.Name]
return! redirectTo false "/web/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour 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)) HttpOnly = true))
| None -> () | None -> ()
{ AppViewInfo.fresh with { AppViewInfo.fresh with
version = appVersion Version = appVersion
messages = msg Messages = msg
requestStart = startTicks RequestStart = startTicks
user = ctx.Session.user User = ctx.Session.user
group = ctx.Session.smallGroup Group = ctx.Session.smallGroup
} }
/// The view is the last parameter, so it can be composed /// 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 /// Add an error message to the session
let addError ctx msg = 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 /// Add an informational message to the session
let addInfo ctx msg = 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 /// Add an informational HTML message to the session
let addHtmlInfo ctx msg = 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 /// Add a warning message to the session
let addWarning ctx msg = 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 /// 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 /// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj = let createMessage (grp : SmallGroup) subj =
let msg = MimeMessage () let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress)) msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress))
msg.Subject <- subj msg.Subject <- subj
msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress)) msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress))
@ -40,7 +40,7 @@ let createHtmlMessage grp subj body (s : IStringLocalizer) =
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage grp subj
msg.Body <- TextPart (TextFormat.Html, Text = bodyText) msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg msg
/// Create a plain-text-format e-mail message /// Create a plain-text-format e-mail message
@ -54,13 +54,13 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage grp subj
msg.Body <- TextPart (TextFormat.Plain, Text = bodyText) msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
msg msg
/// Send e-mails to a class /// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task { let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
let htmlMsg = createHtmlMessage grp subj html s use htmlMsg = createHtmlMessage grp subj html s
let plainTextMsg = createTextMessage grp subj text s use plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do for mbr in recipients do
let emailType = let emailType =
@ -71,10 +71,10 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
match emailType with match emailType with
| HtmlFormat -> | HtmlFormat ->
htmlMsg.To.Add emailTo htmlMsg.To.Add emailTo
do! client.SendAsync htmlMsg let! _ = client.SendAsync htmlMsg
htmlMsg.To.Clear () htmlMsg.To.Clear ()
| PlainTextFormat -> | PlainTextFormat ->
plainTextMsg.To.Add emailTo plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg let! _ = client.SendAsync plainTextMsg
plainTextMsg.To.Clear () plainTextMsg.To.Clear ()
} }

98
src/PrayerTracker/PrayerRequest.fs
View File

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

10
src/PrayerTracker/PrayerTracker.fsproj
View File

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

98
src/PrayerTracker/SmallGroup.fs
View File

@ -21,7 +21,7 @@ let private setGroupCookie (ctx : HttpContext) pwHash =
/// GET /small-group/announcement /// GET /small-group/announcement
let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx -> let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.sendAnnouncement; script = [ "ckeditor/ckeditor" ] } { viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.sendAnnouncement; Script = [ "ckeditor/ckeditor" ] }
|> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx |> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx
|> renderHtml next ctx |> renderHtml next ctx
@ -32,12 +32,12 @@ let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=>
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp -> | Some grp ->
let! reqs = ctx.db.CountRequestsBySmallGroup groupId let! reqs = ctx.db.CountRequestsBySmallGroup groupId
let! usrs = ctx.db.CountUsersBySmallGroup groupId let! users = ctx.db.CountUsersBySmallGroup groupId
ctx.db.RemoveEntry grp ctx.db.RemoveEntry grp
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs] grp.name, reqs, users]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@ -82,18 +82,18 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=>
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx let grp = currentGroup ctx
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
if memberId = Guid.Empty then if memberId = Guid.Empty then
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty typs ctx |> Views.SmallGroup.editMember EditMember.empty types ctx
|> renderHtml next ctx |> renderHtml next ctx
else else
match! ctx.db.TryMemberById memberId with match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@ -103,11 +103,11 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=>
/// GET /small-group/log-on/[group-id?] /// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.ProtectedGroups () let! groups = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> "" let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn } { viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx |> Views.SmallGroup.logOn groups grpId ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@ -117,28 +117,26 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
match! ctx.TryBindFormAsync<GroupLogOn> () with match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with match! ctx.db.TryGroupLogOnByPassword m.SmallGroupId m.Password with
| Some grp -> | Some grp ->
ctx.Session.smallGroup <- Some grp ctx.Session.smallGroup <- Some grp
match m.rememberMe with if defaultArg m.RememberMe false then (setGroupCookie ctx << sha1Hash) m.Password
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
| _ -> ()
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx return! redirectTo false "/web/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s["Password incorrect - login unsuccessful"] addError ctx s["Password incorrect - login unsuccessful"]
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx return! redirectTo false $"/web/small-group/log-on/{flatGuid m.SmallGroupId}" next ctx
| Error e -> return! bindError e next ctx | Result.Error e -> return! bindError e next ctx
} }
/// GET /small-groups /// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.AllGroups () let! groups = ctx.db.AllGroups ()
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx |> Views.SmallGroup.maintain groups ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@ -148,11 +146,11 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId let! members = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers } { viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members mbrs typs ctx |> Views.SmallGroup.members members types ctx
|> renderHtml next 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! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let m = let m =
{ totalActiveReqs = List.length reqs { TotalActiveReqs = List.length reqs
allReqs = reqCount AllReqs = reqCount
totalMbrs = mbrCount TotalMembers = mbrCount
activeReqsByCat = ActiveReqsByType =
(reqs (reqs
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun req -> req.requestType) |> 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 startTicks = DateTime.Now.Ticks
let! tzs = ctx.db.AllTimeZones () let! tzs = ctx.db.AllTimeZones ()
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences } { viewInfo ctx startTicks with HelpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx |> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@ -200,22 +198,22 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! group = let! group =
if m.isNew () then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
else ctx.db.TryGroupById m.smallGroupId else ctx.db.TryGroupById m.SmallGroupId
match group with match group with
| Some grp -> | Some grp ->
m.populateGroup grp m.populateGroup grp
|> function |> function
| grp when m.isNew () -> | grp when m.IsNew ->
ctx.db.AddEntry grp ctx.db.AddEntry grp
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId } ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp | grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower () let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.name] addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.Name]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour 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 -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let! mMbr = let! mMbr =
if m.isNew () then if m.IsNew then
Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId }) 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 match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
{ mbr with { mbr with
memberName = m.memberName memberName = m.Name
email = m.emailAddress email = m.Email
format = match m.emailType with "" | null -> None | _ -> Some m.emailType 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! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower () let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act] addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/web/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | 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. // database values, not the then out-of-sync session ones.
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
| Some grp -> | Some grp ->
let prefs = m.populatePreferences grp.preferences let prefs = m.PopulatePreferences grp.preferences
ctx.db.UpdateEntry prefs ctx.db.UpdateEntry prefs
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
// Refresh session instance // Refresh session instance
@ -265,7 +263,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
addInfo ctx s["Group preferences updated successfully"] addInfo ctx s["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour 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 now = grp.localTimeNow (ctx.GetService<IClock> ())
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
// Reformat the text to use the class's font stylings // Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text let requestText = ckEditorToText m.Text
let htmlText = let htmlText =
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ] p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
[ rawText requestText ] [ rawText requestText ]
@ -287,7 +285,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails // Send the e-mails
let! recipients = let! recipients =
match m.sendToClass with match m.SendToClass with
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers () | "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers ()
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId | _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection () use! client = Email.getConnection ()
@ -296,7 +294,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
(now.ToString "h:mm tt").ToLower ()].Value (now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s htmlText plainText s
// Add to the request list if desired // Add to the request list if desired
match m.sendToClass, m.addToRequestList with match m.SendToClass, m.AddToRequestList with
| "N", _ | "N", _
| _, None -> () | _, None -> ()
| _, Some x when not x -> () | _, Some x when not x -> ()
@ -305,7 +303,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
prayerRequestId = Guid.NewGuid () prayerRequestId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId smallGroupId = grp.smallGroupId
userId = usr.userId userId = usr.userId
requestType = (Option.get >> PrayerRequestType.fromCode) m.requestType requestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType
text = requestText text = requestText
enteredDate = now enteredDate = now
updatedDate = now updatedDate = now
@ -315,14 +313,14 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=>
() ()
// Tell 'em what they've won, Johnny! // Tell 'em what they've won, Johnny!
let toWhom = let toWhom =
match m.sendToClass with match m.SendToClass with
| "N" -> s["{0} users", s["PrayerTracker"]].Value | "N" -> s["{0} users", s["PrayerTracker"]].Value
| _ -> s["Group Members"].Value.ToLower () | _ -> 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]] addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.announcementSent { m with text = htmlText } |> Views.SmallGroup.announcementSent { m with Text = htmlText }
|> renderHtml next ctx |> 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 /// Retrieve a user from the database by password
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does // If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
let private findUserByPassword m (db : AppDbContext) = task { let private findUserByPassword 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 -> | Some u when Option.isSome u.salt ->
// Already upgraded; match = success // Already upgraded; match = success
let pwHash = pbkdf2Hash (Option.get u.salt) m.password let pwHash = pbkdf2Hash (Option.get u.salt) m.Password
if u.passwordHash = pwHash then if u.passwordHash = pwHash then
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
else return None, "" else return None, ""
| Some u when u.passwordHash = sha1Hash m.password -> | Some u when u.passwordHash = sha1Hash m.Password ->
// Not upgraded, but password is good; upgrade 'em! // Not upgraded, but password is good; upgrade 'em!
// Upgrade 'em! // Upgrade 'em!
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password let pwHash = pbkdf2Hash salt m.Password
let upgraded = { u with salt = Some salt; passwordHash = pwHash } let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
@ -54,16 +54,16 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> f
match dbUsr with match dbUsr with
| Some usr -> | Some usr ->
// Check the old password against a possibly non-salted hash // Check the old password against a possibly non-salted hash
(match usr.salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.oldPassword (match usr.salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.OldPassword
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId |> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
| _ -> Task.FromResult None | _ -> Task.FromResult None
match user with match user with
| Some _ when m.newPassword = m.newPasswordConfirm -> | Some _ when m.NewPassword = m.NewPasswordConfirm ->
match dbUsr with match dbUsr with
| Some usr -> | Some usr ->
// Generate new salt whenever the password is changed // Generate new salt whenever the password is changed
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt } ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.NewPassword; salt = Some salt }
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
// If the user is remembered, update the cookie with the new hash // If the user is remembered, update the cookie with the new hash
if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.passwordHash if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.passwordHash
@ -76,7 +76,7 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> f
| None -> | None ->
addError ctx s["The old password was incorrect - your password was NOT changed"] addError ctx s["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx 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 -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! usr, pwHash = findUserByPassword m ctx.db let! usr, pwHash = findUserByPassword m ctx.db
let! grp = ctx.db.TryGroupById m.smallGroupId let! grp = ctx.db.TryGroupById m.SmallGroupId
let nextUrl = let nextUrl =
match usr with match usr with
| Some _ -> | Some _ ->
ctx.Session.user <- usr ctx.Session.user <- usr
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
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"]] addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
match m.redirectUrl with match m.RedirectUrl with
| None -> "/web/small-group" | None -> "/web/small-group"
| Some x when x = "" -> "/web/small-group" | Some x when x = "" -> "/web/small-group"
| Some x -> x | Some x -> x
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.error with { UserMessage.error with
text = htmlLocString s["Invalid credentials - log on unsuccessful"] Text = htmlLocString s["Invalid credentials - log on unsuccessful"]
description = Description =
[ s["This is likely due to one of the following reasons"].Value [ s["This is likely due to one of the following reasons"].Value
":<ul><li>" ":<ul><li>"
s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.Email].Value
"</li><li>" "</li><li>"
s["The password entered does not match the password for the given e-mail address."].Value s["The password entered does not match the password for the given e-mail address."].Value
"</li><li>" "</li><li>"
@ -132,7 +132,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSR
|> addUserMessage ctx |> addUserMessage ctx
"/web/user/log-on" "/web/user/log-on"
return! redirectTo false nextUrl next ctx 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."] addWarning ctx s["The page you requested requires authentication; please log on below."]
| None -> () | None -> ()
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn } { viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx |> Views.User.logOn { UserLogOn.empty with RedirectUrl = url } groups ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@ -186,7 +186,7 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
/// GET /user/password /// GET /user/password
let password : HttpHandler = requireAccess [ User ] >=> fun next ctx -> 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 |> Views.User.changePassword ctx
|> renderHtml next ctx |> renderHtml next ctx
@ -196,13 +196,13 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
| Ok m -> | Ok m ->
let! user = let! user =
if m.isNew () then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () }) if m.IsNew then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
else ctx.db.TryUserById m.userId else ctx.db.TryUserById m.UserId
let saltedUser = let saltedUser =
match user with match user with
| Some u -> | Some u ->
match u.salt with match u.salt with
| None when m.password <> "" -> | None when m.Password <> "" ->
// Generate salt so that a new password hash can be generated // Generate salt so that a new password hash can be generated
Some { u with salt = Some (Guid.NewGuid ()) } Some { u with salt = Some (Guid.NewGuid ()) }
| _ -> | _ ->
@ -211,15 +211,15 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
| _ -> user | _ -> user
match saltedUser with match saltedUser with
| Some u -> | Some u ->
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry) updatedUser |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
if m.isNew () then if m.IsNew then
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.info with { UserMessage.info with
text = h s["Successfully {0} user", s["Added"].Value.ToLower ()] Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
description = Description =
h s["Please select at least one group for which this user ({0}) is authorized", h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName] updatedUser.fullName]
|> Some |> Some
@ -230,7 +230,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next c
addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()] addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| None -> return! fourOhFour 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 match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with match Seq.length m.SmallGroups with
| 0 -> | 0 ->
addError ctx s["You must select at least one group to assign"] addError ctx s["You must select at least one group to assign"]
return! redirectTo false $"/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 -> | Some user ->
let grps = let groups =
m.smallGroups.Split ',' m.SmallGroups.Split ','
|> Array.map Guid.Parse |> Array.map Guid.Parse
|> List.ofArray |> List.ofArray
user.smallGroups 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 |> ctx.db.UserGroupXref.RemoveRange
grps groups
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x }) |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq |> List.ofSeq
|> List.iter ctx.db.AddEntry |> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s["Successfully updated group permissions for {0}", m.userName] addInfo ctx s["Successfully updated group permissions for {0}", m.UserName]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour 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 let startTicks = DateTime.Now.Ticks
match! ctx.db.TryUserByIdWithGroups userId with match! ctx.db.TryUserByIdWithGroups userId with
| Some user -> | 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 let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }

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

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