28 Commits
v7.2 ... v7.6.1

Author SHA1 Message Date
58519f9a4d Fix announcement send problem (#40) 2022-08-06 09:06:11 -04:00
6b1a5e31b5 Merge pull request #35 from bit-badger/dependabot/bundler/docs/nokogiri-1.13.6
Bump nokogiri from 1.11.4 to 1.13.6 in /docs
2022-08-01 16:24:04 -04:00
dependabot[bot]
d332322200 Bump nokogiri from 1.11.4 to 1.13.6 in /docs
Bumps [nokogiri](https://github.com/sparklemotion/nokogiri) from 1.11.4 to 1.13.6.
- [Release notes](https://github.com/sparklemotion/nokogiri/releases)
- [Changelog](https://github.com/sparklemotion/nokogiri/blob/main/CHANGELOG.md)
- [Commits](https://github.com/sparklemotion/nokogiri/compare/v1.11.4...v1.13.6)

---
updated-dependencies:
- dependency-name: nokogiri
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>
2022-05-18 22:14:29 +00:00
dependabot[bot]
1d4e66b863 Bump nokogiri from 1.10.10 to 1.11.4 in /docs (#29)
Bumps [nokogiri](https://github.com/sparklemotion/nokogiri) from 1.10.10 to 1.11.4.
- [Release notes](https://github.com/sparklemotion/nokogiri/releases)
- [Changelog](https://github.com/sparklemotion/nokogiri/blob/main/CHANGELOG.md)
- [Commits](https://github.com/sparklemotion/nokogiri/compare/v1.10.10...v1.11.4)

Signed-off-by: dependabot[bot] <support@github.com>

Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2021-09-18 22:47:29 -04:00
dependabot[bot]
8c3cce2fd8 Bump rexml from 3.2.4 to 3.2.5 in /docs (#28)
Bumps [rexml](https://github.com/ruby/rexml) from 3.2.4 to 3.2.5.
- [Release notes](https://github.com/ruby/rexml/releases)
- [Changelog](https://github.com/ruby/rexml/blob/master/NEWS.md)
- [Commits](https://github.com/ruby/rexml/compare/v3.2.4...v3.2.5)

Signed-off-by: dependabot[bot] <support@github.com>

Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2021-09-18 22:46:58 -04:00
dependabot[bot]
0de3eac7be Bump addressable from 2.7.0 to 2.8.0 in /docs (#30)
Bumps [addressable](https://github.com/sporkmonger/addressable) from 2.7.0 to 2.8.0.
- [Release notes](https://github.com/sporkmonger/addressable/releases)
- [Changelog](https://github.com/sporkmonger/addressable/blob/main/CHANGELOG.md)
- [Commits](https://github.com/sporkmonger/addressable/compare/addressable-2.7.0...addressable-2.8.0)

---
updated-dependencies:
- dependency-name: addressable
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>

Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2021-09-18 22:45:35 -04:00
1a07c673c7 .NET 6 (#32)
- Convert back-end to .NET 6
- Upgrade Giraffe, convert routing to endpoint style
- Refactor code to take advantage of F# advances
2021-09-18 22:42:40 -04:00
665d80261d Update deps for GitHub Pages 2020-11-16 08:21:08 -05:00
b0d3bd4e35 Update to F# 5 (#27) 2020-11-15 21:57:09 -05:00
e3583f9152 Update branch name in AppVeyor link 2020-06-19 16:36:00 -05:00
7fd15a5cff Display new user name (#26)
Also did some refactoring to pull static members into modules
2020-06-10 23:11:28 -05:00
Daniel J. Summers
cb8c2558e0 Update to .NET Core 3.1 (and deps) (#25) 2020-03-07 12:22:39 -06:00
ffc008e07a Merge pull request #24 from bit-badger/dependabot/bundler/docs/nokogiri-1.10.8
Bump nokogiri from 1.10.4 to 1.10.8 in /docs
2020-03-07 11:24:51 -06:00
dependabot[bot]
81445d48f3 Bump nokogiri from 1.10.4 to 1.10.8 in /docs
Bumps [nokogiri](https://github.com/sparklemotion/nokogiri) from 1.10.4 to 1.10.8.
- [Release notes](https://github.com/sparklemotion/nokogiri/releases)
- [Changelog](https://github.com/sparklemotion/nokogiri/blob/master/CHANGELOG.md)
- [Commits](https://github.com/sparklemotion/nokogiri/compare/v1.10.4...v1.10.8)

Signed-off-by: dependabot[bot] <support@github.com>
2020-02-25 21:22:27 +00:00
Daniel J. Summers
1c33c1368f Change from address (#23) 2019-12-02 21:37:27 -06:00
40642f4436 Merge pull request #21 from bit-badger/release-7.4
Release 7.4
2019-10-19 12:22:52 -05:00
Daniel J. Summers
35815bfee6 Merge branch 'master' into release-7.4 2019-10-19 12:20:18 -05:00
Daniel J. Summers
3f26e7ebc2 Update docs deps 2019-10-19 12:16:08 -05:00
Daniel J. Summers
e29a21ed6e Convert to .NET Core 3.0 (#20)
Also extracted common project items to Directory.Build.props, and fixed code and execution issues related to EF Core 3.0 changes
2019-10-19 11:21:48 -05:00
Daniel J. Summers
bf48c360de Remove yield not required by F# 4.7 2019-10-19 09:07:06 -05:00
Daniel J. Summers
4dbd58fb92 Update queries (WIP) 2019-10-19 09:06:45 -05:00
Daniel J. Summers
a845e03341 Update queries (WIP) 2019-08-20 14:00:27 -05:00
Daniel J. Summers
b379654879 Moved button out of field set (#18) 2019-06-14 19:17:38 -05:00
Daniel J. Summers
d6ece81d82 Move all URLs to /web (#19)
All existing URLs are now under the /web directory
2019-06-14 19:05:37 -05:00
Daniel J. Summers
0748ad6ce8 Fixed expiration comparison (#17)
The comparison now forces the comparison on dates, excluding times
2019-06-13 22:01:08 -05:00
Daniel J. Summers
7d0e1484ba Version bump
also updated dependencies
2019-06-06 16:19:01 -05:00
Daniel J. Summers
087595ee75 Store null if requestor/subject is not entered (#12)
The output was fine; the form was parsing `Some ""` instead of `None` as the code was expecting
2019-06-06 14:22:40 -05:00
Daniel J. Summers
43b6b6d8e0 Search, Paging, and "As of" Date (#10)
Issues Fixed:
* Added request search capability (#2)
* Added pagination to search / inactive request lists (#3)
* Added "as of" date display option for requests (#9)
* Updated documentation to reflect the new options and their behavior

Also Fixed (w/o issue numbers):
* Fixed a verbiage error with the confirmation prompts
* Split the I18N for the maintain requests page into its own localized view
* Modified many "magic strings" in the code to use F# discriminated unions instead (stored as single-character codes in the database)
2019-03-20 19:19:02 -05:00
47 changed files with 2730 additions and 1924 deletions

2
.gitignore vendored
View File

@@ -332,3 +332,5 @@ ASALocalRun/
### --- ###
src/PrayerTracker/appsettings.json
docs/_site
.ionide

View File

@@ -1,6 +1,6 @@
# PrayerTracker
[![Build status](https://ci.appveyor.com/api/projects/status/j5nt9o3pu7er7hyi/branch/master?svg=true)](https://ci.appveyor.com/project/danieljsummers/prayertracker/branch/master)
[![Build status](https://ci.appveyor.com/api/projects/status/j5nt9o3pu7er7hyi/branch/main?svg=true)](https://ci.appveyor.com/project/danieljsummers/prayertracker/branch/main)
### Visit the Site

View File

@@ -1,13 +1,11 @@
GEM
remote: https://rubygems.org/
specs:
activesupport (4.2.10)
i18n (~> 0.7)
minitest (~> 5.1)
thread_safe (~> 0.3, >= 0.3.4)
tzinfo (~> 1.1)
addressable (2.5.2)
public_suffix (>= 2.0.2, < 4.0)
activesupport (3.2.22.5)
i18n (~> 0.6, >= 0.6.4)
multi_json (~> 1.0)
addressable (2.8.0)
public_suffix (>= 2.0.2, < 5.0)
coffee-script (2.4.1)
coffee-script-source
execjs
@@ -15,65 +13,67 @@ GEM
colorator (1.1.0)
commonmarker (0.17.13)
ruby-enum (~> 0.5)
concurrent-ruby (1.1.4)
dnsruby (1.61.2)
addressable (~> 2.5)
em-websocket (0.5.1)
concurrent-ruby (1.1.7)
dnsruby (1.61.5)
simpleidn (~> 0.1)
em-websocket (0.5.2)
eventmachine (>= 0.12.9)
http_parser.rb (~> 0.6.0)
ethon (0.12.0)
ffi (>= 1.3.0)
eventmachine (1.2.7)
eventmachine (1.2.7-x64-mingw32)
execjs (2.7.0)
faraday (0.15.4)
faraday (1.1.0)
multipart-post (>= 1.2, < 3)
ffi (1.10.0)
ruby2_keywords
ffi (1.13.1)
ffi (1.13.1-x64-mingw32)
forwardable-extended (2.6.0)
gemoji (3.0.0)
github-pages (197)
activesupport (= 4.2.10)
gemoji (3.0.1)
github-pages (209)
github-pages-health-check (= 1.16.1)
jekyll (= 3.7.4)
jekyll-avatar (= 0.6.0)
jekyll (= 3.9.0)
jekyll-avatar (= 0.7.0)
jekyll-coffeescript (= 1.1.1)
jekyll-commonmark-ghpages (= 0.1.5)
jekyll-commonmark-ghpages (= 0.1.6)
jekyll-default-layout (= 0.1.4)
jekyll-feed (= 0.11.0)
jekyll-feed (= 0.15.1)
jekyll-gist (= 1.5.0)
jekyll-github-metadata (= 2.12.1)
jekyll-mentions (= 1.4.1)
jekyll-optional-front-matter (= 0.3.0)
jekyll-github-metadata (= 2.13.0)
jekyll-mentions (= 1.6.0)
jekyll-optional-front-matter (= 0.3.2)
jekyll-paginate (= 1.1.0)
jekyll-readme-index (= 0.2.0)
jekyll-redirect-from (= 0.14.0)
jekyll-relative-links (= 0.6.0)
jekyll-remote-theme (= 0.3.1)
jekyll-readme-index (= 0.3.0)
jekyll-redirect-from (= 0.16.0)
jekyll-relative-links (= 0.6.1)
jekyll-remote-theme (= 0.4.2)
jekyll-sass-converter (= 1.5.2)
jekyll-seo-tag (= 2.5.0)
jekyll-sitemap (= 1.2.0)
jekyll-swiss (= 0.4.0)
jekyll-seo-tag (= 2.6.1)
jekyll-sitemap (= 1.4.0)
jekyll-swiss (= 1.0.0)
jekyll-theme-architect (= 0.1.1)
jekyll-theme-cayman (= 0.1.1)
jekyll-theme-dinky (= 0.1.1)
jekyll-theme-hacker (= 0.1.1)
jekyll-theme-hacker (= 0.1.2)
jekyll-theme-leap-day (= 0.1.1)
jekyll-theme-merlot (= 0.1.1)
jekyll-theme-midnight (= 0.1.1)
jekyll-theme-minimal (= 0.1.1)
jekyll-theme-modernist (= 0.1.1)
jekyll-theme-primer (= 0.5.3)
jekyll-theme-primer (= 0.5.4)
jekyll-theme-slate (= 0.1.1)
jekyll-theme-tactile (= 0.1.1)
jekyll-theme-time-machine (= 0.1.1)
jekyll-titles-from-headings (= 0.5.1)
jemoji (= 0.10.2)
kramdown (= 1.17.0)
liquid (= 4.0.0)
listen (= 3.1.5)
jekyll-titles-from-headings (= 0.5.3)
jemoji (= 0.12.0)
kramdown (= 2.3.0)
kramdown-parser-gfm (= 1.1.0)
liquid (= 4.0.3)
mercenary (~> 0.3)
minima (= 2.5.0)
nokogiri (>= 1.8.5, < 2.0)
rouge (= 2.2.1)
minima (= 2.5.1)
nokogiri (>= 1.10.4, < 2.0)
rouge (= 3.23.0)
terminal-table (~> 1.4)
github-pages-health-check (1.16.1)
addressable (~> 2.3)
@@ -81,68 +81,70 @@ GEM
octokit (~> 4.0)
public_suffix (~> 3.0)
typhoeus (~> 1.3)
html-pipeline (2.10.0)
html-pipeline (2.14.0)
activesupport (>= 2)
nokogiri (>= 1.4)
http_parser.rb (0.6.0)
i18n (0.9.5)
concurrent-ruby (~> 1.0)
jekyll (3.7.4)
jekyll (3.9.0)
addressable (~> 2.4)
colorator (~> 1.0)
em-websocket (~> 0.5)
i18n (~> 0.7)
jekyll-sass-converter (~> 1.0)
jekyll-watch (~> 2.0)
kramdown (~> 1.14)
kramdown (>= 1.17, < 3)
liquid (~> 4.0)
mercenary (~> 0.3.3)
pathutil (~> 0.9)
rouge (>= 1.7, < 4)
safe_yaml (~> 1.0)
jekyll-avatar (0.6.0)
jekyll (~> 3.0)
jekyll-avatar (0.7.0)
jekyll (>= 3.0, < 5.0)
jekyll-coffeescript (1.1.1)
coffee-script (~> 2.2)
coffee-script-source (~> 1.11.1)
jekyll-commonmark (1.2.0)
jekyll-commonmark (1.3.1)
commonmarker (~> 0.14)
jekyll (>= 3.0, < 4.0)
jekyll-commonmark-ghpages (0.1.5)
jekyll (>= 3.7, < 5.0)
jekyll-commonmark-ghpages (0.1.6)
commonmarker (~> 0.17.6)
jekyll-commonmark (~> 1)
rouge (~> 2)
jekyll-commonmark (~> 1.2)
rouge (>= 2.0, < 4.0)
jekyll-default-layout (0.1.4)
jekyll (~> 3.0)
jekyll-feed (0.11.0)
jekyll (~> 3.3)
jekyll-feed (0.15.1)
jekyll (>= 3.7, < 5.0)
jekyll-gist (1.5.0)
octokit (~> 4.2)
jekyll-github-metadata (2.12.1)
jekyll (~> 3.4)
jekyll-github-metadata (2.13.0)
jekyll (>= 3.4, < 5.0)
octokit (~> 4.0, != 4.4.0)
jekyll-mentions (1.4.1)
jekyll-mentions (1.6.0)
html-pipeline (~> 2.3)
jekyll (~> 3.0)
jekyll-optional-front-matter (0.3.0)
jekyll (~> 3.0)
jekyll (>= 3.7, < 5.0)
jekyll-optional-front-matter (0.3.2)
jekyll (>= 3.0, < 5.0)
jekyll-paginate (1.1.0)
jekyll-readme-index (0.2.0)
jekyll (~> 3.0)
jekyll-redirect-from (0.14.0)
jekyll (~> 3.3)
jekyll-relative-links (0.6.0)
jekyll (~> 3.3)
jekyll-remote-theme (0.3.1)
jekyll (~> 3.5)
rubyzip (>= 1.2.1, < 3.0)
jekyll-readme-index (0.3.0)
jekyll (>= 3.0, < 5.0)
jekyll-redirect-from (0.16.0)
jekyll (>= 3.3, < 5.0)
jekyll-relative-links (0.6.1)
jekyll (>= 3.3, < 5.0)
jekyll-remote-theme (0.4.2)
addressable (~> 2.0)
jekyll (>= 3.5, < 5.0)
jekyll-sass-converter (>= 1.0, <= 3.0.0, != 2.0.0)
rubyzip (>= 1.3.0, < 3.0)
jekyll-sass-converter (1.5.2)
sass (~> 3.4)
jekyll-seo-tag (2.5.0)
jekyll (~> 3.3)
jekyll-sitemap (1.2.0)
jekyll (~> 3.3)
jekyll-swiss (0.4.0)
jekyll-seo-tag (2.6.1)
jekyll (>= 3.3, < 5.0)
jekyll-sitemap (1.4.0)
jekyll (>= 3.7, < 5.0)
jekyll-swiss (1.0.0)
jekyll-theme-architect (0.1.1)
jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0)
@@ -152,8 +154,8 @@ GEM
jekyll-theme-dinky (0.1.1)
jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0)
jekyll-theme-hacker (0.1.1)
jekyll (~> 3.5)
jekyll-theme-hacker (0.1.2)
jekyll (> 3.5, < 5.0)
jekyll-seo-tag (~> 2.0)
jekyll-theme-leap-day (0.1.1)
jekyll (~> 3.5)
@@ -170,8 +172,8 @@ GEM
jekyll-theme-modernist (0.1.1)
jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0)
jekyll-theme-primer (0.5.3)
jekyll (~> 3.5)
jekyll-theme-primer (0.5.4)
jekyll (> 3.5, < 5.0)
jekyll-github-metadata (~> 2.9)
jekyll-seo-tag (~> 2.0)
jekyll-theme-slate (0.1.1)
@@ -183,64 +185,83 @@ GEM
jekyll-theme-time-machine (0.1.1)
jekyll (~> 3.5)
jekyll-seo-tag (~> 2.0)
jekyll-titles-from-headings (0.5.1)
jekyll (~> 3.3)
jekyll-watch (2.1.2)
jekyll-titles-from-headings (0.5.3)
jekyll (>= 3.3, < 5.0)
jekyll-watch (2.2.1)
listen (~> 3.0)
jemoji (0.10.2)
jemoji (0.12.0)
gemoji (~> 3.0)
html-pipeline (~> 2.2)
jekyll (~> 3.0)
kramdown (1.17.0)
liquid (4.0.0)
listen (3.1.5)
rb-inotify (~> 0.9, >= 0.9.7)
jekyll (>= 3.0, < 5.0)
kramdown (2.3.0)
rexml
kramdown-parser-gfm (1.1.0)
kramdown (~> 2.0)
liquid (4.0.3)
listen (3.3.1)
rb-fsevent (~> 0.10, >= 0.10.3)
rb-inotify (~> 0.9, >= 0.9.10)
mercenary (0.3.6)
mini_portile2 (2.4.0)
minima (2.5.0)
jekyll (~> 3.5)
mini_portile2 (2.8.0)
minima (2.5.1)
jekyll (>= 3.5, < 5.0)
jekyll-feed (~> 0.9)
jekyll-seo-tag (~> 2.1)
minitest (5.11.3)
multipart-post (2.0.0)
nokogiri (1.10.1)
mini_portile2 (~> 2.4.0)
octokit (4.13.0)
multi_json (1.15.0)
multipart-post (2.1.1)
nokogiri (1.13.6)
mini_portile2 (~> 2.8.0)
racc (~> 1.4)
nokogiri (1.13.6-x64-mingw32)
racc (~> 1.4)
octokit (4.19.0)
faraday (>= 0.9)
sawyer (~> 0.8.0, >= 0.5.3)
pathutil (0.16.2)
forwardable-extended (~> 2.6)
public_suffix (3.0.3)
rb-fsevent (0.10.3)
rb-inotify (0.10.0)
public_suffix (3.1.1)
racc (1.6.0)
rb-fsevent (0.10.4)
rb-inotify (0.10.1)
ffi (~> 1.0)
rouge (2.2.1)
ruby-enum (0.7.2)
rexml (3.2.5)
rouge (3.23.0)
ruby-enum (0.8.0)
i18n
rubyzip (1.2.2)
ruby2_keywords (0.0.2)
rubyzip (2.3.0)
safe_yaml (1.0.5)
sass (3.7.3)
sass (3.7.4)
sass-listen (~> 4.0.0)
sass-listen (4.0.0)
rb-fsevent (~> 0.9, >= 0.9.4)
rb-inotify (~> 0.9, >= 0.9.7)
sawyer (0.8.1)
addressable (>= 2.3.5, < 2.6)
faraday (~> 0.8, < 1.0)
sawyer (0.8.2)
addressable (>= 2.3.5)
faraday (> 0.8, < 2.0)
simpleidn (0.1.1)
unf (~> 0.1.4)
terminal-table (1.8.0)
unicode-display_width (~> 1.1, >= 1.1.1)
thread_safe (0.3.6)
typhoeus (1.3.1)
typhoeus (1.4.0)
ethon (>= 0.9.0)
tzinfo (1.2.5)
thread_safe (~> 0.1)
unicode-display_width (1.4.1)
tzinfo (2.0.3)
concurrent-ruby (~> 1.0)
tzinfo-data (1.2020.4)
tzinfo (>= 1.0.0)
unf (0.1.4)
unf_ext
unf_ext (0.0.7.7)
unf_ext (0.0.7.7-x64-mingw32)
unicode-display_width (1.7.0)
PLATFORMS
ruby
x64-mingw32
DEPENDENCIES
github-pages
tzinfo-data
BUNDLED WITH
2.0.1
2.1.4

View File

@@ -8,6 +8,10 @@ From this page, you can add, edit, and delete your current requests. You can als
To add a request, click the icon or text in the center of the page, below the title and above the list of requests for your group.
## Search Requests
If you are looking for a particular requests, enter some text in the search box and click “Search”. PrayerTracker will search the Requestor/Subject and Request Text fields (case-insensitively) of both active and inactive requests. The results will be displayed in the same format as the original Maintain Requests page, so the buttons described below will work the same for those requests as well. They will also be displayed in pages, if there are a lot of results; the number per page is configurable by small group.
## Edit Request
To edit a request, click the blue pencil icon; it's the first icon under the “Actions” column heading.

View File

@@ -26,7 +26,7 @@ PrayerTracker must put an name and e-mail address in the “from” position of
## E-mail Format
"This is the default e-mail format for your group. The PrayerTracker default is HTML, which sends the list just as you see it online. However, some e-mail clients may not display this properly, so you can choose to default the email to a plain-text format, which does not have colors, italics, or other formatting. The setting on this page is the group default; you can select a format for each recipient on the “Maintain Group Members” page.
This is the default e-mail format for your group. The PrayerTracker default is HTML, which sends the list just as you see it online. However, some e-mail clients may not display this properly, so you can choose to default the email to a plain-text format, which does not have colors, italics, or other formatting. The setting on this page is the group default; you can select a format for each recipient on the “Maintain Group Members” page.
## Colors
@@ -60,3 +60,11 @@ This is the time zone that you would like to use for your group. If you do not s
## Request List Visibility
The group's request list can be either public, private, or password-protected. Public lists are available without logging in, and private lists are only available online to administrators (though the list can still be sent via e-mail by an administrator). Password-protected lists allow group members to log in and view the current request list online, using the “Group Log On” link and providing this password. As this is a shared password, it is stored in plain text, so you can easily see what it is. If you select “Password Protected” but do not enter a password, the list remains private, which is also the default value. (Changing this password will force all members of the group who logged in with the “Remember Me” box checked to provide the new password.)
## Page Size
As small groups use PrayerTracker, they accumulate many expired requests. When lists of requests that include expired requests, the results will be broken up into pages. The default value is 100 requests per page, but may be set as low as 10 or as high as 255.
## "As of" Date Display
PrayerTracker can display the last date a request was updated, at the end of the request text. By default, it does not. If you select a short date, it will show "(as of 10/11/2015)" (for October 11, 2015); if you select a long date, it will show "(as of Sunday, October 11, 2015)".

View File

@@ -8,6 +8,10 @@ Desde esta página, usted puede agregar, editar y borrar sus peticiones actuales
Para agregar una petición, haga clic en el icono o el texto en el centro de la página, debajo del título y por encima de la lista de peticiones para su grupo.
## Busca las Peticiones
Si está buscando una solicitud en particular, ingrese un texto en el cuadro de búsqueda y haga clic en “Buscar”. SeguidorOración buscará los campos de Solicitante / Asunto y Texto de solicitud (sin distinción de mayúsculas y minúsculas) de solicitudes activas e inactivas. Los resultados se mostrarán en el mismo formato que la página de solicitudes de mantenimiento original, por lo que los botones que se describen a continuación funcionarán igual para esas solicitudes. También se mostrarán en las páginas, si hay muchos resultados; el número por página es configurable por grupos pequeños.
## Editar la Petición
Para editar una petición, haga clic en el icono de lápiz azul, el primer icono bajo el título de columna “Acciones”.

View File

@@ -60,3 +60,11 @@ Esta es la zona horaria que desea utilizar para su clase. Si no puede ver la zon
## La Visibilidad del la Lista de las Peticiones
La lista de peticiones del grupo puede ser pública, privada o protegida por contraseña. Las listas públicas están disponibles sin iniciar sesión, y listas privadas sólo están disponibles en línea a los administradores (aunque la lista todavía puede ser enviado por correo electrónico por el administrador). Protegidos con contraseña listas permiten miembros del grupo iniciar sesión y ver la lista de peticiones actual en el sito, utilizando el "Iniciar Sesión como Grupo" enlace y proporcionar la contraseña. Como se trata de una contraseña compartida, se almacena en texto plano, así que usted puede ver fácilmente lo que es. Si selecciona "Protegido por Contraseña" pero no introduce una contraseña, la lista sigue siendo privado, que también es el valor predeterminado. (Cambiar esta contraseña obligará a todos los miembros del grupo que se iniciar sesión en el "Acuérdate de Mí" caja marcada para proporcionar la nueva contraseña.)
## Tamaño de Página
A medida que los grupos pequeños utilizan SeguidorOración, acumulan muchas solicitudes caducadas. Cuando las listas de solicitudes que incluyen solicitudes caducadas, los resultados se dividirán en páginas. El valor predeterminado es de 100 solicitudes por página, pero se puede establecer tan bajo como 10 o tan alto como 255.
## Visualización de la Fecha “Como de”
SeguidorOración puede mostrar la última fecha en que se actualizó una solicitud, al final del texto de solicitud. Por defecto, no lo hace. Si selecciona una fecha corta, se mostrará "(como de 11/10/2015)" (para el 11 de octubre de 2015); si selecciona una fecha larga, se mostrará "(como de domingo, 11 de octubre de 2015)".

View File

@@ -0,0 +1,9 @@
<Project>
<PropertyGroup>
<AssemblyVersion>7.6.1.0</AssemblyVersion>
<FileVersion>7.6.1.0</FileVersion>
<Authors>danieljsummers</Authors>
<Company>Bit Badger Solutions</Company>
<Version>7.6.1</Version>
</PropertyGroup>
</Project>

View File

@@ -1,13 +1,39 @@
[<AutoOpen>]
module PrayerTracker.DataAccess
open FSharp.Control.Tasks.ContextInsensitive
open Microsoft.EntityFrameworkCore
open Microsoft.FSharpLu
open PrayerTracker.Entities
open System.Collections.Generic
open System.Linq
[<AutoOpen>]
module private Helpers =
open Microsoft.FSharpLu
open System.Threading.Tasks
/// Central place to append sort criteria for prayer request queries
let reqSort sort (q : IQueryable<PrayerRequest>) =
match sort with
| SortByDate ->
query {
for req in q do
sortByDescending req.updatedDate
thenByDescending req.enteredDate
thenBy req.requestor
}
| SortByRequestor ->
query {
for req in q do
sortBy req.requestor
thenByDescending req.updatedDate
thenByDescending req.enteredDate
}
/// Convert a possibly-null object to an option, wrapped as a task
let toOptionTask<'T> (item : 'T) = (Option.fromObject >> Task.FromResult) item
type AppDbContext with
(*-- DISCONNECTED DATA EXTENSIONS --*)
@@ -28,15 +54,22 @@ type AppDbContext with
/// Find a church by its Id
member this.TryChurchById cId =
task {
let! church = this.Churches.AsNoTracking().FirstOrDefaultAsync (fun c -> c.churchId = cId)
return Option.fromObject church
query {
for ch in this.Churches.AsNoTracking () do
where (ch.churchId = cId)
exactlyOneOrDefault
}
|> toOptionTask
/// Find all churches
member this.AllChurches () =
task {
let! churches = this.Churches.AsNoTracking().OrderBy(fun c -> c.name).ToListAsync ()
let q =
query {
for ch in this.Churches.AsNoTracking () do
sortBy ch.name
}
let! churches = q.ToListAsync ()
return List.ofSeq churches
}
@@ -44,19 +77,24 @@ type AppDbContext with
/// Get a small group member by its Id
member this.TryMemberById mId =
task {
let! mbr = this.Members.AsNoTracking().FirstOrDefaultAsync (fun m -> m.memberId = mId)
return Option.fromObject mbr
query {
for mbr in this.Members.AsNoTracking () do
where (mbr.memberId = mId)
select mbr
exactlyOneOrDefault
}
|> toOptionTask
/// Find all members for a small group
member this.AllMembersForSmallGroup gId =
task {
let! mbrs =
this.Members.AsNoTracking()
.Where(fun m -> m.smallGroupId = gId)
.OrderBy(fun m -> m.memberName)
.ToListAsync ()
let q =
query {
for mbr in this.Members.AsNoTracking () do
where (mbr.smallGroupId = gId)
sortBy mbr.memberName
}
let! mbrs = q.ToListAsync ()
return List.ofSeq mbrs
}
@@ -64,42 +102,49 @@ type AppDbContext with
member this.CountMembersForSmallGroup gId =
this.Members.CountAsync (fun m -> m.smallGroupId = gId)
(*-- PRAYER REQUEST EXTENSIONS *)
(*-- PRAYER REQUEST EXTENSIONS --*)
/// Get a prayer request by its Id
member this.TryRequestById reqId =
task {
let! req = this.PrayerRequests.AsNoTracking().FirstOrDefaultAsync (fun pr -> pr.prayerRequestId = reqId)
return Option.fromObject req
query {
for req in this.PrayerRequests.AsNoTracking () do
where (req.prayerRequestId = reqId)
exactlyOneOrDefault
}
|> toOptionTask
/// Get all (or active) requests for a small group as of now or the specified date
member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly : PrayerRequest seq =
// TODO: why not make this an async list like the rest of these methods?
member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr : PrayerRequest seq =
let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock
upcast (
this.PrayerRequests.AsNoTracking().Where(fun pr -> pr.smallGroupId = grp.smallGroupId)
|> function
// Filter
| query when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query.Where(fun pr ->
(pr.updatedDate > asOf
|| pr.doNotExpire
|| RequestType.Recurring = pr.requestType
|| RequestType.Expecting = pr.requestType)
&& not pr.isManuallyExpired)
| query -> query
|> function
// Sort
| query when grp.preferences.requestSort = "D" ->
query.OrderByDescending(fun pr -> pr.updatedDate)
.ThenByDescending(fun pr -> pr.enteredDate)
.ThenBy(fun pr -> pr.requestor)
| query ->
query.OrderBy(fun pr -> pr.requestor)
.ThenByDescending(fun pr -> pr.updatedDate)
.ThenByDescending(fun pr -> pr.enteredDate))
query {
for req in this.PrayerRequests.AsNoTracking () do
where (req.smallGroupId = grp.smallGroupId)
}
|> function
| q when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query {
for req in q do
where ( ( req.updatedDate > asOf
|| req.expiration = Manual
|| req.requestType = LongTermRequest
|| req.requestType = Expecting)
&& req.expiration <> Forced)
}
| q -> q
|> reqSort grp.preferences.requestSort
|> function
| q ->
match activeOnly with
| true -> upcast q
| false ->
upcast query {
for req in q do
skip ((pageNbr - 1) * grp.preferences.pageSize)
take grp.preferences.pageSize
}
/// Count prayer requests for the given small group Id
member this.CountRequestsBySmallGroup gId =
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId)
@@ -108,43 +153,64 @@ type AppDbContext with
member this.CountRequestsByChurch cId =
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId)
/// Get all (or active) requests for a small group as of now or the specified date
// TODO: same as above...
member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr : PrayerRequest seq =
let pgSz = grp.preferences.pageSize
let toSkip = (pageNbr - 1) * pgSz
let sql =
""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
UNION
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}"""
let like = sprintf "%%%s%%"
this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm).AsNoTracking ()
|> reqSort grp.preferences.requestSort
|> function
| q ->
upcast query {
for req in q do
skip toSkip
take pgSz
}
(*-- SMALL GROUP EXTENSIONS --*)
/// Find a small group by its Id
member this.TryGroupById gId =
task {
let! grp =
this.SmallGroups.AsNoTracking()
.Include(fun sg -> sg.preferences)
.FirstOrDefaultAsync (fun sg -> sg.smallGroupId = gId)
return Option.fromObject grp
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.preferences) do
where (grp.smallGroupId = gId)
exactlyOneOrDefault
}
|> toOptionTask
/// Get small groups that are public or password protected
member this.PublicAndProtectedGroups () =
task {
let! grps =
this.SmallGroups.AsNoTracking()
.Include(fun sg -> sg.preferences)
.Include(fun sg -> sg.church)
.Where(fun sg ->
sg.preferences.isPublic || (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> ""))
.OrderBy(fun sg -> sg.church.name)
.ThenBy(fun sg -> sg.name)
.ToListAsync ()
let smallGroups = this.SmallGroups.AsNoTracking().Include(fun sg -> sg.preferences).Include (fun sg -> sg.church)
let q =
query {
for grp in smallGroups do
where ( grp.preferences.isPublic
|| (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> ""))
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
}
/// Get small groups that are password protected
member this.ProtectedGroups () =
task {
let! grps =
this.SmallGroups.AsNoTracking()
.Include(fun sg -> sg.church)
.Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")
.OrderBy(fun sg -> sg.church.name)
.ThenBy(fun sg -> sg.name)
.ToListAsync ()
let q =
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
where (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> "")
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
}
@@ -164,38 +230,37 @@ type AppDbContext with
/// Get a small group list by their Id, with their church prepended to their name
member this.GroupList () =
task {
let! grps =
this.SmallGroups.AsNoTracking()
.Include(fun sg -> sg.church)
.OrderBy(fun sg -> sg.church.name)
.ThenBy(fun sg -> sg.name)
.ToListAsync ()
let q =
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return grps
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", sprintf "%s | %s" grp.church.name grp.name)
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
|> List.ofSeq
}
/// Log on a small group
member this.TryGroupLogOnByPassword gId pw =
task {
let! grp = this.TryGroupById gId
match grp with
match! this.TryGroupById gId with
| None -> return None
| Some g ->
match pw = g.preferences.groupPassword with
| true -> return grp
| Some grp ->
match pw = grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
}
/// Check a cookie log on for a small group
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) =
task {
let! grp = this.TryGroupById gId
match grp with
match! this.TryGroupById gId with
| None -> return None
| Some g ->
match pwHash = hasher g.preferences.groupPassword with
| true -> return grp
| Some grp ->
match pwHash = hasher grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
}
@@ -207,15 +272,22 @@ type AppDbContext with
/// Get a time zone by its Id
member this.TryTimeZoneById tzId =
task {
let! tz = this.TimeZones.FirstOrDefaultAsync (fun t -> t.timeZoneId = tzId)
return Option.fromObject tz
query {
for tz in this.TimeZones do
where (tz.timeZoneId = tzId)
exactlyOneOrDefault
}
|> toOptionTask
/// Get all time zones
member this.AllTimeZones () =
task {
let! tzs = this.TimeZones.OrderBy(fun t -> t.sortOrder).ToListAsync ()
let q =
query {
for tz in this.TimeZones do
sortBy tz.sortOrder
}
let! tzs = q.ToListAsync ()
return List.ofSeq tzs
}
@@ -223,67 +295,72 @@ type AppDbContext with
/// Find a user by its Id
member this.TryUserById uId =
task {
let! user = this.Users.AsNoTracking().FirstOrDefaultAsync (fun u -> u.userId = uId)
return Option.fromObject user
query {
for usr in this.Users.AsNoTracking () do
where (usr.userId = uId)
exactlyOneOrDefault
}
|> toOptionTask
/// Find a user by its e-mail address and authorized small group
member this.TryUserByEmailAndGroup email gId =
task {
let! user =
this.Users.AsNoTracking().FirstOrDefaultAsync (fun u ->
u.emailAddress = email
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
return Option.fromObject user
query {
for usr in this.Users.AsNoTracking () do
where (usr.emailAddress = email && usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault
}
|> toOptionTask
/// Find a user by its Id (tracked entity), eagerly loading the user's groups
member this.TryUserByIdWithGroups uId =
task {
let! user = this.Users.Include(fun u -> u.smallGroups).FirstOrDefaultAsync (fun u -> u.userId = uId)
return Option.fromObject user
query {
for usr in this.Users.AsNoTracking().Include (fun u -> u.smallGroups) do
where (usr.userId = uId)
exactlyOneOrDefault
}
|> toOptionTask
/// Get a list of all users
member this.AllUsers () =
task {
let! usrs = this.Users.AsNoTracking().OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync ()
let q =
query {
for usr in this.Users.AsNoTracking () do
sortBy usr.lastName
thenBy usr.firstName
}
let! usrs = q.ToListAsync ()
return List.ofSeq usrs
}
/// Get all PrayerTracker users as members (used to send e-mails)
member this.AllUsersAsMembers () =
task {
let! usrs =
this.Users.AsNoTracking().OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync ()
return usrs
|> Seq.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName })
|> List.ofSeq
let! users = this.AllUsers ()
return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName })
}
/// Find a user based on their credentials
member this.TryUserLogOnByPassword email pwHash gId =
task {
let! user =
this.Users.FirstOrDefaultAsync (fun u ->
u.emailAddress = email
&& u.passwordHash = pwHash
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
return Option.fromObject user
query {
for usr in this.Users.AsNoTracking () do
where ( usr.emailAddress = email
&& usr.passwordHash = pwHash
&& usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault
}
|> toOptionTask
/// Find a user based on credentials stored in a cookie
member this.TryUserLogOnByCookie uId gId pwHash =
task {
let! user = this.TryUserByIdWithGroups uId
match user with
match! this.TryUserByIdWithGroups uId with
| None -> return None
| Some u ->
match pwHash = u.passwordHash && u.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with
| Some usr ->
match pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with
| true ->
this.Entry<User>(u).State <- EntityState.Detached
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }
this.Entry<User>(usr).State <- EntityState.Detached
return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }
| _ -> return None
}

View File

@@ -6,37 +6,206 @@ open NodaTime
open System
open System.Collections.Generic
(*-- CONSTANTS --*)
/// Constants to use for the e-mail type parameter
[<RequireQualifiedAccess>]
module EmailType =
/// HTML e-mail
[<Literal>]
let Html = "Html"
/// Plain Text e-mail
[<Literal>]
let PlainText = "PlainText"
/// E-mail with the list as an attached PDF
[<Literal>]
let AttachedPdf = "AttachedPdf"
/// These values match those in the RequestType document store
[<RequireQualifiedAccess>]
module RequestType =
/// Current Requests (follow expiration rules)
let Current = "Current"
/// Long-Term / Recurring Requests (do not automatically expire)
let Recurring = "Recurring"
/// Praise Reports (follow expiration rules)
let Praise = "Praise"
/// Expectant Mothers (do not automatically expire)
let Expecting = "Expecting"
/// Announcements (follow expiration rules)
let Announcement = "Announcement"
// fsharplint:disable RecordFieldNames MemberNames
(*-- SUPPORT TYPES --*)
/// How as-of dates should (or should not) be displayed with requests
type AsOfDateDisplay =
/// No as-of date should be displayed
| NoDisplay
/// The as-of date should be displayed in the culture's short date format
| ShortDate
/// The as-of date should be displayed in the culture's long date format
| LongDate
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "N" -> NoDisplay
| "S" -> ShortDate
| "L" -> LongDate
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
/// Convert this DU case to a single-character string
member this.code =
match this with
| NoDisplay -> "N"
| ShortDate -> "S"
| LongDate -> "L"
/// Acceptable e-mail formats
type EmailFormat =
/// HTML e-mail
| HtmlFormat
/// Plain-text e-mail
| PlainTextFormat
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "H" -> HtmlFormat
| "P" -> PlainTextFormat
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
/// Convert this DU case to a single-character string
member this.code =
match this with
| HtmlFormat -> "H"
| PlainTextFormat -> "P"
/// Expiration for requests
type Expiration =
/// Follow the rules for normal expiration
| Automatic
/// Do not expire via rules
| Manual
/// Force immediate expiration
| Forced
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "A" -> Automatic
| "M" -> Manual
| "F" -> Forced
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
/// Convert this DU case to a single-character string
member this.code =
match this with
| Automatic -> "A"
| Manual -> "M"
| Forced -> "F"
/// Types of prayer requests
type PrayerRequestType =
/// Current requests
| CurrentRequest
/// Long-term/ongoing request
| LongTermRequest
/// Expectant couples
| Expecting
/// Praise reports
| PraiseReport
/// Announcements
| Announcement
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "C" -> CurrentRequest
| "L" -> LongTermRequest
| "E" -> Expecting
| "P" -> PraiseReport
| "A" -> Announcement
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
/// Convert this DU case to a single-character string
member this.code =
match this with
| CurrentRequest -> "C"
| LongTermRequest -> "L"
| Expecting -> "E"
| PraiseReport -> "P"
| Announcement -> "A"
/// How requests should be sorted
type RequestSort =
/// Sort by date, then by requestor/subject
| SortByDate
/// Sort by requestor/subject, then by date
| SortByRequestor
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "D" -> SortByDate
| "R" -> SortByRequestor
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
/// Convert this DU case to a single-character string
member this.code =
match this with
| SortByDate -> "D"
| SortByRequestor -> "R"
module Converters =
open Microsoft.EntityFrameworkCore.Storage.ValueConversion
open Microsoft.FSharp.Linq.RuntimeHelpers
open System.Linq.Expressions
let private asOfFromDU =
<@ Func<AsOfDateDisplay, string>(fun (x : AsOfDateDisplay) -> x.code) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<AsOfDateDisplay, string>>>
let private asOfToDU =
<@ Func<string, AsOfDateDisplay>(AsOfDateDisplay.fromCode) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<string, AsOfDateDisplay>>>
let private emailFromDU =
<@ Func<EmailFormat, string>(fun (x : EmailFormat) -> x.code) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<EmailFormat, string>>>
let private emailToDU =
<@ Func<string, EmailFormat>(EmailFormat.fromCode) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<string, EmailFormat>>>
let private expFromDU =
<@ Func<Expiration, string>(fun (x : Expiration) -> x.code) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<Expiration, string>>>
let private expToDU =
<@ Func<string, Expiration>(Expiration.fromCode) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<string, Expiration>>>
let private sortFromDU =
<@ Func<RequestSort, string>(fun (x : RequestSort) -> x.code) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<RequestSort, string>>>
let private sortToDU =
<@ Func<string, RequestSort>(RequestSort.fromCode) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<string, RequestSort>>>
let private typFromDU =
<@ Func<PrayerRequestType, string>(fun (x : PrayerRequestType) -> x.code) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<PrayerRequestType, string>>>
let private typToDU =
<@ Func<string, PrayerRequestType>(PrayerRequestType.fromCode) @>
|> LeafExpressionConverter.QuotationToExpression
|> unbox<Expression<Func<string, PrayerRequestType>>>
/// Conversion between a string and an AsOfDateDisplay DU value
type AsOfDateDisplayConverter () =
inherit ValueConverter<AsOfDateDisplay, string> (asOfFromDU, asOfToDU)
/// Conversion between a string and an EmailFormat DU value
type EmailFormatConverter () =
inherit ValueConverter<EmailFormat, string> (emailFromDU, emailToDU)
/// Conversion between a string and an Expiration DU value
type ExpirationConverter () =
inherit ValueConverter<Expiration, string> (expFromDU, expToDU)
/// Conversion between a string and an AsOfDateDisplay DU value
type PrayerRequestTypeConverter () =
inherit ValueConverter<PrayerRequestType, string> (typFromDU, typToDU)
/// Conversion between a string and a RequestSort DU value
type RequestSortConverter () =
inherit ValueConverter<RequestSort, string> (sortFromDU, sortToDU)
/// Statistics for churches
[<NoComparison; NoEquality>]
type ChurchStats =
@@ -145,17 +314,21 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
/// The font size for the text on the prayer request list
textFontSize : int
/// The order in which the prayer requests are sorted
requestSort : string
requestSort : RequestSort
/// The password used for "small group login" (view-only request list)
groupPassword : string
/// The default e-mail type for this class
defaultEmailType : string
defaultEmailType : EmailFormat
/// Whether this class makes its request list public
isPublic : bool
/// The time zone which this class uses (use tzdata names)
timeZoneId : TimeZoneId
/// The time zone information
timeZone : TimeZone
/// The number of requests displayed per page
pageSize : int
/// How the as-of date should be automatically displayed
asOfDateDisplay : AsOfDateDisplay
}
with
/// A set of preferences with their default values
@@ -171,12 +344,14 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
lineColor = "navy"
headingFontSize = 16
textFontSize = 12
requestSort = "D"
requestSort = SortByDate
groupPassword = ""
defaultEmailType = EmailType.Html
defaultEmailType = HtmlFormat
isPublic = false
timeZoneId = "America/Denver"
timeZone = TimeZone.empty
pageSize = 100
asOfDateDisplay = NoDisplay
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
@@ -188,80 +363,97 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
m.Property(fun e -> e.daysToKeepNew)
.HasColumnName("DaysToKeepNew")
.IsRequired()
.HasDefaultValue(7)
.HasDefaultValue 7
|> ignore
m.Property(fun e -> e.daysToExpire)
.HasColumnName("DaysToExpire")
.IsRequired()
.HasDefaultValue(14)
.HasDefaultValue 14
|> ignore
m.Property(fun e -> e.longTermUpdateWeeks)
.HasColumnName("LongTermUpdateWeeks")
.IsRequired()
.HasDefaultValue(4)
.HasDefaultValue 4
|> ignore
m.Property(fun e -> e.emailFromName)
.HasColumnName("EmailFromName")
.IsRequired()
.HasDefaultValue("PrayerTracker")
.HasDefaultValue "PrayerTracker"
|> ignore
m.Property(fun e -> e.emailFromAddress)
.HasColumnName("EmailFromAddress")
.IsRequired()
.HasDefaultValue("prayer@djs-consulting.com")
.HasDefaultValue "prayer@djs-consulting.com"
|> ignore
m.Property(fun e -> e.listFonts)
.HasColumnName("ListFonts")
.IsRequired()
.HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif")
.HasDefaultValue "Century Gothic,Tahoma,Luxi Sans,sans-serif"
|> ignore
m.Property(fun e -> e.headingColor)
.HasColumnName("HeadingColor")
.IsRequired()
.HasDefaultValue("maroon")
.HasDefaultValue "maroon"
|> ignore
m.Property(fun e -> e.lineColor)
.HasColumnName("LineColor")
.IsRequired()
.HasDefaultValue("navy")
.HasDefaultValue "navy"
|> ignore
m.Property(fun e -> e.headingFontSize)
.HasColumnName("HeadingFontSize")
.IsRequired()
.HasDefaultValue(16)
.HasDefaultValue 16
|> ignore
m.Property(fun e -> e.textFontSize)
.HasColumnName("TextFontSize")
.IsRequired()
.HasDefaultValue(12)
.HasDefaultValue 12
|> ignore
m.Property(fun e -> e.requestSort)
.HasColumnName("RequestSort")
.IsRequired()
.HasMaxLength(1)
.HasDefaultValue("D")
.HasDefaultValue SortByDate
|> ignore
m.Property(fun e -> e.groupPassword)
.HasColumnName("GroupPassword")
.IsRequired()
.HasDefaultValue("")
.HasDefaultValue ""
|> ignore
m.Property(fun e -> e.defaultEmailType)
.HasColumnName("DefaultEmailType")
.IsRequired()
.HasDefaultValue(EmailType.Html)
.HasDefaultValue HtmlFormat
|> ignore
m.Property(fun e -> e.isPublic)
.HasColumnName("IsPublic")
.IsRequired()
.HasDefaultValue(false)
.HasDefaultValue false
|> ignore
m.Property(fun e -> e.timeZoneId)
.HasColumnName("TimeZoneId")
.IsRequired()
.HasDefaultValue("America/Denver")
.HasDefaultValue "America/Denver"
|> ignore
m.Property(fun e -> e.pageSize)
.HasColumnName("PageSize")
.IsRequired()
.HasDefaultValue 100
|> ignore
m.Property(fun e -> e.asOfDateDisplay)
.HasColumnName("AsOfDateDisplay")
.IsRequired()
.HasMaxLength(1)
.HasDefaultValue NoDisplay
|> ignore)
|> ignore
mb.Model.FindEntityType(typeof<ListPreferences>).FindProperty("requestSort")
.SetValueConverter(Converters.RequestSortConverter ())
mb.Model.FindEntityType(typeof<ListPreferences>).FindProperty("defaultEmailType")
.SetValueConverter(Converters.EmailFormatConverter ())
mb.Model.FindEntityType(typeof<ListPreferences>).FindProperty("asOfDateDisplay")
.SetValueConverter(Converters.AsOfDateDisplayConverter ())
/// A member of a small group
@@ -275,7 +467,7 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
/// The e-mail address for the member
email : string
/// The type of e-mail preferred by this member (see <see cref="EmailTypes"/> constants)
format : string option
format : string option // TODO - do I need a custom formatter for this?
/// The small group to which this member belongs
smallGroup : SmallGroup
}
@@ -306,64 +498,62 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
/// This represents a single prayer request
and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
{ /// The Id of this request
prayerRequestId : PrayerRequestId
prayerRequestId : PrayerRequestId
/// The type of the request
requestType : string
requestType : PrayerRequestType
/// The user who entered the request
userId : UserId
userId : UserId
/// The small group to which this request belongs
smallGroupId : SmallGroupId
smallGroupId : SmallGroupId
/// The date/time on which this request was entered
enteredDate : DateTime
enteredDate : DateTime
/// The date/time this request was last updated
updatedDate : DateTime
updatedDate : DateTime
/// The name of the requestor or subject, or title of announcement
requestor : string option
requestor : string option
/// The text of the request
text : string
/// Whether this request is exempt from standard expiration rules
doNotExpire : bool
text : string
/// Whether the chaplain should be notified for this request
notifyChaplain : bool
/// Whether this request has been expired manually
isManuallyExpired : bool
notifyChaplain : bool
/// The user who entered this request
user : User
user : User
/// The small group to which this request belongs
smallGroup : SmallGroup
smallGroup : SmallGroup
/// Is this request expired?
expiration : Expiration
}
with
/// An empty request
static member empty =
{ prayerRequestId = Guid.Empty
requestType = RequestType.Current
userId = Guid.Empty
smallGroupId = Guid.Empty
enteredDate = DateTime.MinValue
updatedDate = DateTime.MinValue
requestor = None
text = ""
doNotExpire = false
notifyChaplain = false
isManuallyExpired = false
user = User.empty
smallGroup = SmallGroup.empty
{ prayerRequestId = Guid.Empty
requestType = CurrentRequest
userId = Guid.Empty
smallGroupId = Guid.Empty
enteredDate = DateTime.MinValue
updatedDate = DateTime.MinValue
requestor = None
text = ""
notifyChaplain = false
user = User.empty
smallGroup = SmallGroup.empty
expiration = Automatic
}
/// Is this request expired?
member this.isExpired (curr : DateTime) expDays =
match this.isManuallyExpired with
| true -> true // Manual expiration
| false ->
let nonExpiringTypes = [ RequestType.Recurring; RequestType.Expecting ]
match this.doNotExpire || List.contains this.requestType nonExpiringTypes with
| true -> false // No expiration
| false -> curr.AddDays(-(float expDays)) > this.updatedDate // Automatic expiration
match this.expiration with
| Forced -> true
| Manual -> false
| Automatic ->
match this.requestType with
| LongTermRequest
| Expecting -> false
| _ -> curr.AddDays(-(float expDays)).Date > this.updatedDate.Date // Automatic expiration
/// Is an update required for this long-term request?
member this.updateRequired curr expDays updWeeks =
match this.isExpired curr expDays with
| true -> false
| _ -> curr.AddDays(-(float (updWeeks * 7))) > this.updatedDate
| false -> curr.AddDays(-(float (updWeeks * 7))).Date > this.updatedDate.Date
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
@@ -378,12 +568,15 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
m.Property(fun e -> e.updatedDate).HasColumnName "UpdatedDate" |> ignore
m.Property(fun e -> e.requestor).HasColumnName "Requestor" |> ignore
m.Property(fun e -> e.text).HasColumnName("Text").IsRequired() |> ignore
m.Property(fun e -> e.doNotExpire).HasColumnName "DoNotExpire" |> ignore
m.Property(fun e -> e.notifyChaplain).HasColumnName "NotifyChaplain" |> ignore
m.Property(fun e -> e.isManuallyExpired).HasColumnName "IsManuallyExpired" |> ignore)
m.Property(fun e -> e.expiration).HasColumnName "Expiration" |> ignore)
|> ignore
mb.Model.FindEntityType(typeof<PrayerRequest>).FindProperty("requestType")
.SetValueConverter(Converters.PrayerRequestTypeConverter ())
mb.Model.FindEntityType(typeof<PrayerRequest>).FindProperty("requestor")
.SetValueConverter(OptionConverter<string> ())
mb.Model.FindEntityType(typeof<PrayerRequest>).FindProperty("expiration")
.SetValueConverter(Converters.ExpirationConverter ())
/// This represents a small group (Sunday School class, Bible study group, etc.)

View File

@@ -10,6 +10,7 @@ open PrayerTracker
open PrayerTracker.Entities
open System
// fsharplint:disable RecordFieldNames
type ChurchTable =
{ churchId : OperationBuilder<AddColumnOperation>
@@ -37,6 +38,8 @@ type ListPreferencesTable =
requestSort : OperationBuilder<AddColumnOperation>
textFontSize : OperationBuilder<AddColumnOperation>
timeZoneId : OperationBuilder<AddColumnOperation>
pageSize : OperationBuilder<AddColumnOperation>
asOfDateDisplay : OperationBuilder<AddColumnOperation>
}
type MemberTable =
@@ -48,17 +51,16 @@ type MemberTable =
}
type PrayerRequestTable =
{ prayerRequestId : OperationBuilder<AddColumnOperation>
doNotExpire : OperationBuilder<AddColumnOperation>
enteredDate : OperationBuilder<AddColumnOperation>
isManuallyExpired : OperationBuilder<AddColumnOperation>
notifyChaplain : OperationBuilder<AddColumnOperation>
requestType : OperationBuilder<AddColumnOperation>
requestor : OperationBuilder<AddColumnOperation>
smallGroupId : OperationBuilder<AddColumnOperation>
text : OperationBuilder<AddColumnOperation>
updatedDate : OperationBuilder<AddColumnOperation>
userId : OperationBuilder<AddColumnOperation>
{ prayerRequestId : OperationBuilder<AddColumnOperation>
enteredDate : OperationBuilder<AddColumnOperation>
expiration : OperationBuilder<AddColumnOperation>
notifyChaplain : OperationBuilder<AddColumnOperation>
requestType : OperationBuilder<AddColumnOperation>
requestor : OperationBuilder<AddColumnOperation>
smallGroupId : OperationBuilder<AddColumnOperation>
text : OperationBuilder<AddColumnOperation>
updatedDate : OperationBuilder<AddColumnOperation>
userId : OperationBuilder<AddColumnOperation>
}
type SmallGroupTable =
@@ -102,12 +104,12 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
city = table.Column<string> (name = "City", nullable = false)
{ churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
city = table.Column<string> (name = "City", nullable = false)
hasInterface = table.Column<bool> (name = "HasVirtualPrayerRoomInterface", nullable = false)
interfaceAddress = table.Column<string> (name = "InterfaceAddress", nullable = true)
name = table.Column<string> (name = "Name", nullable = false)
st = table.Column<string> (name = "ST", maxLength = Nullable<int> 2, nullable = false)
name = table.Column<string> (name = "Name", nullable = false)
st = table.Column<string> (name = "ST", nullable = false, maxLength = Nullable<int> 2)
}),
constraints =
fun table ->
@@ -119,10 +121,10 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false)
{ timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false)
description = table.Column<string> (name = "Description", nullable = false)
isActive = table.Column<bool> (name = "IsActive", nullable = false)
sortOrder = table.Column<int> (name = "SortOrder", nullable = false)
isActive = table.Column<bool> (name = "IsActive", nullable = false)
sortOrder = table.Column<int> (name = "SortOrder", nullable = false)
}),
constraints =
fun table ->
@@ -134,13 +136,13 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
emailAddress = table.Column<string> (name = "EmailAddress", nullable = false)
firstName = table.Column<string> (name = "FirstName", nullable = false)
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
emailAddress = table.Column<string> (name = "EmailAddress", nullable = false)
firstName = table.Column<string> (name = "FirstName", nullable = false)
isAdmin = table.Column<bool> (name = "IsSystemAdmin", nullable = false)
lastName = table.Column<string> (name = "LastName", nullable = false)
passwordHash = table.Column<string> (name = "PasswordHash", nullable = false)
salt = table.Column<Guid> (name = "Salt", nullable = true)
lastName = table.Column<string> (name = "LastName", nullable = false)
passwordHash = table.Column<string> (name = "PasswordHash", nullable = false)
salt = table.Column<Guid> (name = "Salt", nullable = true)
}),
constraints =
fun table ->
@@ -153,8 +155,8 @@ type InitialDatabase () =
columns =
(fun table ->
{ smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
name = table.Column<string> (name = "Name", nullable = false)
churchId = table.Column<Guid> (name = "ChurchId", nullable = false)
name = table.Column<string> (name = "Name", nullable = false)
}),
constraints =
fun table ->
@@ -174,22 +176,24 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
daysToExpire = table.Column<int> (name = "DaysToExpire", nullable = false, defaultValue = 14)
daysToKeepNew = table.Column<int> (name = "DaysToKeepNew", nullable = false, defaultValue = 7)
defaultEmailType = table.Column<string> (name = "DefaultEmailType", nullable = false, defaultValue = "Html")
emailFromAddress = table.Column<string> (name = "EmailFromAddress", nullable = false, defaultValue = "prayer@djs-consulting.com")
emailFromName = table.Column<string> (name = "EmailFromName", nullable = false, defaultValue = "PrayerTracker")
groupPassword = table.Column<string> (name = "GroupPassword", nullable = false, defaultValue = "")
headingColor = table.Column<string> (name = "HeadingColor", nullable = false, defaultValue = "maroon")
headingFontSize = table.Column<int> (name = "HeadingFontSize", nullable = false, defaultValue = 16)
isPublic = table.Column<bool> (name = "IsPublic", nullable = false, defaultValue = false)
lineColor = table.Column<string> (name = "LineColor", nullable = false, defaultValue = "navy")
listFonts = table.Column<string> (name = "ListFonts", nullable = false, defaultValue = "Century Gothic,Tahoma,Luxi Sans,sans-serif")
{ smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
daysToExpire = table.Column<int> (name = "DaysToExpire", nullable = false, defaultValue = 14)
daysToKeepNew = table.Column<int> (name = "DaysToKeepNew", nullable = false, defaultValue = 7)
defaultEmailType = table.Column<string> (name = "DefaultEmailType", nullable = false, defaultValue = "Html")
emailFromAddress = table.Column<string> (name = "EmailFromAddress", nullable = false, defaultValue = "prayer@djs-consulting.com")
emailFromName = table.Column<string> (name = "EmailFromName", nullable = false, defaultValue = "PrayerTracker")
groupPassword = table.Column<string> (name = "GroupPassword", nullable = false, defaultValue = "")
headingColor = table.Column<string> (name = "HeadingColor", nullable = false, defaultValue = "maroon")
headingFontSize = table.Column<int> (name = "HeadingFontSize", nullable = false, defaultValue = 16)
isPublic = table.Column<bool> (name = "IsPublic", nullable = false, defaultValue = false)
lineColor = table.Column<string> (name = "LineColor", nullable = false, defaultValue = "navy")
listFonts = table.Column<string> (name = "ListFonts", nullable = false, defaultValue = "Century Gothic,Tahoma,Luxi Sans,sans-serif")
longTermUpdateWeeks = table.Column<int> (name = "LongTermUpdateWeeks", nullable = false, defaultValue = 4)
requestSort = table.Column<string> (name = "RequestSort", maxLength = Nullable<int> 1, nullable = false, defaultValue = "D")
textFontSize = table.Column<int> (name = "TextFontSize", nullable = false, defaultValue = 12)
timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false, defaultValue = "America/Denver")
requestSort = table.Column<string> (name = "RequestSort", nullable = false, defaultValue = "D", maxLength = Nullable<int> 1)
textFontSize = table.Column<int> (name = "TextFontSize", nullable = false, defaultValue = 12)
timeZoneId = table.Column<string> (name = "TimeZoneId", nullable = false, defaultValue = "America/Denver")
pageSize = table.Column<int> (name = "PageSize", nullable = false, defaultValue = 100)
asOfDateDisplay = table.Column<string> (name = "AsOfDateDisplay", nullable = false, defaultValue = "N", maxLength = Nullable<int> 1)
}),
constraints =
fun table ->
@@ -217,10 +221,10 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ memberId = table.Column<Guid> (name = "MemberId", nullable = false)
email = table.Column<string> (name = "Email", nullable = false)
format = table.Column<string> (name = "Format", nullable = true)
memberName = table.Column<string> (name = "MemberName", nullable = false)
{ memberId = table.Column<Guid> (name = "MemberId", nullable = false)
email = table.Column<string> (name = "Email", nullable = false)
format = table.Column<string> (name = "Format", nullable = true)
memberName = table.Column<string> (name = "MemberName", nullable = false)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
}),
constraints =
@@ -242,16 +246,15 @@ type InitialDatabase () =
columns =
(fun table ->
{ prayerRequestId = table.Column<Guid> (name = "PrayerRequestId", nullable = false)
doNotExpire = table.Column<bool> (name = "DoNotExpire", nullable = false)
enteredDate = table.Column<DateTime> (name = "EnteredDate", nullable = false)
isManuallyExpired = table.Column<bool> (name = "IsManuallyExpired", nullable = false)
notifyChaplain = table.Column<bool> (name = "NotifyChaplain", nullable = false)
requestType = table.Column<string> (name = "RequestType", nullable = false)
requestor = table.Column<string> (name = "Requestor", nullable = true)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
text = table.Column<string> (name = "Text", nullable = false)
updatedDate = table.Column<DateTime> (name = "UpdatedDate", nullable = false)
userId = table.Column<Guid> (name = "UserId", nullable = false)
expiration = table.Column<bool> (name = "Expiration", nullable = false)
enteredDate = table.Column<DateTime> (name = "EnteredDate", nullable = false)
notifyChaplain = table.Column<bool> (name = "NotifyChaplain", nullable = false)
requestType = table.Column<string> (name = "RequestType", nullable = false)
requestor = table.Column<string> (name = "Requestor", nullable = true)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
text = table.Column<string> (name = "Text", nullable = false)
updatedDate = table.Column<DateTime> (name = "UpdatedDate", nullable = false)
userId = table.Column<Guid> (name = "UserId", nullable = false)
}),
constraints =
fun table ->
@@ -279,7 +282,7 @@ type InitialDatabase () =
schema = "pt",
columns =
(fun table ->
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
{ userId = table.Column<Guid> (name = "UserId", nullable = false)
smallGroupId = table.Column<Guid> (name = "SmallGroupId", nullable = false)
}),
constraints =
@@ -347,7 +350,7 @@ type InitialDatabase () =
b.Property<Guid>("smallGroupId") |> ignore
b.Property<int>("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore
b.Property<int>("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Html") |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H") |> ignore
b.Property<string>("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore
b.Property<string>("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore
b.Property<string>("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore
@@ -357,9 +360,11 @@ type InitialDatabase () =
b.Property<string>("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore
b.Property<string>("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore
b.Property<int>("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<int>("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore
b.Property<string>("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore
b.Property<int>("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore
b.Property<string>("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("timeZoneId") |> ignore
b.ToTable("ListPreference") |> ignore)
@@ -382,11 +387,10 @@ type InitialDatabase () =
typeof<PrayerRequest>,
fun b ->
b.Property<Guid>("prayerRequestId").ValueGeneratedOnAdd() |> ignore
b.Property<bool>("doNotExpire") |> ignore
b.Property<DateTime>("enteredDate") |> ignore
b.Property<bool>("isManuallyExpired") |> ignore
b.Property<DateTime>("enteredDate").IsRequired() |> ignore
b.Property<string>("expiration").IsRequired().HasMaxLength 1 |> ignore
b.Property<bool>("notifyChaplain") |> ignore
b.Property<string>("requestType").IsRequired() |> ignore
b.Property<string>("requestType").IsRequired().HasMaxLength 1 |> ignore
b.Property<string>("requestor") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.Property<string>("text").IsRequired() |> ignore

View File

@@ -36,7 +36,7 @@ type AppDbContextModelSnapshot () =
b.Property<Guid>("smallGroupId") |> ignore
b.Property<int>("daysToExpire").ValueGeneratedOnAdd().HasDefaultValue(14) |> ignore
b.Property<int>("daysToKeepNew").ValueGeneratedOnAdd().HasDefaultValue(7) |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Html") |> ignore
b.Property<string>("defaultEmailType").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("H").HasMaxLength(1) |> ignore
b.Property<string>("emailFromAddress").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("prayer@djs-consulting.com") |> ignore
b.Property<string>("emailFromName").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("PrayerTracker") |> ignore
b.Property<string>("groupPassword").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("") |> ignore
@@ -46,9 +46,11 @@ type AppDbContextModelSnapshot () =
b.Property<string>("lineColor").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("navy") |> ignore
b.Property<string>("listFonts").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("Century Gothic,Tahoma,Luxi Sans,sans-serif") |> ignore
b.Property<int>("longTermUpdateWeeks").ValueGeneratedOnAdd().HasDefaultValue(4) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<string>("requestSort").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("D").HasMaxLength(1) |> ignore
b.Property<int>("textFontSize").ValueGeneratedOnAdd().HasDefaultValue(12) |> ignore
b.Property<string>("timeZoneId").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("America/Denver") |> ignore
b.Property<int>("pageSize").IsRequired().ValueGeneratedOnAdd().HasDefaultValue(100) |> ignore
b.Property<string>("asOfDateDisplay").IsRequired().ValueGeneratedOnAdd().HasDefaultValue("N").HasMaxLength(1) |> ignore
b.HasKey("smallGroupId") |> ignore
b.HasIndex("timeZoneId") |> ignore
b.ToTable("ListPreference") |> ignore)
@@ -71,11 +73,10 @@ type AppDbContextModelSnapshot () =
typeof<PrayerRequest>,
fun b ->
b.Property<Guid>("prayerRequestId").ValueGeneratedOnAdd() |> ignore
b.Property<bool>("doNotExpire") |> ignore
b.Property<DateTime>("enteredDate") |> ignore
b.Property<bool>("isManuallyExpired") |> ignore
b.Property<string>("expiration").IsRequired().HasMaxLength(1) |> ignore
b.Property<bool>("notifyChaplain") |> ignore
b.Property<string>("requestType").IsRequired() |> ignore
b.Property<string>("requestType").IsRequired().HasMaxLength(1) |> ignore
b.Property<string>("requestor") |> ignore
b.Property<Guid>("smallGroupId") |> ignore
b.Property<string>("text").IsRequired() |> ignore

View File

@@ -1,9 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<AssemblyVersion>7.0.0.0</AssemblyVersion>
<FileVersion>7.0.0.0</FileVersion>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
@@ -16,14 +14,9 @@
<ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.10.30" />
<PackageReference Include="NodaTime" Version="2.4.4" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="2.2.0" />
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
<PackageReference Include="NodaTime" Version="3.0.5" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
</ItemGroup>
</Project>

View File

@@ -1,10 +1,36 @@
module PrayerTracker.Entities.EntitiesTests
open Expecto
open System
open System.Linq
open NodaTime.Testing
open NodaTime
open System
[<Tests>]
let asOfDateDisplayTests =
testList "AsOfDateDisplay" [
test "NoDisplay code is correct" {
Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\""
}
test "ShortDate code is correct" {
Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\""
}
test "LongDate code is correct" {
Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\""
}
test "fromCode N should return NoDisplay" {
Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay"
}
test "fromCode S should return ShortDate" {
Expect.equal (AsOfDateDisplay.fromCode "S") ShortDate "\"S\" should have been converted to ShortDate"
}
test "fromCode L should return LongDate" {
Expect.equal (AsOfDateDisplay.fromCode "L") LongDate "\"L\" should have been converted to LongDate"
}
test "fromCode X should raise" {
Expect.throws (fun () -> AsOfDateDisplay.fromCode "X" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let churchTests =
@@ -22,6 +48,52 @@ let churchTests =
}
]
[<Tests>]
let emailFormatTests =
testList "EmailFormat" [
test "HtmlFormat code is correct" {
Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\""
}
test "PlainTextFormat code is correct" {
Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\""
}
test "fromCode H should return HtmlFormat" {
Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat"
}
test "fromCode P should return ShortDate" {
Expect.equal (EmailFormat.fromCode "P") PlainTextFormat "\"P\" should have been converted to PlainTextFormat"
}
test "fromCode Z should raise" {
Expect.throws (fun () -> EmailFormat.fromCode "Z" |> ignore) "An unknown code should have raised an exception"
}
]
[<Tests>]
let expirationTests =
testList "Expiration" [
test "Automatic code is correct" {
Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\""
}
test "Manual code is correct" {
Expect.equal Manual.code "M" "The code for Manual should have been \"M\""
}
test "Forced code is correct" {
Expect.equal Forced.code "F" "The code for Forced should have been \"F\""
}
test "fromCode A should return Automatic" {
Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic"
}
test "fromCode M should return Manual" {
Expect.equal (Expiration.fromCode "M") Manual "\"M\" should have been converted to Manual"
}
test "fromCode F should return Forced" {
Expect.equal (Expiration.fromCode "F") Forced "\"F\" should have been converted to Forced"
}
test "fromCode V should raise" {
Expect.throws (fun () -> Expiration.fromCode "V" |> ignore) "An unknown code should have raised an exception"
}
]
[<Tests>]
let listPreferencesTests =
testList "ListPreferences" [
@@ -39,12 +111,14 @@ let listPreferencesTests =
Expect.equal mt.lineColor "navy" "The default heding line color should have been navy"
Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16"
Expect.equal mt.textFontSize 12 "The default text font size should have been 12"
Expect.equal mt.requestSort "D" "The default request sort should have been D (date)"
Expect.equal mt.requestSort SortByDate "The default request sort should have been by date"
Expect.equal mt.groupPassword "" "The default group password should have been blank"
Expect.equal mt.defaultEmailType EmailType.Html "The default e-mail type should have been HTML"
Expect.equal mt.defaultEmailType HtmlFormat "The default e-mail type should have been HTML"
Expect.isFalse mt.isPublic "The isPublic flag should not have been set"
Expect.equal mt.timeZoneId "America/Denver" "The default time zone should have been America/Denver"
Expect.equal mt.timeZone.timeZoneId "" "The default preferences should have included an empty time zone"
Expect.equal mt.pageSize 100 "The default page size should have been 100"
Expect.equal mt.asOfDateDisplay NoDisplay "The as-of date display should have been No Display"
}
]
@@ -68,67 +142,136 @@ let prayerRequestTests =
test "empty is as expected" {
let mt = PrayerRequest.empty
Expect.equal mt.prayerRequestId Guid.Empty "The request ID should have been an empty GUID"
Expect.equal mt.requestType RequestType.Current "The request type should have been Current"
Expect.equal mt.requestType CurrentRequest "The request type should have been Current"
Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID"
Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID"
Expect.equal mt.enteredDate DateTime.MinValue "The entered date should have been the minimum"
Expect.equal mt.updatedDate DateTime.MinValue "The updated date should have been the minimum"
Expect.isNone mt.requestor "The requestor should not exist"
Expect.equal mt.text "" "The request text should have been blank"
Expect.isFalse mt.doNotExpire "The do not expire flag should not have been set"
Expect.isFalse mt.notifyChaplain "The notify chaplain flag should not have been set"
Expect.isFalse mt.isManuallyExpired "The is manually expired flag should not have been set"
Expect.equal mt.expiration Automatic "The expiration should have been Automatic"
Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one"
Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one"
}
test "isExpired always returns false for expecting requests" {
let req = { PrayerRequest.empty with requestType = RequestType.Expecting }
let req = { PrayerRequest.empty with requestType = Expecting }
Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired"
}
test "isExpired always returns false for never-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddMonths -1; doNotExpire = true }
test "isExpired always returns false for manually-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddMonths -1; expiration = Manual }
Expect.isFalse (req.isExpired DateTime.Now 4) "A never-expired request should never be considered expired"
}
test "isExpired always returns false for recurring requests" {
let req = { PrayerRequest.empty with requestType = RequestType.Recurring }
test "isExpired always returns false for long term/recurring requests" {
let req = { PrayerRequest.empty with requestType = LongTermRequest }
Expect.isFalse (req.isExpired DateTime.Now 0) "A recurring/long-term request should never be considered expired"
}
test "isExpired always returns true for manually expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now; isManuallyExpired = true }
Expect.isTrue (req.isExpired DateTime.Now 5) "A manually expired request should always be considered expired"
test "isExpired always returns true for force-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced }
Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired"
}
test "isExpired returns false for non-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddDays -5. }
Expect.isFalse (req.isExpired DateTime.Now 7) "A request updated 5 days ago should not be considered expired"
let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.AddDays -5. }
Expect.isFalse (req.isExpired now 7) "A request updated 5 days ago should not be considered expired"
}
test "isExpired returns true for expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddDays -8. }
Expect.isTrue (req.isExpired DateTime.Now 7) "A request updated 8 days ago should be considered expired"
let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.AddDays -8. }
Expect.isTrue (req.isExpired now 7) "A request updated 8 days ago should be considered expired"
}
test "isExpired returns true for same-day expired requests" {
let now = DateTime.Now
let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. }
Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired"
}
test "updateRequired returns false for expired requests" {
let req = { PrayerRequest.empty with isManuallyExpired = true }
let req = { PrayerRequest.empty with expiration = Forced }
Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update"
}
test "updateRequired returns false when an update is not required for an active request" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = RequestType.Recurring
updatedDate = DateTime.Now.AddDays -14.
requestType = LongTermRequest
updatedDate = now.AddDays -14.
}
Expect.isFalse (req.updateRequired DateTime.Now 7 4)
Expect.isFalse (req.updateRequired now 7 4)
"An active request updated 14 days ago should not require an update until 28 days"
}
test "updateRequired returns true when an update is required for an active request" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = RequestType.Recurring
updatedDate = DateTime.Now.AddDays -34.
requestType = LongTermRequest
updatedDate = now.AddDays -34.
}
Expect.isTrue (req.updateRequired DateTime.Now 7 4)
Expect.isTrue (req.updateRequired now 7 4)
"An active request updated 34 days ago should require an update (past 28 days)"
}
]
[<Tests>]
let prayerRequestTypeTests =
testList "PrayerRequestType" [
test "CurrentRequest code is correct" {
Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\""
}
test "LongTermRequest code is correct" {
Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\""
}
test "PraiseReport code is correct" {
Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\""
}
test "Expecting code is correct" {
Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\""
}
test "Announcement code is correct" {
Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\""
}
test "fromCode C should return CurrentRequest" {
Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest
"\"C\" should have been converted to CurrentRequest"
}
test "fromCode L should return LongTermRequest" {
Expect.equal (PrayerRequestType.fromCode "L") LongTermRequest
"\"L\" should have been converted to LongTermRequest"
}
test "fromCode P should return PraiseReport" {
Expect.equal (PrayerRequestType.fromCode "P") PraiseReport "\"P\" should have been converted to PraiseReport"
}
test "fromCode E should return Expecting" {
Expect.equal (PrayerRequestType.fromCode "E") Expecting "\"E\" should have been converted to Expecting"
}
test "fromCode A should return Announcement" {
Expect.equal (PrayerRequestType.fromCode "A") Announcement "\"A\" should have been converted to Announcement"
}
test "fromCode R should raise" {
Expect.throws (fun () -> PrayerRequestType.fromCode "R" |> ignore)
"An unknown code should have raised an exception"
}
]
[<Tests>]
let requestSortTests =
testList "RequestSort" [
test "SortByDate code is correct" {
Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\""
}
test "SortByRequestor code is correct" {
Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\""
}
test "fromCode D should return SortByDate" {
Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate"
}
test "fromCode R should return SortByRequestor" {
Expect.equal (RequestSort.fromCode "R") SortByRequestor "\"R\" should have been converted to SortByRequestor"
}
test "fromCode Q should raise" {
Expect.throws (fun () -> RequestSort.fromCode "Q" |> ignore) "An unknown code should have raised an exception"
}
]
[<Tests>]
let smallGroupTests =
testList "SmallGroup" [

View File

@@ -2,7 +2,7 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>netcoreapp2.2</TargetFramework>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
@@ -15,9 +15,9 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Expecto" Version="8.9.1" />
<PackageReference Include="Expecto" Version="9.0.4" />
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
<PackageReference Include="NodaTime.Testing" Version="2.4.4" />
<PackageReference Include="NodaTime.Testing" Version="3.0.5" />
</ItemGroup>
<ItemGroup>
@@ -26,8 +26,4 @@
<ProjectReference Include="..\PrayerTracker\PrayerTracker.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project>

View File

@@ -1,7 +1,7 @@
module PrayerTracker.UI.CommonFunctionsTests
open Expecto
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization
open PrayerTracker.Tests.TestLocalization

View File

@@ -68,6 +68,21 @@ let htmlToPlainTextTests =
}
]
[<Tests>]
let makeUrlTests =
testList "makeUrl" [
test "returns the URL when there are no parameters" {
Expect.equal (makeUrl "/test" []) "/test" "The URL should not have had any query string parameters added"
}
test "returns the URL with one query string parameter" {
Expect.equal (makeUrl "/test" [ "unit", "true" ]) "/test?unit=true" "The URL was not constructed properly"
}
test "returns the URL with multiple encoded query string parameters" {
let url = makeUrl "/test" [ "space", "a space"; "turkey", "=" ]
Expect.equal url "/test?space=a+space&turkey=%3D" "The URL was not constructed properly"
}
]
[<Tests>]
let sndAsStringTests =
testList "sndAsString" [

View File

@@ -15,19 +15,31 @@ let countAll _ = true
module ReferenceListTests =
[<Tests>]
let asOfDateListTests =
testList "ReferenceList.asOfDateList" [
test "has all three options listed" {
let asOf = ReferenceList.asOfDateList _s
Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned"
Expect.exists asOf (fun (x, _) -> x = NoDisplay.code) "The option for no display was not found"
Expect.exists asOf (fun (x, _) -> x = ShortDate.code) "The option for a short date was not found"
Expect.exists asOf (fun (x, _) -> x = LongDate.code) "The option for a full date was not found"
}
]
[<Tests>]
let emailTypeListTests =
testList "ReferenceList.emailTypeList" [
test "includes default type" {
let typs = ReferenceList.emailTypeList EmailType.Html _s
let typs = ReferenceList.emailTypeList HtmlFormat _s
Expect.hasCountOf typs 3u countAll "There should have been 3 e-mail type options returned"
let top = Seq.head typs
Expect.equal (fst top) "" "The default option should have been blank"
Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect"
let nxt = typs |> Seq.skip 1 |> Seq.head
Expect.equal (fst nxt) EmailType.Html "The 2nd option should have been HTML"
Expect.equal (fst nxt) HtmlFormat.code "The 2nd option should have been HTML"
let lst = typs |> Seq.last
Expect.equal (fst lst) EmailType.PlainText "The 3rd option should have been plain text"
Expect.equal (fst lst) PlainTextFormat.code "The 3rd option should have been plain text"
}
]
@@ -37,15 +49,15 @@ module ReferenceListTests =
test "excludes immediate expiration if not required" {
let exps = ReferenceList.expirationList _s false
Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned"
Expect.exists exps (fun exp -> fst exp = "N") "The option for normal expiration was not found"
Expect.exists exps (fun exp -> fst exp = "Y") "The option for \"never expire\" 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"
}
test "includes immediate expiration if required" {
let exps = ReferenceList.expirationList _s true
Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned"
Expect.exists exps (fun exp -> fst exp = "N") "The option for normal expiration was not found"
Expect.exists exps (fun exp -> fst exp = "Y") "The option for \"never expire\" was not found"
Expect.exists exps (fun exp -> fst exp = "X") "The option for \"expire immediately\" 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 = Forced.code) "The option for immediate expiration was not found"
}
]
@@ -57,14 +69,12 @@ module ReferenceListTests =
yield! testFixture withList [
yield "returns 5 types",
fun typs -> Expect.hasCountOf typs 5u countAll "There should have been 5 request types returned"
yield! [ RequestType.Current; RequestType.Recurring; RequestType.Praise; RequestType.Expecting;
RequestType.Announcement
]
|> List.map (fun typ ->
sprintf "contains \"%s\"" typ,
fun typs ->
Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ))
(sprintf "The \"%s\" option was not found" typ))
yield! [ CurrentRequest; LongTermRequest; PraiseReport; Expecting; Announcement ]
|> List.map (fun typ ->
sprintf "contains \"%O\"" typ,
fun typs ->
Expect.isSome (typs |> List.tryFind (fun x -> fst x = typ))
(sprintf "The \"%O\" option was not found" typ))
]
]
@@ -220,8 +230,8 @@ let editMemberTests =
Expect.equal edit.emailType "" "The e-mail type should have been blank for group default"
}
test "fromMember populates with specific format" {
let edit = EditMember.fromMember { Member.empty with format = Some EmailType.Html }
Expect.equal edit.emailType EmailType.Html "The e-mail type was not filled correctly"
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"
}
test "empty is as expected" {
let edit = EditMember.empty
@@ -248,10 +258,10 @@ let editPreferencesTests =
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.longTermUpdateWeeks prefs.longTermUpdateWeeks "The weeks for update were not filled correctly"
Expect.equal edit.requestSort prefs.requestSort "The request sort was not filled correctly"
Expect.equal edit.requestSort prefs.requestSort.code "The request sort was not filled correctly"
Expect.equal edit.emailFromName prefs.emailFromName "The e-mail from name was not filled correctly"
Expect.equal edit.emailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly"
Expect.equal edit.defaultEmailType prefs.defaultEmailType "The default e-mail type was not filled correctly"
Expect.equal edit.defaultEmailType prefs.defaultEmailType.code "The default e-mail type was not filled correctly"
Expect.equal edit.headingLineType "Name" "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.headingTextType "Name" "The heading text color type was not derived correctly"
@@ -291,39 +301,29 @@ let editRequestTests =
test "empty is as expected" {
let mt = EditRequest.empty
Expect.equal mt.requestId Guid.Empty "The request ID should be an empty GUID"
Expect.equal mt.requestType "" "The request type should have been blank"
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.skipDateUpdate "The \"skip date update\" flag should have been None"
Expect.isNone mt.requestor "The requestor should have been None"
Expect.equal mt.expiration "N" "The expiration should have been \"N\""
Expect.equal mt.expiration Automatic.code "The expiration should have been \"A\" (Automatic)"
Expect.equal mt.text "" "The text should have been blank"
}
test "fromRequest succeeds when a request has the do-not-expire flag set" {
test "fromRequest succeeds" {
let req =
{ PrayerRequest.empty with
prayerRequestId = Guid.NewGuid ()
requestType = RequestType.Current
requestType = CurrentRequest
requestor = Some "Me"
doNotExpire = true
expiration = Manual
text = "the text"
}
let edit = EditRequest.fromRequest req
Expect.equal edit.requestId req.prayerRequestId "The request ID was not filled correctly"
Expect.equal edit.requestType req.requestType "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.expiration "Y" "The expiration should have been \"Y\" since the do-not-expire flag was set"
Expect.equal edit.expiration Manual.code "The expiration was not filled correctly"
Expect.equal edit.text req.text "The text was not filled correctly"
}
test "fromRequest succeeds when a request has the do-not-expire flag unset" {
let req =
{ PrayerRequest.empty with
requestor = None
doNotExpire = false
}
let edit = EditRequest.fromRequest req
Expect.equal edit.requestor req.requestor "The requestor was not filled correctly"
Expect.equal edit.expiration "N" "The expiration should have been \"N\" since the do-not-expire flag was not set"
}
test "isNew works for a new request" {
Expect.isTrue (EditRequest.empty.isNew ()) "An empty GUID should be flagged as a new request"
}
@@ -438,25 +438,38 @@ let groupLogOnTests =
}
]
[<Tests>]
let maintainRequestsTests =
testList "MaintainRequests" [
test "empty is as expected" {
let mt = MaintainRequests.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.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.pageNbr "The page number should have been None"
}
]
[<Tests>]
let requestListTests =
testList "RequestList" [
let withRequestList f () =
{ requests = [
{ PrayerRequest.empty with
requestType = RequestType.Current
requestType = CurrentRequest
requestor = Some "Zeb"
text = "zyx"
updatedDate = DateTime.Today
}
{ PrayerRequest.empty with
requestType = RequestType.Current
requestType = CurrentRequest
requestor = Some "Aaron"
text = "abc"
updatedDate = DateTime.Today - TimeSpan.FromDays 9.
}
{ PrayerRequest.empty with
requestType = RequestType.Praise
requestType = PraiseReport
text = "nmo"
updatedDate = DateTime.Today
}
@@ -469,7 +482,7 @@ let requestListTests =
}
|> f
yield! testFixture withRequestList [
"asHtml succeeds without header",
"asHtml succeeds without header or as-of date",
fun reqList ->
let htmlList = { reqList with listGroup = { reqList.listGroup with name = "Test HTML Group" } }
let html = htmlList.asHtml _s
@@ -525,7 +538,37 @@ let requestListTests =
Expect.stringContains html lstHeading "Expected HTML for the list heading not found"
// spot check; without header test tests this exhaustively
Expect.stringContains html "<strong>Zeb</strong> &mdash; zyx</li>" "Expected requests not found"
"asText succeeds",
"asHtml succeeds with short as-of date",
fun reqList ->
let htmlList =
{ reqList with
listGroup =
{ reqList.listGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate }
}
}
let html = htmlList.asHtml _s
let expected =
htmlList.requests.[0].updatedDate.ToShortDateString ()
|> 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
Expect.stringContains html expected "Expected short as-of date not found"
"asHtml succeeds with long as-of date",
fun reqList ->
let htmlList =
{ reqList with
listGroup =
{ reqList.listGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate }
}
}
let html = htmlList.asHtml _s
let expected =
htmlList.requests.[0].updatedDate.ToLongDateString ()
|> 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
Expect.stringContains html expected "Expected long as-of date not found"
"asText succeeds with no as-of date",
fun reqList ->
let textList = { reqList with listGroup = { reqList.listGroup with name = "Test Group" } }
let text = textList.asText _s
@@ -539,29 +582,61 @@ let requestListTests =
Expect.stringContains text "------------------\n PRAISE REPORTS\n------------------\n"
"Heading for category \"Praise Reports\" not found"
Expect.stringContains text " + nmo\n \n" "Last request not found"
"asText succeeds with short as-of date",
fun reqList ->
let textList =
{ reqList with
listGroup =
{ reqList.listGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = ShortDate }
}
}
let text = textList.asText _s
let expected =
textList.requests.[0].updatedDate.ToShortDateString ()
|> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should
Expect.stringContains text expected "Expected short as-of date not found"
"asText succeeds with long as-of date",
fun reqList ->
let textList =
{ reqList with
listGroup =
{ reqList.listGroup with
preferences = { reqList.listGroup.preferences with asOfDateDisplay = LongDate }
}
}
let text = textList.asText _s
let expected =
textList.requests.[0].updatedDate.ToLongDateString ()
|> sprintf " + Zeb - zyx (as of %s)"
// spot check; if one request has it, they all should
Expect.stringContains text expected "Expected long as-of date not found"
"isNew succeeds for both old and new requests",
fun reqList ->
let reqs = reqList.requestsInCategory RequestType.Current
let reqs = reqList.requestsInCategory CurrentRequest
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.isFalse (reqList.isNew (List.last reqs)) "The second request should not have been new"
"requestsInCategory succeeds when requests exist",
fun reqList ->
let reqs = reqList.requestsInCategory RequestType.Current
let reqs = reqList.requestsInCategory CurrentRequest
Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs
Expect.equal first.text "zyx" "The requests should be sorted by updated date descending"
"requestsInCategory succeeds when requests do not exist",
fun reqList ->
Expect.isEmpty (reqList.requestsInCategory "ABC") "There should have been no category \"ABC\" requests"
Expect.isEmpty (reqList.requestsInCategory Announcement) "There should have been no \"Announcement\" requests"
"requestsInCategory succeeds and sorts by requestor",
fun reqList ->
let newList =
{ reqList with
listGroup =
{ reqList.listGroup with preferences = { reqList.listGroup.preferences with requestSort = "R" } }
{ reqList.listGroup with
preferences = { reqList.listGroup.preferences with requestSort = SortByRequestor }
}
}
let reqs = newList.requestsInCategory RequestType.Current
let reqs = newList.requestsInCategory CurrentRequest
Expect.hasCountOf reqs 2u countAll "There should have been two requests"
let first = List.head reqs
Expect.equal first.text "abc" "The requests should be sorted by requestor"
@@ -585,19 +660,19 @@ let userLogOnTests =
let userMessageTests =
testList "UserMessage" [
test "Error is constructed properly" {
let msg = UserMessage.Error
let msg = UserMessage.error
Expect.equal msg.level "ERROR" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None"
}
test "Warning is constructed properly" {
let msg = UserMessage.Warning
let msg = UserMessage.warning
Expect.equal msg.level "WARNING" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None"
}
test "Info is constructed properly" {
let msg = UserMessage.Info
let msg = UserMessage.info
Expect.equal msg.level "Info" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None"

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.Church
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open PrayerTracker.Entities
open PrayerTracker.ViewModels
@@ -8,7 +8,7 @@ open PrayerTracker.ViewModels
let edit (m : EditChurch) ctx vi =
let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church"
let s = I18N.localizer.Force ()
[ form [ _action "/church/save"; _method "post"; _class "pt-center-columns" ] [
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ]
[ rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" ]
csrfToken ctx
@@ -29,11 +29,11 @@ let edit (m : EditChurch) ctx vi =
]
div [ _class "pt-field-row" ] [
div [ _class "pt-checkbox-field" ] [
input [ yield _type "checkbox"
yield _name "hasInterface"
yield _id "hasInterface"
yield _value "True"
match m.hasInterface with Some x when x -> yield _checked | _ -> () ]
input [ _type "checkbox"
_name "hasInterface"
_id "hasInterface"
_value "True"
match m.hasInterface with Some x when x -> _checked | _ -> () ]
label [ _for "hasInterface" ] [ locStr s.["Has an interface with Virtual Prayer Room"] ]
]
]
@@ -74,15 +74,15 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
churches
|> List.map (fun ch ->
let chId = flatGuid ch.churchId
let delAction = sprintf "/church/%s/delete" chId
let delPrompt = s.["Are you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Church"].Value.ToLower ()) ch.name]
let delAction = $"/web/church/{chId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["Church"].Value.ToLower ()} ({ch.name})"""]
tr [] [
td [] [
a [ _href (sprintf "/church/%s/edit" chId); _title s.["Edit This Church"].Value ] [ icon "edit" ]
a [ _href $"/web/church/{chId}/edit"; _title s.["Edit This Church"].Value ] [ icon "edit" ]
a [ _href delAction
_title s.["Delete This Church"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%A')" delAction delPrompt) ]
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str ch.name ]
@@ -96,7 +96,7 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href (sprintf "/church/%s/edit" emptyGuid); _title s.["Add a New Church"].Value ]
a [ _href $"/web/church/{emptyGuid}/edit"; _title s.["Add a New Church"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Church"] ]
br []
br []

View File

@@ -2,8 +2,9 @@
module PrayerTracker.Views.CommonFunctions
open Giraffe
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization
@@ -28,7 +29,7 @@ let space = rawText " "
let icon name = i [ _class "material-icons" ] [ rawText name ]
/// Generate a Material Design icon, specifying the point size (must be defined in CSS)
let iconSized size name = i [ _class (sprintf "material-icons md-%i" size) ] [ rawText name ]
let iconSized size name = i [ _class $"material-icons md-{size}" ] [ rawText name ]
/// Generate a CSRF prevention token
let csrfToken (ctx : HttpContext) =
@@ -52,27 +53,27 @@ let tableSummary itemCount (s : IStringLocalizer) =
let namedColorList name selected attrs (s : IStringLocalizer) =
/// The list of HTML named colors (name, display, text color)
seq {
yield ("aqua", s.["Aqua"], "black")
yield ("black", s.["Black"], "white")
yield ("blue", s.["Blue"], "white")
yield ("fuchsia", s.["Fuchsia"], "black")
yield ("gray", s.["Gray"], "white")
yield ("green", s.["Green"], "white")
yield ("lime", s.["Lime"], "black")
yield ("maroon", s.["Maroon"], "white")
yield ("navy", s.["Navy"], "white")
yield ("olive", s.["Olive"], "white")
yield ("purple", s.["Purple"], "white")
yield ("red", s.["Red"], "black")
yield ("silver", s.["Silver"], "black")
yield ("teal", s.["Teal"], "white")
yield ("white", s.["White"], "black")
yield ("yellow", s.["Yellow"], "black")
("aqua", s.["Aqua"], "black")
("black", s.["Black"], "white")
("blue", s.["Blue"], "white")
("fuchsia", s.["Fuchsia"], "black")
("gray", s.["Gray"], "white")
("green", s.["Green"], "white")
("lime", s.["Lime"], "black")
("maroon", s.["Maroon"], "white")
("navy", s.["Navy"], "white")
("olive", s.["Olive"], "white")
("purple", s.["Purple"], "white")
("red", s.["Red"], "black")
("silver", s.["Silver"], "black")
("teal", s.["Teal"], "white")
("white", s.["White"], "black")
("yellow", s.["Yellow"], "black")
}
|> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color
option [ yield _value colorName
yield _style (sprintf "background-color:%s;color:%s;" colorName txtColor)
yield _style $"background-color:{colorName};color:{txtColor};"
match colorName = selected with true -> yield _selected | false -> () ] [
encodedText (dispText.Value.ToLower ())
])
@@ -81,23 +82,23 @@ let namedColorList name selected attrs (s : IStringLocalizer) =
/// Generate an input[type=radio] that is selected if its value is the current value
let radio name domId value current =
input [ yield _type "radio"
yield _name name
yield _id domId
yield _value value
match value = current with true -> yield _checked | false -> () ]
input [ _type "radio"
_name name
_id domId
_value value
match value = current with true -> _checked | false -> () ]
/// Generate a select list with the current value selected
let selectList name selected attrs items =
items
|> Seq.map (fun (value, text) ->
option [ yield _value value
match value = selected with true -> yield _selected | false -> () ] [ encodedText text ])
option [ _value value
match value = selected with true -> _selected | false -> () ] [ encodedText text ])
|> List.ofSeq
|> select (List.concat [ [ _name name; _id name ]; attrs ])
/// Generate the text for a default entry at the top of a select list
let selectDefault text = sprintf "— %s —" text
let selectDefault text = $"— {text} —"
/// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
@@ -115,7 +116,7 @@ let blockquote = tag "blockquote"
/// role attribute
let _role = attr "role"
/// aria-* attribute
let _aria typ = attr (sprintf "aria-%s" typ)
let _aria typ = attr $"aria-{typ}"
/// onclick attribute
let _onclick = attr "onclick"
/// onsubmit attribute
@@ -125,6 +126,13 @@ let _onsubmit = attr "onsubmit"
let _scoped = flag "scoped"
/// The name this function used to have when the view engine was part of Giraffe
let renderHtmlNode = RenderView.AsString.htmlNode
/// Render an HTML node, then return the value as an HTML string
let renderHtmlString = renderHtmlNode >> HtmlString
/// Utility methods to help with time zones (and localization of their names)
module TimeZones =

View File

@@ -1,7 +1,7 @@
/// Views associated with the home page, or those that don't fit anywhere else
module PrayerTracker.Views.Home
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Html
open PrayerTracker.ViewModels
open System.IO
@@ -32,12 +32,12 @@ let error code vi =
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]]
]
]
yield br []
yield hr []
yield div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [
img [ _src (sprintf "/img/%A.png" s.["footer_en"])
_alt (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"])
_title (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"])
br []
hr []
div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [
img [ _src $"""/img/%A{s.["footer_en"]}.png"""
_alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ]
str vi.version
]
@@ -203,8 +203,8 @@ let termsOfService vi =
use sw = new StringWriter ()
let raw = rawLocText sw
let ppLink =
a [ _href "/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|> (renderHtmlNode >> HtmlString)
a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|> renderHtmlString
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ]

View File

@@ -19,4 +19,4 @@ let localizer = lazy (stringLocFactory.Create ("Common", resAsmName))
/// Get a view localizer
let forView (view : string) =
htmlLocFactory.Create (sprintf "Views.%s" (view.Replace ('/', '.')), resAsmName)
htmlLocFactory.Create ($"""Views.{view.Replace ('/', '.')}""", resAsmName)

View File

@@ -1,7 +1,7 @@
/// Layout items for PrayerTracker
module PrayerTracker.Views.Layout
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open PrayerTracker
open PrayerTracker.ViewModels
open System
@@ -22,61 +22,61 @@ module Navigation =
let leftLinks = [
match m.user with
| Some u ->
yield li [ _class "dropdown" ] [
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Requests"].Value; _title s.["Requests"].Value ]
[ icon "question_answer"; space; locStr s.["Requests"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/prayer-requests" ] [ icon "compare_arrows"; menuSpacer; locStr s.["Maintain"] ]
a [ _href "/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s.["View List"] ]
a [ _href "/web/prayer-requests" ] [ icon "compare_arrows"; menuSpacer; locStr s.["Maintain"] ]
a [ _href "/web/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s.["View List"] ]
]
]
yield li [ _class "dropdown" ] [
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Group"].Value; _title s.["Group"].Value ]
[ icon "group"; space; locStr s.["Group"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/small-group/members" ] [ icon "email"; menuSpacer; locStr s.["Maintain Group Members"] ]
a [ _href "/small-group/announcement" ] [ icon "send"; menuSpacer; locStr s.["Send Announcement"] ]
a [ _href "/small-group/preferences" ] [ icon "build"; menuSpacer; locStr s.["Change Preferences"] ]
a [ _href "/web/small-group/members" ] [ icon "email"; menuSpacer; locStr s.["Maintain Group Members"] ]
a [ _href "/web/small-group/announcement" ] [ icon "send"; menuSpacer; locStr s.["Send Announcement"] ]
a [ _href "/web/small-group/preferences" ] [ icon "build"; menuSpacer; locStr s.["Change Preferences"] ]
]
]
match u.isAdmin with
| true ->
yield li [ _class "dropdown" ] [
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Administration"].Value; _title s.["Administration"].Value ]
[ icon "settings"; space; locStr s.["Administration"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/churches" ] [ icon "home"; menuSpacer; locStr s.["Churches"] ]
a [ _href "/small-groups" ] [ icon "send"; menuSpacer; locStr s.["Groups"] ]
a [ _href "/users" ] [ icon "build"; menuSpacer; locStr s.["Users"] ]
a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s.["Churches"] ]
a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s.["Groups"] ]
a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s.["Users"] ]
]
]
| false -> ()
| None ->
match m.group with
| Some _ ->
yield li [] [
a [ _href "/prayer-requests/view"
li [] [
a [ _href "/web/prayer-requests/view"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
]
| None ->
yield li [ _class "dropdown" ] [
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Log On"].Value; _title s.["Log On"].Value ]
[ icon "security"; space; locStr s.["Log On"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/user/log-on" ] [ icon "person"; menuSpacer; locStr s.["User"] ]
a [ _href "/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s.["Group"] ]
a [ _href "/web/user/log-on" ] [ icon "person"; menuSpacer; locStr s.["User"] ]
a [ _href "/web/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s.["Group"] ]
]
]
yield li [] [
a [ _href "/prayer-requests/lists"
li [] [
a [ _href "/web/prayer-requests/lists"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
]
yield li [] [
a [ _href (sprintf "https://docs.prayer.bitbadger.solutions/%s" <| langCode ())
li [] [
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_aria "label" s.["Help"].Value;
_title s.["View Help"].Value
_target "_blank"
@@ -89,15 +89,15 @@ module Navigation =
| Some _ ->
[ match m.user with
| Some _ ->
yield li [] [
a [ _href "/user/password"
li [] [
a [ _href "/web/user/password"
_aria "label" s.["Change Your Password"].Value
_title s.["Change Your Password"].Value ]
[ icon "lock"; space; locStr s.["Change Your Password"] ]
]
| None -> ()
yield li [] [
a [ _href "/log-off"; _aria "label" s.["Log Off"].Value; _title s.["Log Off"].Value ]
li [] [
a [ _href "/web/log-off"; _aria "label" s.["Log Off"].Value; _title s.["Log Off"].Value ]
[ icon "power_settings_new"; space; locStr s.["Log Off"] ]
]
]
@@ -105,7 +105,7 @@ module Navigation =
header [ _class "pt-title-bar" ] [
section [ _class "pt-title-bar-left" ] [
span [ _class "pt-title-bar-home" ] [
a [ _href "/"; _title s.["Home"].Value ] [ locStr s.["PrayerTracker"] ]
a [ _href "/web/"; _title s.["Home"].Value ] [ locStr s.["PrayerTracker"] ]
]
ul [] leftLinks
]
@@ -120,35 +120,35 @@ module Navigation =
let s = I18N.localizer.Force ()
header [ _id "pt-language" ] [
div [] [
yield span [ _class "u" ] [ locStr s.["Language"]; rawText ": " ]
span [ _class "u" ] [ locStr s.["Language"]; rawText ": " ]
match langCode () with
| "es" ->
yield locStr s.["Spanish"]
yield rawText " &nbsp; &bull; &nbsp; "
yield a [ _href "/language/en" ] [ locStr s.["Change to English"] ]
locStr s.["Spanish"]
rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/en" ] [ locStr s.["Change to English"] ]
| _ ->
yield locStr s.["English"]
yield rawText " &nbsp; &bull; &nbsp; "
yield a [ _href "/language/es" ] [ locStr s.["Cambie a Español"] ]
locStr s.["English"]
rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/es" ] [ locStr s.["Cambie a Español"] ]
]
match m.group with
| Some g ->
[ match m.user with
| Some u ->
yield span [ _class "u" ] [ locStr s.["Currently Logged On"] ]
yield rawText "&nbsp; &nbsp;"
yield icon "person"
yield strong [] [ str u.fullName ]
yield rawText "&nbsp; &nbsp; "
span [ _class "u" ] [ locStr s.["Currently Logged On"] ]
rawText "&nbsp; &nbsp;"
icon "person"
strong [] [ str u.fullName ]
rawText "&nbsp; &nbsp; "
| None ->
yield locStr s.["Logged On as a Member of"]
yield rawText "&nbsp; "
yield icon "group"
yield space
locStr s.["Logged On as a Member of"]
rawText "&nbsp; "
icon "group"
space
match m.user with
| Some _ -> yield a [ _href "/small-group" ] [ strong [] [ str g.name ] ]
| None -> yield strong [] [ str g.name ]
yield rawText " &nbsp;"
| Some _ -> a [ _href "/web/small-group" ] [ strong [] [ str g.name ] ]
| None -> strong [] [ str g.name ]
rawText " &nbsp;"
]
| None -> []
|> div []
@@ -179,13 +179,13 @@ let private commonHead =
let private htmlHead m pageTitle =
let s = I18N.localizer.Force ()
head [] [
yield meta [ _charset "UTF-8" ]
yield title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ]
meta [ _charset "UTF-8" ]
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ]
yield! commonHead
for cssFile in m.style do
yield link [ _rel "stylesheet"; _href (sprintf "/css/%s.css" cssFile); _type "text/css" ]
link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
for jsFile in m.script do
yield script [ _src (sprintf "/js/%s.js" jsFile) ] []
script [ _src $"/js/{jsFile}.js" ] []
]
/// Render a link to the help page for the current page
@@ -194,7 +194,7 @@ let private helpLink link =
sup [] [
a [ _href link
_title s.["Click for Help on This Page"].Value
_onclick (sprintf "return PT.showHelp('%s')" link) ] [
_onclick $"return PT.showHelp('{link}')" ] [
icon "help_outline"
]
]
@@ -202,10 +202,8 @@ let private helpLink link =
/// Render the page title, and optionally a help link
let private renderPageTitle m pageTitle =
h2 [ _id "pt-page-title" ] [
match m.helpLink with
| Some link -> yield Help.fullLink (langCode ()) link |> helpLink
| None -> ()
yield locStr pageTitle
match m.helpLink with Some link -> Help.fullLink (langCode ()) link |> helpLink | None -> ()
locStr pageTitle
]
/// Render the messages that may need to be displayed to the user
@@ -213,19 +211,19 @@ let private messages m =
let s = I18N.localizer.Force ()
m.messages
|> List.map (fun msg ->
table [ _class (sprintf "pt-msg %s" (msg.level.ToLower ())) ] [
table [ _class $"pt-msg {msg.level.ToLower ()}" ] [
tr [] [
td [] [
match msg.level with
| "Info" -> ()
| lvl ->
yield strong [] [ locStr s.[lvl] ]
yield rawText " &#xbb; "
yield rawText msg.text.Value
strong [] [ locStr s.[lvl] ]
rawText " &#xbb; "
rawText msg.text.Value
match msg.description with
| Some desc ->
yield br []
yield div [ _class "description" ] [ rawText desc.Value ]
br []
div [ _class "description" ] [ rawText desc.Value ]
| None -> ()
]
]
@@ -238,9 +236,9 @@ let private htmlFooter m =
let resultTime = TimeSpan(DateTime.Now.Ticks - m.requestStart).TotalSeconds
footer [] [
div [ _id "pt-legal" ] [
a [ _href "/legal/privacy-policy" ] [ locStr s.["Privacy Policy"] ]
a [ _href "/web/legal/privacy-policy" ] [ locStr s.["Privacy Policy"] ]
rawText " &bull; "
a [ _href "/legal/terms-of-service" ] [ locStr s.["Terms of Service"] ]
a [ _href "/web/legal/terms-of-service" ] [ locStr s.["Terms of Service"] ]
rawText " &bull; "
a [ _href "https://github.com/bit-badger/PrayerTracker"
_title s.["View source code and get technical support"].Value
@@ -250,8 +248,8 @@ let private htmlFooter m =
]
]
div [ _id "pt-footer" ] [
a [ _href "/"; _style "line-height:28px;" ] [
img [ _src (sprintf "/img/%O.png" s.["footer_en"]); _alt imgText; _title imgText ]
a [ _href "/web/"; _style "line-height:28px;" ] [
img [ _src $"""/img/%O{s.["footer_en"]}.png"""; _alt imgText; _title imgText ]
]
str m.version
space
@@ -262,7 +260,7 @@ let private htmlFooter m =
]
/// The standard layout for PrayerTracker
let standard m pageTitle content =
let standard m pageTitle (content : XmlNode) =
let s = I18N.localizer.Force ()
let ttl = s.[pageTitle]
html [ _lang "" ] [
@@ -270,11 +268,11 @@ let standard m pageTitle content =
body [] [
Navigation.top m
div [ _id "pt-body" ] [
yield Navigation.identity m
yield renderPageTitle m ttl
Navigation.identity m
renderPageTitle m ttl
yield! messages m
yield content
yield htmlFooter m
content
htmlFooter m
]
]
]
@@ -288,7 +286,5 @@ let bare pageTitle content =
meta [ _charset "UTF-8" ]
title [] [ locStr ttl; titleSep; locStr s.["PrayerTracker"] ]
]
body [] [
content
]
body [] [ content ]
]

View File

@@ -1,7 +1,7 @@
module PrayerTracker.Views.PrayerRequest
open Giraffe
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker
@@ -15,18 +15,18 @@ open System.Text
let edit (m : EditRequest) today ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Request" | false -> "Edit Request"
[ form [ _action "/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [
[ form [ _action "/web/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ]
div [ _class "pt-field-row" ] [
yield div [ _class "pt-field" ] [
div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ]
ReferenceList.requestTypeList s
|> Seq.ofList
|> Seq.map (fun item -> fst item, (snd item).Value)
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" m.requestType [ _required; _autofocus ]
]
yield div [ _class "pt-field" ] [
div [ _class "pt-field" ] [
label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ]
input [ _type "text"
_name "requestor"
@@ -35,12 +35,12 @@ let edit (m : EditRequest) today ctx vi =
]
match m.isNew () with
| true ->
yield div [ _class "pt-field" ] [
div [ _class "pt-field" ] [
label [ _for "enteredDate" ] [ locStr s.["Date"] ]
input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ]
]
| false ->
yield div [ _class "pt-field" ] [
div [ _class "pt-field" ] [
div [ _class "pt-checkbox-field" ] [
br []
input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ]
@@ -55,7 +55,7 @@ let edit (m : EditRequest) today ctx vi =
label [] [ locStr s.["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ())
|> List.map (fun exp ->
let radioId = sprintf "expiration_%s" (fst exp)
let radioId = $"expiration_{fst exp}"
span [ _class "text-nowrap" ] [
radio "expiration" radioId (fst exp) m.expiration
label [ _for radioId ] [ locStr (snd exp) ]
@@ -80,13 +80,13 @@ let edit (m : EditRequest) today ctx vi =
/// View for the request e-mail results page
let email m vi =
let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name
let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let prefs = m.listGroup.preferences
let addresses =
m.recipients
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
(StringBuilder ())
[ p [ _style (sprintf "font-family:%s;font-size:%ipt;" prefs.listFonts prefs.textFontSize) ] [
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [
locStr s.["The request list was sent to the following people, via individual e-mails"]
rawText ":"
br []
@@ -118,7 +118,7 @@ let lists (grps : SmallGroup list) vi =
let l = I18N.forView "Requests/Lists"
use sw = new StringWriter ()
let raw = rawLocText sw
[ yield p [] [
[ p [] [
raw l.["The groups listed below have either public or password-protected request lists."]
space
raw l.["Those with list icons are public, and those with log on icons are password-protected."]
@@ -126,10 +126,10 @@ let lists (grps : SmallGroup list) vi =
raw l.["Click the appropriate icon to log on or view the request list."]
]
match grps.Length with
| 0 -> yield p [] [ raw l.["There are no groups with public or password-protected request lists."] ]
| 0 -> p [] [ raw l.["There are no groups with public or password-protected request lists."] ]
| count ->
yield tableSummary count s
yield table [ _class "pt-table pt-action-table" ] [
tableSummary count s
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
@@ -143,9 +143,9 @@ let lists (grps : SmallGroup list) vi =
tr [] [
match grp.preferences.isPublic with
| true ->
a [ _href (sprintf "/prayer-requests/%s/list" grpId); _title s.["View"].Value ] [ icon "list" ]
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s.["View"].Value ] [ icon "list" ]
| false ->
a [ _href (sprintf "/small-group/log-on/%s" grpId); _title s.["Log On"].Value ]
a [ _href $"/web/small-group/log-on/{grpId}"; _title s.["Log On"].Value ]
[ icon "verified_user" ]
|> List.singleton
|> td []
@@ -160,70 +160,94 @@ let lists (grps : SmallGroup list) vi =
/// View for the prayer request maintenance page
let maintain (reqs : PrayerRequest seq) (grp : SmallGroup) onlyActive (ctx : HttpContext) vi =
let maintain m (ctx : HttpContext) vi =
let s = I18N.localizer.Force ()
let now = grp.localDateNow (ctx.GetService<IClock> ())
let l = I18N.forView "Requests/Maintain"
use sw = new StringWriter ()
let raw = rawLocText sw
let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ())
let typs = ReferenceList.requestTypeList s |> Map.ofList
let updReq (req : PrayerRequest) =
match req.updateRequired now grp.preferences.daysToExpire grp.preferences.longTermUpdateWeeks with
match req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks with
| true -> "pt-request-update"
| false -> ""
|> _class
let reqExp (req : PrayerRequest) =
_class (match req.isExpired now grp.preferences.daysToExpire with true -> "pt-request-expired" | false -> "")
_class (match req.isExpired now m.smallGroup.preferences.daysToExpire with true -> "pt-request-expired" | false -> "")
/// Iterate the sequence once, before we render, so we can get the count of it at the top of the table
let requests =
reqs
m.requests
|> Seq.map (fun req ->
let reqId = flatGuid req.prayerRequestId
let reqText = Utils.htmlToPlainText req.text
let delAction = sprintf "/prayer-request/%s/delete" reqId
let delPrompt = s.["Are you want to delete this prayer request? This action cannot be undone.\\n(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"].Value
let reqText = htmlToPlainText req.text
let delAction = $"/web/prayer-request/{reqId}/delete"
let delPrompt =
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.",
s.["Prayer Request"].Value.ToLower() ]
.Value
"\\n"
l.["(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"]
.Value
]
|> String.concat ""
tr [] [
td [] [
yield a [ _href (sprintf "/prayer-request/%s/edit" reqId); _title s.["Edit This Prayer Request"].Value ]
a [ _href $"/web/prayer-request/{reqId}/edit"; _title l.["Edit This Prayer Request"].Value ]
[ icon "edit" ]
match req.isExpired now grp.preferences.daysToExpire with
match req.isExpired now m.smallGroup.preferences.daysToExpire with
| true ->
yield a [ _href (sprintf "/prayer-request/%s/restore" reqId)
_title s.["Restore This Inactive Request"].Value ]
a [ _href $"/web/prayer-request/{reqId}/restore"
_title l.["Restore This Inactive Request"].Value ]
[ icon "visibility" ]
| false ->
yield a [ _href (sprintf "/prayer-request/%s/expire" reqId)
_title s.["Expire This Request Immediately"].Value ]
a [ _href $"/web/prayer-request/{reqId}/expire"
_title l.["Expire This Request Immediately"].Value ]
[ icon "visibility_off" ]
yield a [ _href delAction; _title s.["Delete This Request"].Value;
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
a [ _href delAction; _title l.["Delete This Request"].Value;
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [ updReq req ] [
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, System.Globalization.CultureInfo.CurrentUICulture))
str (req.updatedDate.ToString(s.["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture))
]
td [] [ locStr typs.[req.requestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
td [] [
yield
match 60 > reqText.Length with
| true -> rawText reqText
| false -> rawText (sprintf "%s&hellip;" (reqText.Substring (0, 60)))
match reqText.Length with
| len when len < 60 -> rawText reqText
| _ -> rawText $"{reqText.[0..59]}&hellip;"
]
])
|> List.ofSeq
[ yield div [ _class "pt-center-text" ] [
[ div [ _class "pt-center-text" ] [
br []
a [ _href (sprintf "/prayer-request/%s/edit" emptyGuid); _title s.["Add a New Request"].Value ]
a [ _href $"/web/prayer-request/{emptyGuid}/edit"; _title s.["Add a New Request"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ]
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/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"] ]
br []
br []
match m.searchTerm with
| Some _ ->
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests"; _title l.["Clear Search Criteria"].Value ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ]
| None -> ()
]
yield tableSummary requests.Length s
form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [
input [ _type "text"
_name "search"
_placeholder l.["Search requests..."].Value
_value (defaultArg m.searchTerm "")
]
space
submit [] "search" s.["Search"]
]
br []
tableSummary requests.Length s
match requests.Length with
| 0 -> ()
| _ ->
yield table [ _class "pt-table pt-action-table" ] [
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
@@ -235,35 +259,57 @@ let maintain (reqs : PrayerRequest seq) (grp : SmallGroup) onlyActive (ctx : Htt
]
tbody [] requests
]
yield div [ _class "pt-center-text" ] [
yield br []
match onlyActive with
| true ->
yield locStr s.["Inactive requests are currently not shown"]
yield br []
yield a [ _href "/prayer-requests/inactive" ] [ locStr s.["Show Inactive Requests"] ]
| false ->
yield locStr s.["Inactive requests are currently shown"]
yield br []
yield a [ _href "/prayer-requests" ] [ locStr s.["Do Not Show Inactive Requests"] ]
div [ _class "pt-center-text" ] [
br []
match m.onlyActive with
| Some true ->
raw l.["Inactive requests are currently not shown"]
br []
a [ _href "/web/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ]
| _ ->
match Option.isSome m.onlyActive with
| true ->
raw l.["Inactive requests are currently shown"]
br []
a [ _href "/web/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ]
br []
br []
| false -> ()
let srch = [ match m.searchTerm with Some s -> "search", s | None -> () ]
let pg = defaultArg m.pageNbr 1
let url =
match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/web/prayer-requests%s"
match pg with
| 1 -> ()
| _ ->
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch
a [ _href (makeUrl url withPage) ]
[ icon "keyboard_arrow_left"; space; raw l.["Previous Page"] ]
rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with
| true ->
a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ]
[ raw l.["Next Page"]; space; icon "keyboard_arrow_right" ]
| false -> ()
]
yield form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
]
|> Layout.Content.wide
|> Layout.standard vi "Maintain Requests"
|> Layout.standard vi (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
/// View for the printable prayer request list
let print m version =
let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name
let imgAlt = sprintf "%s %s" s.["PrayerTracker"].Value s.["from Bit Badger Solutions"].Value
let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}"""
article [] [
rawText (m.asHtml s)
br []
hr []
div [ _style "font-size:70%;font-family:@Model.ListGroup.preferences.listFonts;" ] [
img [ _src (sprintf "/img/%s.png" s.["footer_en"].Value)
div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
img [ _src $"""/img/{s.["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;"
_alt imgAlt
_title imgAlt ]
@@ -277,19 +323,19 @@ let print m version =
/// View for the prayer request list
let view m vi =
let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name
let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = m.date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [
yield br []
yield a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/print/%s" dtString)
_title s.["View Printable"].Value ] [
br []
a [ _class "pt-icon-link"
_href $"/web/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"]
]
match m.canEmail with
| true ->
yield spacer
spacer
match m.date.DayOfWeek = DayOfWeek.Sunday with
| true -> ()
| false ->
@@ -298,21 +344,21 @@ let view m vi =
| true -> date
| false -> findSunday (date.AddDays 1.)
let sunday = findSunday m.date
yield a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/view/%s" (sunday.ToString "yyyy-MM-dd"))
_title s.["List for Next Sunday"].Value ] [
a [ _class "pt-icon-link"
_href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s.["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"]
]
yield spacer
spacer
let emailPrompt = s.["This will e-mail the current list to every member of your group, without further prompting. Are you sure this is what you are ready to do?"].Value
yield a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/email/%s" dtString)
_title s.["Send via E-mail"].Value
_onclick (sprintf "return PT.requests.view.promptBeforeEmail('%s')" emailPrompt) ] [
a [ _class "pt-icon-link"
_href $"/web/prayer-requests/email/{dtString}"
_title s.["Send via E-mail"].Value
_onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"]
]
yield spacer
yield a [ _class "pt-icon-link"; _href "/prayer-requests"; _title s.["Maintain Prayer Requests"].Value ] [
spacer
a [ _class "pt-icon-link"; _href "/web/prayer-requests"; _title s.["Maintain Prayer Requests"].Value ] [
icon "compare_arrows"; rawText " &nbsp;"; locStr s.["Maintain Prayer Requests"]
]
| false -> ()

View File

@@ -1,9 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<AssemblyVersion>7.0.0.0</AssemblyVersion>
<FileVersion>7.0.0.0</FileVersion>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
@@ -20,13 +18,14 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="3.6.0" />
<PackageReference Include="MailKit" Version="2.1.3" />
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="MailKit" Version="2.15.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="12.0.1" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
</ItemGroup>
<ItemGroup>
@@ -55,13 +54,12 @@
<EmbeddedResource Update="Resources\Views\Requests\Lists.es.resx">
<Generator>ResXFileCodeGenerator</Generator>
</EmbeddedResource>
<EmbeddedResource Update="Resources\Views\Requests\Maintain.es.resx">
<Generator>ResXFileCodeGenerator</Generator>
</EmbeddedResource>
<EmbeddedResource Update="Resources\Views\SmallGroup\Preferences.es.resx">
<Generator>ResXFileCodeGenerator</Generator>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project>

View File

@@ -144,8 +144,8 @@
<data name="Aqua" xml:space="preserve">
<value>Verde Azulado Brillante</value>
</data>
<data name="Are you want to delete this {0}? This action cannot be undone." xml:space="preserve">
<value>¿Está desea eliminar este {0}? Esta acción no se puede deshacer.</value>
<data name="Are you sure you want to delete this {0}? This action cannot be undone." xml:space="preserve">
<value>¿Seguro que desea eliminar este {0}? Esta acción no se puede deshacer.</value>
</data>
<data name="Attached PDF" xml:space="preserve">
<value>PDF Adjunto</value>
@@ -612,9 +612,6 @@
<data name="Delete This Group" xml:space="preserve">
<value>Eliminar Este Grupo</value>
</data>
<data name="Do Not Show Inactive Requests" xml:space="preserve">
<value>No Muestran las Peticiones Inactivos</value>
</data>
<data name="E-mail" xml:space="preserve">
<value>Correo Electrónico</value>
</data>
@@ -633,12 +630,6 @@
<data name="Group Preferences" xml:space="preserve">
<value>Las Preferencias del Grupo</value>
</data>
<data name="Inactive requests are currently not shown" xml:space="preserve">
<value>Peticiones inactivas no se muestra actualmente</value>
</data>
<data name="Inactive requests are currently shown" xml:space="preserve">
<value>Peticiones inactivas se muestra actualmente</value>
</data>
<data name="Maintain Groups" xml:space="preserve">
<value>Mantener los Grupos</value>
</data>
@@ -696,9 +687,6 @@
<data name="Send Announcement to" xml:space="preserve">
<value>Enviar anuncio a</value>
</data>
<data name="Show Inactive Requests" xml:space="preserve">
<value>Muestran las Peticiones Inactivos</value>
</data>
<data name="Sort by Last Updated Date" xml:space="preserve">
<value>Ordenar por Fecha de Última Actualización</value>
</data>
@@ -729,15 +717,6 @@
<data name="Active Requests" xml:space="preserve">
<value>Peticiones Activas</value>
</data>
<data name="Delete This Request" xml:space="preserve">
<value>Eliminar esta petición</value>
</data>
<data name="Edit This Prayer Request" xml:space="preserve">
<value>Editar esta petición de oración</value>
</data>
<data name="Expire This Request Immediately" xml:space="preserve">
<value>Expirar esta petición de oración de inmediato</value>
</data>
<data name="Maintain Prayer Requests" xml:space="preserve">
<value>Mantener las Peticiones de Oración</value>
</data>
@@ -747,9 +726,6 @@
<data name="Quick Actions" xml:space="preserve">
<value>Acciones Rápidas</value>
</data>
<data name="Restore This Inactive Request" xml:space="preserve">
<value>Restaurar esta petición inactiva</value>
</data>
<data name="Save" xml:space="preserve">
<value>Guardar</value>
</data>
@@ -819,4 +795,31 @@
<data name="Click for Help on This Page" xml:space="preserve">
<value>Haga Clic para Obtener Ayuda en Esta Página</value>
</data>
<data name="Search" xml:space="preserve">
<value>Buscar</value>
</data>
<data name="Display a full “as of” date" xml:space="preserve">
<value>Mostrar una fecha “como de” completa</value>
</data>
<data name="Display a short “as of” date" xml:space="preserve">
<value>Mostrar una fecha “como de” corta</value>
</data>
<data name="Do not display the “as of” date" xml:space="preserve">
<value>No se muestran la fecha “como de”</value>
</data>
<data name="Page Size" xml:space="preserve">
<value>Tamaño de Página</value>
</data>
<data name="Prayer Request" xml:space="preserve">
<value>Petición de Oración</value>
</data>
<data name="Search Results" xml:space="preserve">
<value>Resultados de la Búsqueda</value>
</data>
<data name="“As of” Date Display" xml:space="preserve">
<value>Visualización de la Fecha “Como de”</value>
</data>
<data name="as of" xml:space="preserve">
<value>como de</value>
</data>
</root>

View File

@@ -0,0 +1,159 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<data name="(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)" xml:space="preserve">
<value>(Si la solicitud de oración ha sido respondida o si un evento ha pasado, considere desactivarla.)</value>
</data>
<data name="Clear Search Criteria" xml:space="preserve">
<value>Borrar los Criterios de Búsqueda</value>
</data>
<data name="Delete This Request" xml:space="preserve">
<value>Eliminar esta petición</value>
</data>
<data name="Do Not Show Inactive Requests" xml:space="preserve">
<value>No Muestran las Peticiones Inactivos</value>
</data>
<data name="Edit This Prayer Request" xml:space="preserve">
<value>Editar esta petición de oración</value>
</data>
<data name="Expire This Request Immediately" xml:space="preserve">
<value>Expirar esta petición de oración de inmediato</value>
</data>
<data name="Inactive requests are currently not shown" xml:space="preserve">
<value>Peticiones inactivas no se muestra actualmente</value>
</data>
<data name="Inactive requests are currently shown" xml:space="preserve">
<value>Peticiones inactivas se muestra actualmente</value>
</data>
<data name="Next Page" xml:space="preserve">
<value>Siguiente Página</value>
</data>
<data name="Previous Page" xml:space="preserve">
<value>Página Anterior</value>
</data>
<data name="Restore This Inactive Request" xml:space="preserve">
<value>Restaurar esta petición inactiva</value>
</data>
<data name="Search requests..." xml:space="preserve">
<value>Busca las peticiones...</value>
</data>
<data name="Show Inactive Requests" xml:space="preserve">
<value>Muestran las Peticiones Inactivos</value>
</data>
</root>

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.SmallGroup
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.Extensions.Localization
open PrayerTracker
open PrayerTracker.Entities
@@ -11,9 +11,9 @@ open System.IO
let announcement isAdmin ctx vi =
let s = I18N.localizer.Force ()
let reqTypes = ReferenceList.requestTypeList s
[ form [ _action "/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [
yield csrfToken ctx
yield div [ _class "pt-field-row" ] [
[ form [ _action "/web/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s.["Announcement Text"] ]
textarea [ _name "text"; _id "text"; _autofocus ] []
@@ -21,7 +21,7 @@ let announcement isAdmin ctx vi =
]
match isAdmin with
| true ->
yield div [ _class "pt-field-row" ] [
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [] [ locStr s.["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [
@@ -32,24 +32,23 @@ let announcement isAdmin ctx vi =
]
]
]
| false ->
yield input [ _type "hidden"; _name "sendToClass"; _value "Y" ]
yield div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
| false -> input [ _type "hidden"; _name "sendToClass"; _value "Y" ]
div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ]
label [ _for "addToRequestList" ] [ locStr s.["Add to Request List"] ]
]
]
yield div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [
div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [
div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ]
reqTypes
|> Seq.ofList
|> Seq.map (fun item -> fst item, (snd item).Value)
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" "Announcement" []
]
]
yield div [ _class "pt-field-row" ] [ submit [] "send" s.["Send Announcement"] ]
div [ _class "pt-field-row" ] [ submit [] "send" s.["Send Announcement"] ]
]
script [] [ rawText "PT.onLoad(PT.smallGroup.announcement.onPageLoad)" ]
]
@@ -75,7 +74,7 @@ let announcementSent (m : Announcement) vi =
let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group" | false -> "Edit Group"
form [ _action "/small-group/save"; _method "post"; _class "pt-center-columns" ] [
form [ _action "/web/small-group/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx
input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ]
div [ _class "pt-field-row" ] [
@@ -88,7 +87,7 @@ let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s.["Church"] ]
seq {
yield "", selectDefault s.["Select Church"].Value
"", selectDefault s.["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name)
}
|> selectList "churchId" (flatGuid m.churchId) [ _required ]
@@ -105,7 +104,7 @@ let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
let editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group Member" | false -> "Edit Group Member"
form [ _action "/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; }" ]
csrfToken ctx
input [ _type "hidden"; _name "memberId"; _value (flatGuid m.memberId) ]
@@ -137,18 +136,18 @@ let editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
/// View for the small group log on page
let logOn (grps : SmallGroup list) grpId ctx vi =
let s = I18N.localizer.Force ()
[ form [ _action "/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
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ]
seq {
match grps.Length with
| 0 -> yield "", s.["There are no classes with passwords defined"].Value
| 0 -> "", s.["There are no classes with passwords defined"].Value
| _ ->
yield "", selectDefault s.["Select Group"].Value
"", selectDefault s.["Select Group"].Value
yield! grps
|> List.map (fun grp -> flatGuid grp.smallGroupId, sprintf "%s | %s" grp.church.name grp.name)
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
}
|> selectList "smallGroupId" grpId [ _required ]
]
@@ -191,15 +190,15 @@ let maintain (grps : SmallGroup list) ctx vi =
grps
|> List.map (fun g ->
let grpId = flatGuid g.smallGroupId
let delAction = sprintf "/small-group/%s/delete" grpId
let delPrompt = s.["Are you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Small Group"].Value.ToLower ()) g.name].Value
let delAction = $"/web/small-group/{grpId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["Small Group"].Value.ToLower ()} ({g.name})""" ].Value
tr [] [
td [] [
a [ _href (sprintf "/small-group/%s/edit" grpId); _title s.["Edit This Group"].Value ] [ icon "edit" ]
a [ _href $"/web/small-group/{grpId}/edit"; _title s.["Edit This Group"].Value ] [ icon "edit" ]
a [ _href delAction
_title s.["Delete This Group"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str g.name ]
@@ -210,7 +209,7 @@ let maintain (grps : SmallGroup list) ctx vi =
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href (sprintf "/small-group/%s/edit" emptyGuid); _title s.["Add a New Group"].Value ] [
a [ _href $"/web/small-group/{emptyGuid}/edit"; _title s.["Add a New Group"].Value ] [
icon "add_circle"
rawText " &nbsp;"
locStr s.["Add a New Group"]
@@ -245,16 +244,18 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
mbrs
|> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId
let delAction = sprintf "/small-group/member/%s/delete" mbrId
let delPrompt = s.["Are you want to delete this {0} ({1})? This action cannot be undone.",
s.["group member"], mbr.memberName].Value
let delAction = $"/web/small-group/member/{mbrId}/delete"
let delPrompt =
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]]
.Value
.Replace("?", $" ({mbr.memberName})?")
tr [] [
td [] [
a [ _href (sprintf "/small-group/member/%s/edit" mbrId); _title s.["Edit This Group Member"].Value ]
a [ _href $"/web/small-group/member/{mbrId}/edit"; _title s.["Edit This Group Member"].Value ]
[ icon "edit" ]
a [ _href delAction
_title s.["Delete This Group Member"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str mbr.memberName ]
@@ -265,7 +266,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
]
[ div [ _class"pt-center-text" ] [
br []
a [ _href (sprintf "/small-group/member/%s/edit" emptyGuid); _title s.["Add a New Group Member"].Value ]
a [ _href $"/web/small-group/member/{emptyGuid}/edit"; _title s.["Add a New Group Member"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Group Member"] ]
br []
br []
@@ -282,7 +283,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
let overview m vi =
let s = I18N.localizer.Force ()
let linkSpacer = rawText "&nbsp; "
let typs = ReferenceList.requestTypeList s |> Map.ofList
let typs = ReferenceList.requestTypeList s |> dict
article [ _class "pt-overview" ] [
section [] [
header [ _role "heading" ] [
@@ -290,11 +291,11 @@ let overview m vi =
locStr s.["Quick Actions"]
]
div [] [
a [ _href "/prayer-requests/view" ] [ icon "list"; linkSpacer; locStr s.["View Prayer Request List"] ]
a [ _href "/web/prayer-requests/view" ] [ icon "list"; linkSpacer; locStr s.["View Prayer Request List"] ]
hr []
a [ _href "/small-group/announcement" ] [ icon "send"; linkSpacer; locStr s.["Send Announcement"] ]
a [ _href "/web/small-group/announcement" ] [ icon "send"; linkSpacer; locStr s.["Send Announcement"] ]
hr []
a [ _href "/small-group/preferences" ] [ icon "build"; linkSpacer; locStr s.["Change Preferences"] ]
a [ _href "/web/small-group/preferences" ] [ icon "build"; linkSpacer; locStr s.["Change Preferences"] ]
]
]
section [] [
@@ -303,21 +304,21 @@ let overview m vi =
locStr s.["Prayer Requests"]
]
div [] [
yield p [ _class "pt-center-text" ] [
p [ _class "pt-center-text" ] [
strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s.["Active Requests"] ]
]
yield hr []
hr []
for cat in m.activeReqsByCat do
yield str (cat.Value.ToString "N0")
yield space
yield locStr typs.[cat.Key]
yield br []
yield br []
yield str (m.allReqs.ToString "N0")
yield space
yield locStr s.["Total Requests"]
yield hr []
yield a [ _href "/prayer-requests/maintain" ] [
str (cat.Value.ToString "N0")
space
locStr typs.[cat.Key]
br []
br []
str (m.allReqs.ToString "N0")
space
locStr s.["Total Requests"]
hr []
a [ _href "/web/prayer-requests/maintain" ] [
icon "compare_arrows"
linkSpacer
locStr s.["Maintain Prayer Requests"]
@@ -332,7 +333,7 @@ let overview m vi =
div [ _class "pt-center-text" ] [
strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s.["Members"] ]
hr []
a [ _href "/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"] ]
]
]
]
@@ -347,8 +348,8 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
let l = I18N.forView "SmallGroup/Preferences"
use sw = new StringWriter ()
let raw = rawLocText sw
[ form [ _action "/small-group/preferences/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] [ rawText "#expireDays, #daysToKeepNew, #longTermUpdateWeeks, #headingFontSize, #listFontSize { width: 3rem; } #emailFromAddress { width: 20rem; } #listFonts { width: 40rem; } @media screen and (max-width: 40rem) { #listFonts { width: 100%; } }" ]
[ 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%; } }" ]
csrfToken ctx
fieldset [] [
legend [] [ strong [] [ icon "date_range"; rawText " &nbsp;"; locStr s.["Dates"] ] ]
@@ -404,8 +405,10 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s.["E-mail Format"] ]
seq {
yield "", selectDefault s.["Select"].Value
yield! ReferenceList.emailTypeList "" s |> Seq.skip 1 |> Seq.map (fun typ -> fst typ, (snd typ).Value)
"", selectDefault s.["Select"].Value
yield! ReferenceList.emailTypeList HtmlFormat s
|> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
}
|> selectList "defaultEmailType" m.defaultEmailType [ _required ]
]
@@ -420,16 +423,16 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType
label [ _for "headingLineType_Name" ] [ locStr s.["Named Color"] ]
namedColorList "headingLineColor" m.headingLineColor
[ yield _id "headingLineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> yield _disabled | false -> () ] s
[ _id "headingLineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ())
radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType
label [ _for "headingLineType_RGB" ] [ locStr s.["Custom Color"] ]
input [ yield _type "color"
yield _name "headingLineColor"
yield _id "headingLineColor_Color"
yield _value m.headingLineColor
match m.headingLineColor.StartsWith "#" with true -> () | false -> yield _disabled ]
input [ _type "color"
_name "headingLineColor"
_id "headingLineColor_Color"
_value m.headingLineColor
match m.headingLineColor.StartsWith "#" with true -> () | false -> _disabled ]
]
]
]
@@ -440,16 +443,16 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType
label [ _for "headingTextType_Name" ] [ locStr s.["Named Color"] ]
namedColorList "headingTextColor" m.headingTextColor
[ yield _id "headingTextColor_Select"
match m.headingTextColor.StartsWith "#" with true -> yield _disabled | false -> () ] s
[ _id "headingTextColor_Select"
match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ())
radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType
label [ _for "headingTextType_RGB" ] [ locStr s.["Custom Color"] ]
input [ yield _type "color"
yield _name "headingTextColor"
yield _id "headingTextColor_Color"
yield _value m.headingTextColor
match m.headingTextColor.StartsWith "#" with true -> () | false -> yield _disabled ]
input [ _type "color"
_name "headingTextColor"
_id "headingTextColor_Color"
_value m.headingTextColor
match m.headingTextColor.StartsWith "#" with true -> () | false -> _disabled ]
]
]
]
@@ -477,9 +480,9 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
legend [] [ strong [] [ icon "settings"; rawText " &nbsp;"; locStr s.["Other Settings"] ] ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "TimeZone" ] [ locStr s.["Time Zone"] ]
label [ _for "timeZone" ] [ locStr s.["Time Zone"] ]
seq {
yield "", selectDefault s.["Select"].Value
"", selectDefault s.["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
}
|> selectList "timeZone" m.timeZone [ _required ]
@@ -498,10 +501,10 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
label [ _for "viz_Password" ] [ locStr s.["Password Protected"] ]
]
]
div [ yield _id "divClassPassword"
div [ _id "divClassPassword"
match m.listVisibility = RequestVisibility.passwordProtected with
| true -> yield _class "pt-field-row pt-fadeable pt-show"
| false -> yield _class "pt-field-row pt-fadeable"
| true -> _class "pt-field-row pt-fadeable pt-show"
| false -> _class "pt-field-row pt-fadeable"
] [
div [ _class "pt-field" ] [
label [ _for "groupPassword" ] [ locStr s.["Group Password (Used to Read Online)"] ]
@@ -509,8 +512,21 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
_value (match m.groupPassword with Some x -> x | None -> "") ]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Preferences"] ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "pageSize" ] [ locStr s.["Page Size"] ]
input [ _type "number"; _name "pageSize"; _id "pageSize"; _min "10"; _max "255"; _required
_value (string m.pageSize) ]
]
div [ _class "pt-field" ] [
label [ _for "asOfDate" ] [ locStr s.["“As of” Date Display"] ]
ReferenceList.asOfDateList s
|> List.map (fun (code, desc) -> code, desc.Value)
|> selectList "asOfDate" m.asOfDate [ _required ]
]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Preferences"] ]
]
p [] [
rawText "** "

View File

@@ -1,6 +1,6 @@
module PrayerTracker.Views.User
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open PrayerTracker.Entities
open PrayerTracker.ViewModels
@@ -8,7 +8,7 @@ open PrayerTracker.ViewModels
let assignGroups m groups curGroups ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %A" m.userName s.["Assign Groups"]
form [ _action "/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
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
input [ _type "hidden"; _name "userName"; _value m.userName ]
@@ -21,14 +21,14 @@ let assignGroups m groups curGroups ctx vi =
]
groups
|> List.map (fun (grpId, grpName) ->
let inputId = sprintf "id-%s" grpId
let inputId = $"id-{grpId}"
tr [] [
td [] [
input [ yield _type "checkbox"
yield _name "smallGroups"
yield _id inputId
yield _value grpId
match curGroups |> List.contains grpId with true -> yield _checked | false -> () ]
input [ _type "checkbox"
_name "smallGroups"
_id inputId
_value grpId
match curGroups |> List.contains grpId with true -> _checked | false -> () ]
]
td [] [ label [ _for inputId ] [ str grpName ] ]
])
@@ -47,9 +47,9 @@ let changePassword ctx vi =
[ 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."]
]
form [ _action "/user/password/change"
form [ _action "/web/user/password/change"
_method "post"
_onsubmit (sprintf "return PT.compareValidation('newPassword','newPasswordConfirm','%A')" s.["The passwords do not match"]) ] [
_onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s.["The passwords do not match"]}')""" ] [
style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "]
csrfToken ctx
div [ _class "pt-field-row" ] [
@@ -83,8 +83,8 @@ let edit (m : EditUser) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User"
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value
[ form [ _action "/user/edit/save"; _method "post"; _class "pt-center-columns"
_onsubmit (sprintf "return PT.compareValidation('password','passwordConfirm','%A')" s.["The passwords do not match"]) ] [
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns"
_onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s.["The passwords do not match"]}')""" ] [
style [ _scoped ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
csrfToken ctx
@@ -114,16 +114,16 @@ let edit (m : EditUser) ctx vi =
]
]
div [ _class "pt-checkbox-field" ] [
input [ yield _type "checkbox"
yield _name "isAdmin"
yield _id "isAdmin"
yield _value "True"
match m.isAdmin with Some x when x -> yield _checked | _ -> () ]
input [ _type "checkbox"
_name "isAdmin"
_id "isAdmin"
_value "True"
match m.isAdmin with Some x when x -> _checked | _ -> () ]
label [ _for "isAdmin" ] [ locStr s.["This user is a PrayerTracker administrator"] ]
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ]
]
script [] [ rawText (sprintf "PT.onLoad(PT.user.edit.onPageLoad(%s))" ((string (m.isNew ())).ToLower ())) ]
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ]
]
|> Layout.Content.standard
|> Layout.standard vi pageTitle
@@ -132,7 +132,7 @@ let edit (m : EditUser) ctx vi =
/// View for the user log on page
let logOn (m : UserLogOn) groups ctx vi =
let s = I18N.localizer.Force ()
form [ _action "/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; }" ]
csrfToken ctx
input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ]
@@ -151,7 +151,7 @@ let logOn (m : UserLogOn) groups ctx vi =
div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ]
seq {
yield "", selectDefault s.["Select Group"].Value
"", selectDefault s.["Select Group"].Value
yield! groups
}
|> selectList "smallGroupId" "" [ _required ]
@@ -189,31 +189,31 @@ let maintain (users : User list) ctx vi =
users
|> List.map (fun user ->
let userId = flatGuid user.userId
let delAction = sprintf "/user/%s/delete" userId
let delPrompt = s.["Are you want to delete this {0}? This action cannot be undone.",
(sprintf "%s (%s)" (s.["User"].Value.ToLower()) user.fullName)].Value
let delAction = $"/web/user/{userId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value
tr [] [
td [] [
a [ _href (sprintf "/user/%s/edit" userId); _title s.["Edit This User"].Value ] [ icon "edit" ]
a [ _href (sprintf "/user/%s/small-groups" userId); _title s.["Assign Groups to This User"].Value ]
a [ _href $"/web/user/{userId}/edit"; _title s.["Edit This User"].Value ] [ icon "edit" ]
a [ _href $"/web/user/{userId}/small-groups"; _title s.["Assign Groups to This User"].Value ]
[ icon "group" ]
a [ _href delAction
_title s.["Delete This User"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ]
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str user.fullName ]
td [ _class "pt-center-text" ] [
match user.isAdmin with
| true -> yield strong [] [ locStr s.["Yes"] ]
| false -> yield locStr s.["No"]
| true -> strong [] [ locStr s.["Yes"] ]
| false -> locStr s.["No"]
]
])
|> tbody []
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href (sprintf "/user/%s/edit" emptyGuid); _title s.["Add a New User"].Value ]
a [ _href $"/web/user/{emptyGuid}/edit"; _title s.["Add a New User"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New User"] ]
br []
br []

View File

@@ -30,17 +30,15 @@ module String =
/// string.Replace()
let replace (find : string) repl (str : string) = str.Replace (find, repl)
/// Replace the first occurrence of a string with a second string within a given string
let replaceFirst (needle : string) replacement (haystack : string) =
match haystack.IndexOf needle with
| -1 -> haystack
| idx ->
seq {
yield haystack.[0..idx - 1]
yield replacement
yield haystack.[idx + needle.Length..]
}
[ haystack.[0..idx - 1]
replacement
haystack.[idx + needle.Length..]
]
|> String.concat ""
@@ -56,9 +54,9 @@ let stripTags allowedTags input =
|> List.fold
(fun acc t ->
acc
|| htmlTag.IndexOf (sprintf "<%s>" t) = 0
|| htmlTag.IndexOf (sprintf "<%s " t) = 0
|| htmlTag.IndexOf (sprintf "</%s" t) = 0) false
|| htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf $"</{t}" = 0) false
match isAllowed with
| true -> ()
| false -> output <- String.replaceFirst tag.Value "" output
@@ -127,6 +125,20 @@ let htmlToPlainText html =
/// Get the second portion of a tuple as a string
let sndAsString x = (snd >> string) x
/// Make a URL with query string parameters
let makeUrl (url : string) (qs : (string * string) list) =
let queryString =
qs
|> List.fold
(fun (acc : StringBuilder) (key, value) ->
acc.Append(key).Append("=").Append(WebUtility.UrlEncode value).Append "&")
(StringBuilder ())
match queryString.Length with
| 0 -> url
| _ -> queryString.Insert(0, "?").Insert(0, url).Remove(queryString.Length - 1, 1).ToString ()
/// "Magic string" repository
[<RequireQualifiedAccess>]
module Key =
@@ -188,7 +200,7 @@ module Help =
/// Help link for user password change page
let changePassword = "user/password"
/// Create a full link for a help page
let fullLink lang url = sprintf "https://docs.prayer.bitbadger.solutions/%s/%s.html" lang url
let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html"
/// This class serves as a common anchor for resources
type Common () =

View File

@@ -10,39 +10,43 @@ open System
/// Helper module to return localized reference lists
module ReferenceList =
/// A localized list of the AsOfDateDisplay DU cases
let asOfDateList (s : IStringLocalizer) =
[ NoDisplay.code, s.["Do not display the “as of” date"]
ShortDate.code, s.["Display a short “as of” date"]
LongDate.code, s.["Display a full “as of” date"]
]
/// A list of e-mail type options
let emailTypeList def (s : IStringLocalizer) =
// Localize the default type
let defaultType =
match def with
| EmailType.Html -> s.["HTML Format"].Value
| EmailType.PlainText -> s.["Plain-Text Format"].Value
| EmailType.AttachedPdf -> s.["Attached PDF"].Value
| _ -> ""
| HtmlFormat -> s.["HTML Format"].Value
| PlainTextFormat -> s.["Plain-Text Format"].Value
seq {
yield "", LocalizedString ("", sprintf "%s (%s)" s.["Group Default"].Value defaultType)
yield EmailType.Html, s.["HTML Format"]
yield EmailType.PlainText, s.["Plain-Text Format"]
"", LocalizedString ("", $"""{s.["Group Default"].Value} ({defaultType})""")
HtmlFormat.code, s.["HTML Format"]
PlainTextFormat.code, s.["Plain-Text Format"]
}
/// A list of expiration options
let expirationList (s : IStringLocalizer) includeExpireNow =
seq {
yield "N", s.["Expire Normally"]
yield "Y", s.["Request Never Expires"]
match includeExpireNow with true -> yield "X", s.["Expire Immediately"] | false -> ()
}
|> List.ofSeq
[ Automatic.code, s.["Expire Normally"]
Manual.code, s.["Request Never Expires"]
match includeExpireNow with true -> Forced.code, s.["Expire Immediately"] | false -> ()
]
/// A list of request types
let requestTypeList (s : IStringLocalizer) =
[ RequestType.Current, s.["Current Requests"]
RequestType.Recurring, s.["Long-Term Requests"]
RequestType.Praise, s.["Praise Reports"]
RequestType.Expecting, s.["Expecting"]
RequestType.Announcement, s.["Announcements"]
[ CurrentRequest, s.["Current Requests"]
LongTermRequest, s.["Long-Term Requests"]
PraiseReport, s.["Praise Reports"]
Expecting, s.["Expecting"]
Announcement, s.["Announcements"]
]
// fsharplint:disable RecordFieldNames MemberNames
/// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>]
@@ -54,25 +58,25 @@ type UserMessage =
/// The description (further information)
description : HtmlString option
}
with
/// Error message template
static member Error =
{ level = "ERROR"
text = HtmlString.Empty
description = None
}
/// Warning message template
static member Warning =
{ level = "WARNING"
text = HtmlString.Empty
description = None
}
/// Info message template
static member Info =
{ level = "Info"
text = HtmlString.Empty
description = None
}
module UserMessage =
/// Error message template
let error =
{ level = "ERROR"
text = HtmlString.Empty
description = None
}
/// Warning message template
let warning =
{ level = "WARNING"
text = HtmlString.Empty
description = None
}
/// Info message template
let info =
{ level = "Info"
text = HtmlString.Empty
description = None
}
/// View model required by the layout template, given as first parameter for all pages in PrayerTracker
@@ -95,18 +99,18 @@ type AppViewInfo =
/// The currently logged on small group, if there is one
group : SmallGroup option
}
with
/// A fresh version that can be populated to process the current request
static member fresh =
{ style = []
script = []
helpLink = None
messages = []
version = ""
requestStart = DateTime.Now.Ticks
user = None
group = None
}
module AppViewInfo =
/// A fresh version that can be populated to process the current request
let fresh =
{ style = []
script = []
helpLink = None
messages = []
version = ""
requestStart = DateTime.Now.Ticks
user = None
group = None
}
/// Form for sending a small group or system-wide announcement
@@ -136,9 +140,9 @@ type AssignGroups =
/// The Ids of the small groups to which the user is authorized
smallGroups : string
}
with
module AssignGroups =
/// Create an instance of this form from an existing user
static member fromUser (u : User) =
let fromUser (u : User) =
{ userId = u.userId
userName = u.fullName
smallGroups = ""
@@ -174,24 +178,6 @@ type EditChurch =
interfaceAddress : string option
}
with
/// Create an instance from an existing church
static member fromChurch (ch : Church) =
{ churchId = ch.churchId
name = ch.name
city = ch.city
st = ch.st
hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress
}
/// An instance to use for adding churches
static member empty =
{ churchId = Guid.Empty
name = ""
city = ""
st = ""
hasInterface = None
interfaceAddress = None
}
/// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId
/// Populate a church from this form
@@ -203,7 +189,26 @@ with
hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
}
module EditChurch =
/// Create an instance from an existing church
let fromChurch (ch : Church) =
{ churchId = ch.churchId
name = ch.name
city = ch.city
st = ch.st
hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress
}
/// An instance to use for adding churches
let empty =
{ churchId = Guid.Empty
name = ""
city = ""
st = ""
hasInterface = None
interfaceAddress = None
}
/// Form for adding/editing small group members
[<CLIMutable; NoComparison; NoEquality>]
@@ -218,22 +223,23 @@ type EditMember =
emailType : string
}
with
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
module EditMember =
/// Create an instance from an existing member
static member fromMember (m : Member) =
let fromMember (m : Member) =
{ memberId = m.memberId
memberName = m.memberName
emailAddress = m.email
emailType = match m.format with Some f -> f | None -> ""
}
/// An empty instance
static member empty =
let empty =
{ memberId = Guid.Empty
memberName = ""
emailAddress = ""
emailType = ""
}
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
/// This form allows the user to set class preferences
@@ -273,32 +279,12 @@ type EditPreferences =
listVisibility : int
/// The small group password
groupPassword : string option
/// The page size for search / inactive requests
pageSize : int
/// How the as-of date should be displayed
asOfDate : string
}
with
static member fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ expireDays = prefs.daysToExpire
daysToKeepNew = prefs.daysToKeepNew
longTermUpdateWeeks = prefs.longTermUpdateWeeks
requestSort = prefs.requestSort
emailFromName = prefs.emailFromName
emailFromAddress = prefs.emailFromAddress
defaultEmailType = prefs.defaultEmailType
headingLineType = setType prefs.lineColor
headingLineColor = prefs.lineColor
headingTextType = setType prefs.headingColor
headingTextColor = prefs.headingColor
listFonts = prefs.listFonts
headingFontSize = prefs.headingFontSize
listFontSize = prefs.textFontSize
timeZone = prefs.timeZoneId
groupPassword = Some prefs.groupPassword
listVisibility =
match true with
| _ when prefs.isPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
| _ -> RequestVisibility.passwordProtected
}
/// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw =
@@ -311,10 +297,10 @@ with
daysToExpire = this.expireDays
daysToKeepNew = this.daysToKeepNew
longTermUpdateWeeks = this.longTermUpdateWeeks
requestSort = this.requestSort
requestSort = RequestSort.fromCode this.requestSort
emailFromName = this.emailFromName
emailFromAddress = this.emailFromAddress
defaultEmailType = this.defaultEmailType
defaultEmailType = EmailFormat.fromCode this.defaultEmailType
lineColor = this.headingLineColor
headingColor = this.headingTextColor
listFonts = this.listFonts
@@ -323,6 +309,36 @@ with
timeZoneId = this.timeZone
isPublic = isPublic
groupPassword = grpPw
pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate
}
module EditPreferences =
/// Populate an edit form from existing preferences
let fromPreferences (prefs : ListPreferences) =
let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name"
{ expireDays = prefs.daysToExpire
daysToKeepNew = prefs.daysToKeepNew
longTermUpdateWeeks = prefs.longTermUpdateWeeks
requestSort = prefs.requestSort.code
emailFromName = prefs.emailFromName
emailFromAddress = prefs.emailFromAddress
defaultEmailType = prefs.defaultEmailType.code
headingLineType = setType prefs.lineColor
headingLineColor = prefs.lineColor
headingTextType = setType prefs.headingColor
headingTextColor = prefs.headingColor
listFonts = prefs.listFonts
headingFontSize = prefs.headingFontSize
listFontSize = prefs.textFontSize
timeZone = prefs.timeZoneId
groupPassword = Some prefs.groupPassword
pageSize = prefs.pageSize
asOfDate = prefs.asOfDateDisplay.code
listVisibility =
match true with
| _ when prefs.isPublic -> RequestVisibility.``public``
| _ when prefs.groupPassword = "" -> RequestVisibility.``private``
| _ -> RequestVisibility.passwordProtected
}
@@ -346,27 +362,28 @@ type EditRequest =
text : string
}
with
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
module EditRequest =
/// An empty instance to use for new requests
static member empty =
let empty =
{ requestId = Guid.Empty
requestType = ""
requestType = CurrentRequest.code
enteredDate = None
skipDateUpdate = None
requestor = None
expiration = "N"
expiration = Automatic.code
text = ""
}
/// Create an instance from an existing request
static member fromRequest req =
{ EditRequest.empty with
let fromRequest req =
{ empty with
requestId = req.prayerRequestId
requestType = req.requestType
requestType = req.requestType.code
requestor = req.requestor
expiration = match req.doNotExpire with true -> "Y" | false -> "N"
expiration = req.expiration.code
text = req.text
}
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
/// Form for the admin-level editing of small groups
@@ -380,18 +397,6 @@ type EditSmallGroup =
churchId : ChurchId
}
with
/// Create an instance from an existing small group
static member fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId
name = g.name
churchId = g.churchId
}
/// An empty instance (used when adding a new group)
static member empty =
{ smallGroupId = Guid.Empty
name = ""
churchId = Guid.Empty
}
/// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId
/// Populate a small group from this form
@@ -400,6 +405,19 @@ with
name = this.name
churchId = this.churchId
}
module EditSmallGroup =
/// Create an instance from an existing small group
let fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId
name = g.name
churchId = g.churchId
}
/// An empty instance (used when adding a new group)
let empty =
{ smallGroupId = Guid.Empty
name = ""
churchId = Guid.Empty
}
/// Form for the user edit page
@@ -421,25 +439,6 @@ type EditUser =
isAdmin : bool option
}
with
/// An empty instance
static member empty =
{ userId = Guid.Empty
firstName = ""
lastName = ""
emailAddress = ""
password = ""
passwordConfirm = ""
isAdmin = None
}
/// Create an instance from an existing user
static member fromUser (user : User) =
{ EditUser.empty with
userId = user.userId
firstName = user.firstName
lastName = user.lastName
emailAddress = user.emailAddress
isAdmin = match user.isAdmin with true -> Some true | false -> None
}
/// Is this a new user?
member this.isNew () = Guid.Empty = this.userId
/// Populate a user from the form
@@ -451,8 +450,28 @@ with
isAdmin = match this.isAdmin with Some x -> x | None -> false
}
|> function
| u when this.password = null || this.password = "" -> u
| u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password }
module EditUser =
/// An empty instance
let empty =
{ userId = Guid.Empty
firstName = ""
lastName = ""
emailAddress = ""
password = ""
passwordConfirm = ""
isAdmin = None
}
/// Create an instance from an existing user
let fromUser (user : User) =
{ empty with
userId = user.userId
firstName = user.firstName
lastName = user.lastName
emailAddress = user.emailAddress
isAdmin = match user.isAdmin with true -> Some true | false -> None
}
/// Form for the small group log on page
@@ -465,20 +484,47 @@ type GroupLogOn =
/// Whether to remember the login
rememberMe : bool option
}
with
static member empty =
module GroupLogOn =
/// An empty instance
let empty =
{ smallGroupId = Guid.Empty
password = ""
rememberMe = None
}
/// Items needed to display the request maintenance page
[<NoComparison; NoEquality>]
type MaintainRequests =
{ /// The requests to be displayed
requests : PrayerRequest seq
/// The small group to which the requests belong
smallGroup : SmallGroup
/// Whether only active requests are included
onlyActive : bool option
/// The search term for the requests
searchTerm : string option
/// The page number of the results
pageNbr : int option
}
module MaintainRequests =
/// An empty instance
let empty =
{ requests = Seq.empty
smallGroup = SmallGroup.empty
onlyActive = None
searchTerm = None
pageNbr = None
}
/// Items needed to display the small group overview page
[<NoComparison; NoEquality>]
type Overview =
{ /// The total number of active requests
totalActiveReqs : int
/// The numbers of active requests by category
activeReqsByCat : Map<string, int>
activeReqsByCat : Map<PrayerRequestType, int>
/// A count of all requests
allReqs : int
/// A count of all members
@@ -500,8 +546,9 @@ type UserLogOn =
/// The URL to which the user should be redirected once login is successful
redirectUrl : string option
}
with
static member empty =
module UserLogOn =
/// An empty instance
let empty =
{ emailAddress = ""
password = ""
smallGroupId = Guid.Empty
@@ -510,7 +557,7 @@ with
}
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
/// This represents a list of requests
type RequestList =
@@ -535,29 +582,30 @@ with
|> Seq.ofList
|> Seq.filter (fun req -> req.requestType = cat)
match this.listGroup.preferences.requestSort with
| "D" -> reqs |> Seq.sortByDescending (fun req -> req.updatedDate)
| _ -> reqs |> Seq.sortBy (fun req -> req.requestor)
| SortByDate -> reqs |> Seq.sortByDescending (fun req -> req.updatedDate)
| SortByRequestor -> reqs |> Seq.sortBy (fun req -> req.requestor)
|> List.ofSeq
/// Is this request new?
member this.isNew (req : PrayerRequest) =
(this.date - req.updatedDate).Days <= this.listGroup.preferences.daysToKeepNew
/// Generate this list as HTML
member this.asHtml (s : IStringLocalizer) =
let prefs = this.listGroup.preferences
let prefs = this.listGroup.preferences
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2)
[ match this.showHeader with
| true ->
yield div [ _style (sprintf "text-align:center;font-family:%s" prefs.listFonts) ] [
span [ _style (sprintf "font-size:%ipt;" prefs.headingFontSize) ] [
div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [
span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
strong [] [ str s.["Prayer Requests"].Value ]
]
br []
span [ _style (sprintf "font-size:%ipt;" prefs.textFontSize) ] [
span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
strong [] [ str this.listGroup.name ]
br []
str (this.date.ToString s.["MMMM d, yyyy"].Value)
]
]
yield br []
br []
| false -> ()
let typs = ReferenceList.requestTypeList s
for cat in
@@ -567,42 +615,51 @@ with
|> Seq.filter (fun c -> 0 < (this.requests |> List.filter (fun req -> req.requestType = c) |> List.length)) do
let reqs = this.requestsInCategory cat
let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd
yield div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style (sprintf "font-family:%s;page-break-inside:avoid;" prefs.listFonts) ] [
div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [
tr [] [
td [ _style (sprintf "font-size:%ipt;color:%s;padding:3px 0;border-top:solid 3px %s;border-bottom:solid 3px %s;font-weight:bold;"
prefs.headingFontSize prefs.headingColor prefs.lineColor prefs.lineColor) ] [
td [ _style $"font-size:%i{prefs.headingFontSize}pt;color:{prefs.headingColor};padding:3px 0;border-top:solid 3px {prefs.lineColor};border-bottom:solid 3px {prefs.lineColor};font-weight:bold;" ] [
rawText "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; "
]
]
]
]
yield
reqs
|> List.map (fun req ->
let bullet = match this.isNew req with true -> "circle" | false -> "disc"
li [ _style (sprintf "list-style-type:%s;font-family:%s;font-size:%ipt;padding-bottom:.25em;"
bullet prefs.listFonts prefs.textFontSize) ] [
match req.requestor with
| Some rqstr when rqstr <> "" ->
yield strong [] [ str rqstr ]
yield rawText " &mdash; "
| Some _ -> ()
| None -> ()
yield rawText req.text
])
reqs
|> List.map (fun req ->
let bullet = match this.isNew req with true -> "circle" | false -> "disc"
li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [
match req.requestor with
| Some rqstr when rqstr <> "" ->
strong [] [ str rqstr ]
rawText " &mdash; "
| Some _ -> ()
| None -> ()
rawText req.text
match prefs.asOfDateDisplay with
| NoDisplay -> ()
| ShortDate
| LongDate ->
let dt =
match prefs.asOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString ()
| _ -> ""
i [ _style $"font-size:%.2f{asOfSize}pt" ] [
rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")"
]
])
|> ul []
yield br []
br []
]
|> renderHtmlNodes
|> RenderView.AsString.htmlNodes
/// Generate this list as plain text
member this.asText (s : IStringLocalizer) =
seq {
yield this.listGroup.name
yield s.["Prayer Requests"].Value
yield this.date.ToString s.["MMMM d, yyyy"].Value
yield " "
this.listGroup.name
s.["Prayer Requests"].Value
this.date.ToString s.["MMMM d, yyyy"].Value
" "
let typs = ReferenceList.requestTypeList s
for cat in
typs
@@ -612,14 +669,23 @@ with
let reqs = this.requestsInCategory cat
let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value
let dashes = String.replicate (typ.Length + 4) "-"
yield dashes
yield sprintf @" %s" (typ.ToUpper ())
yield dashes
dashes
$" {typ.ToUpper ()}"
dashes
for req in reqs do
let bullet = match this.isNew req with true -> "+" | false -> "-"
let requestor = match req.requestor with Some r -> sprintf "%s - " r | None -> ""
yield sprintf " %s %s%s" bullet requestor (htmlToPlainText req.text)
yield " "
match this.listGroup.preferences.asOfDateDisplay with
| NoDisplay -> ""
| _ ->
let dt =
match this.listGroup.preferences.asOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString ()
| _ -> ""
$""" ({s.["as of"].Value} {dt})"""
|> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text)
" "
}
|> String.concat "\n"
|> wordWrap 74

View File

@@ -1,7 +1,7 @@

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 15
VisualStudioVersion = 15.0.26228.4
# Visual Studio Version 17
VisualStudioVersion = 17.2.32630.192
MinimumVisualStudioVersion = 10.0.40219.1
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTracker\PrayerTracker.fsproj", "{63780D3F-D811-4BFB-9FB0-C28A83CCE28F}"
EndProject
@@ -11,6 +11,12 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "Pray
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "PrayerTracker.Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}"
EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B290BA27-C8B8-44F3-BF01-D103302D815F}"
ProjectSection(SolutionItems) = preProject
Directory.Build.props = Directory.Build.props
Publish-App.ps1 = Publish-App.ps1
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU

View File

@@ -0,0 +1,12 @@
{
"version": 1,
"isRoot": true,
"tools": {
"dotnet-ef": {
"version": "3.1.2",
"commands": [
"dotnet-ef"
]
}
}
}

View File

@@ -9,12 +9,13 @@ module Configure =
open Cookies
open Giraffe
open Giraffe.TokenRouter
open Giraffe.EndpointRouting
open Microsoft.AspNetCore.Localization
open Microsoft.AspNetCore.Server.Kestrel.Core
open Microsoft.EntityFrameworkCore
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Localization
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Options
@@ -25,7 +26,7 @@ module Configure =
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName, optional = true)
.AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
.AddEnvironmentVariables()
|> ignore
@@ -48,104 +49,110 @@ module Configure =
.AddDistributedMemoryCache()
.AddSession()
.AddAntiforgery()
.AddRouting()
.AddSingleton<IClock>(SystemClock.Instance)
|> ignore
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let crypto = config.GetSection "CookieCrypto"
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
svc.AddDbContext<AppDbContext>(
fun options ->
options.UseNpgsql(config.GetConnectionString "PrayerTracker") |> ignore)
(fun options ->
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|> ignore
/// Routes for PrayerTracker
let webApp =
router Handlers.CommonFunctions.fourOhFour [
GET [
subRoute "/church" [
route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit
let routes =
[ subRoute "/web" [
GET_HEAD [
subRoute "/church" [
route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit
]
route "/class/logon" (redirectTo true "/web/small-group/log-on")
routef "/error/%s" Handlers.Home.error
routef "/language/%s" Handlers.Home.language
subRoute "/legal" [
route "/privacy-policy" Handlers.Home.privacyPolicy
route "/terms-of-service" Handlers.Home.tos
]
route "/log-off" Handlers.Home.logOff
subRoute "/prayer-request" [
route "s" (Handlers.PrayerRequest.maintain true)
routef "s/email/%s" Handlers.PrayerRequest.email
route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/lists" Handlers.PrayerRequest.lists
routef "s/%O/list" Handlers.PrayerRequest.list
route "s/maintain" (redirectTo true "/web/prayer-requests")
routef "s/print/%s" Handlers.PrayerRequest.print
route "s/view" (Handlers.PrayerRequest.view None)
routef "s/view/%s" (Some >> Handlers.PrayerRequest.view)
routef "/%O/edit" Handlers.PrayerRequest.edit
routef "/%O/expire" Handlers.PrayerRequest.expire
routef "/%O/restore" Handlers.PrayerRequest.restore
]
subRoute "/small-group" [
route "" Handlers.SmallGroup.overview
route "s" Handlers.SmallGroup.maintain
route "/announcement" Handlers.SmallGroup.announcement
routef "/%O/edit" Handlers.SmallGroup.edit
route "/log-on" (Handlers.SmallGroup.logOn None)
routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn)
route "/logon" (redirectTo true "/web/small-group/log-on")
routef "/member/%O/edit" Handlers.SmallGroup.editMember
route "/members" Handlers.SmallGroup.members
route "/preferences" Handlers.SmallGroup.preferences
]
route "/unauthorized" Handlers.Home.unauthorized
subRoute "/user" [
route "s" Handlers.User.maintain
routef "/%O/edit" Handlers.User.edit
routef "/%O/small-groups" Handlers.User.smallGroups
route "/log-on" Handlers.User.logOn
route "/logon" (redirectTo true "/web/user/log-on")
route "/password" Handlers.User.password
]
route "/" Handlers.Home.homePage
]
route "/class/logon" (redirectTo true "/small-group/log-on")
routef "/error/%s" Handlers.Home.error
routef "/language/%s" Handlers.Home.language
subRoute "/legal" [
route "/privacy-policy" Handlers.Home.privacyPolicy
route "/terms-of-service" Handlers.Home.tos
]
route "/log-off" Handlers.Home.logOff
subRoute "/prayer-request" [
route "s" (Handlers.PrayerRequest.maintain true)
routef "s/email/%s" Handlers.PrayerRequest.email
route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/lists" Handlers.PrayerRequest.lists
routef "s/%O/list" Handlers.PrayerRequest.list
route "s/maintain" (redirectTo true "/prayer-requests")
routef "s/print/%s" Handlers.PrayerRequest.print
route "s/view" (Handlers.PrayerRequest.view None)
routef "s/view/%s" (Some >> Handlers.PrayerRequest.view)
routef "/%O/edit" Handlers.PrayerRequest.edit
routef "/%O/expire" Handlers.PrayerRequest.expire
routef "/%O/restore" Handlers.PrayerRequest.restore
]
subRoute "/small-group" [
route "" Handlers.SmallGroup.overview
route "s" Handlers.SmallGroup.maintain
route "/announcement" Handlers.SmallGroup.announcement
routef "/%O/edit" Handlers.SmallGroup.edit
route "/log-on" (Handlers.SmallGroup.logOn None)
routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn)
route "/logon" (redirectTo true "/small-group/log-on")
routef "/member/%O/edit" Handlers.SmallGroup.editMember
route "/members" Handlers.SmallGroup.members
route "/preferences" Handlers.SmallGroup.preferences
]
route "/unauthorized" Handlers.Home.unauthorized
subRoute "/user" [
route "s" Handlers.User.maintain
routef "/%O/edit" Handlers.User.edit
routef "/%O/small-groups" Handlers.User.smallGroups
route "/log-on" Handlers.User.logOn
route "/logon" (redirectTo true "/user/log-on")
route "/password" Handlers.User.password
]
route "/" Handlers.Home.homePage
]
POST [
subRoute "/church" [
routef "/%O/delete" Handlers.Church.delete
route "/save" Handlers.Church.save
]
subRoute "/prayer-request" [
routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.PrayerRequest.save
]
subRoute "/small-group" [
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
routef "/%O/delete" Handlers.SmallGroup.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
routef "/member/%O/delete" Handlers.SmallGroup.deleteMember
route "/member/save" Handlers.SmallGroup.saveMember
route "/preferences/save" Handlers.SmallGroup.savePreferences
route "/save" Handlers.SmallGroup.save
]
subRoute "/user" [
routef "/%O/delete" Handlers.User.delete
route "/edit/save" Handlers.User.save
route "/log-on" Handlers.User.doLogOn
route "/password/change" Handlers.User.changePassword
route "/small-groups/save" Handlers.User.saveGroups
POST [
subRoute "/church" [
routef "/%O/delete" Handlers.Church.delete
route "/save" Handlers.Church.save
]
subRoute "/prayer-request" [
routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.PrayerRequest.save
]
subRoute "/small-group" [
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
routef "/%O/delete" Handlers.SmallGroup.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
routef "/member/%O/delete" Handlers.SmallGroup.deleteMember
route "/member/save" Handlers.SmallGroup.saveMember
route "/preferences/save" Handlers.SmallGroup.savePreferences
route "/save" Handlers.SmallGroup.save
]
subRoute "/user" [
routef "/%O/delete" Handlers.User.delete
route "/edit/save" Handlers.User.save
route "/log-on" Handlers.User.doLogOn
route "/password/change" Handlers.User.changePassword
route "/small-groups/save" Handlers.User.saveGroups
]
]
]
// Temp redirect to new URLs
route "/" (redirectTo false "/web/")
]
/// Giraffe error handler
let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> text ex.Message
/// Configure logging
let logging (log : ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IHostingEnvironment> ()
let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> ()
match env.IsDevelopment () with
| true -> log
| false -> log.AddFilter (fun l -> l > LogLevel.Information)
@@ -153,8 +160,7 @@ module Configure =
|> ignore
let app (app : IApplicationBuilder) =
let env = app.ApplicationServices.GetRequiredService<IHostingEnvironment>()
let log = app.ApplicationServices.GetRequiredService<ILoggerFactory>()
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
(match env.IsDevelopment () with
| true ->
app.UseDeveloperExceptionPage ()
@@ -166,9 +172,10 @@ module Configure =
app.UseGiraffeErrorHandler errorHandler)
.UseStatusCodePagesWithReExecute("/error/{0}")
.UseStaticFiles()
.UseRouting()
.UseSession()
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
.UseGiraffe(webApp)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
|> ignore
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()

View File

@@ -1,6 +1,5 @@
module PrayerTracker.Handlers.Church
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open PrayerTracker
open PrayerTracker.Entities
@@ -10,105 +9,90 @@ open System
open System.Threading.Tasks
/// Find statistics for the given church
let private findStats (db : AppDbContext) churchId =
task {
let! grps = db.CountGroupsByChurch churchId
let! reqs = db.CountRequestsByChurch churchId
let! usrs = db.CountUsersByChurch churchId
return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs }
}
let private findStats (db : AppDbContext) churchId = task {
let! grps = db.CountGroupsByChurch churchId
let! reqs = db.CountRequestsByChurch churchId
let! usrs = db.CountUsersByChurch churchId
return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs }
}
/// POST /church/[church-id]/delete
let delete churchId : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
let db = ctx.dbContext ()
task {
let! church = db.TryChurchById churchId
match church with
| Some ch ->
let! _, stats = findStats db churchId
db.RemoveEntry ch
let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
ch.name, stats.smallGroups, stats.prayerRequests, stats.users]
return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour next ctx
}
>=> fun next ctx -> task {
match! ctx.db.TryChurchById churchId with
| Some church ->
let! _, stats = findStats ctx.db churchId
ctx.db.RemoveEntry church
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.name, stats.smallGroups, stats.prayerRequests, stats.users]
return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx
}
/// GET /church/[church-id]/edit
let edit churchId : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
match churchId with
| x when x = Guid.Empty ->
return!
viewInfo ctx startTicks
|> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx
| _ ->
let db = ctx.dbContext ()
let! church = db.TryChurchById churchId
match church with
| Some ch ->
return!
viewInfo ctx startTicks
|> Views.Church.edit (EditChurch.fromChurch ch) ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
match churchId with
| x when x = Guid.Empty ->
return!
viewInfo ctx startTicks
|> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx
| _ ->
match! ctx.db.TryChurchById churchId with
| Some church ->
return!
viewInfo ctx startTicks
|> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
/// GET /churches
let maintain : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
task {
let! churches = db.AllChurches ()
let! stats =
churches
|> Seq.ofList
|> Seq.map (fun c -> findStats db c.churchId)
|> Task.WhenAll
return!
viewInfo ctx startTicks
|> Views.Church.maintain churches (stats |> Map.ofArray) ctx
|> renderHtml next ctx
}
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let await = Async.AwaitTask >> Async.RunSynchronously
let! churches = ctx.db.AllChurches ()
let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId))
return!
viewInfo ctx startTicks
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|> renderHtml next ctx
}
/// POST /church/save
let save : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<EditChurch> ()
match result with
| Ok m ->
let db = ctx.dbContext ()
let! church =
match m.isNew () with
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () })
| false -> db.TryChurchById m.churchId
match church with
| Some ch ->
m.populateChurch ch
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m ->
let! church =
match m.isNew () with
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () })
| false -> ctx.db.TryChurchById m.churchId
match church with
| Some ch ->
m.populateChurch ch
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}

View File

@@ -2,7 +2,6 @@
[<AutoOpen>]
module PrayerTracker.Handlers.CommonFunctions
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
@@ -24,7 +23,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
[ match withDefault with
| true ->
let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem (sprintf "&mdash; %A &mdash;" s.[emptyText], "")
yield SelectListItem ($"""&mdash; %A{s.[emptyText]} &mdash;""", "")
| _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
]
@@ -41,44 +40,36 @@ let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) =
let appVersion =
let v = Assembly.GetExecutingAssembly().GetName().Version
#if (DEBUG)
sprintf "v%A" v
$"v{v}"
#else
seq {
yield sprintf "v%d" v.Major
$"v%d{v.Major}"
match v.Minor with
| 0 -> match v.Build with 0 -> () | _ -> yield sprintf ".0.%d" v.Build
| 0 -> match v.Build with 0 -> () | _ -> $".0.%d{v.Build}"
| _ ->
yield sprintf ".%d" v.Minor
match v.Build with 0 -> () | _ -> yield sprintf ".%d" v.Build
$".%d{v.Minor}"
match v.Build with 0 -> () | _ -> $".%d{v.Build}"
}
|> String.concat ""
#endif
/// An option of the currently signed-in user
let tryCurrentUser (ctx : HttpContext) =
ctx.Session.GetUser ()
/// The currently signed-in user (will raise if none exists)
let currentUser ctx =
match tryCurrentUser ctx with Some u -> u | None -> nullArg "User"
/// An option of the currently signed-in small group
let tryCurrentGroup (ctx : HttpContext) =
ctx.Session.GetSmallGroup ()
let currentUser (ctx : HttpContext) =
match ctx.Session.user with Some u -> u | None -> nullArg "User"
/// The currently signed-in small group (will raise if none exists)
let currentGroup ctx =
match tryCurrentGroup ctx with Some g -> g | None -> nullArg "SmallGroup"
let currentGroup (ctx : HttpContext) =
match ctx.Session.smallGroup with Some g -> g | None -> nullArg "SmallGroup"
/// Create the common view information heading
let viewInfo (ctx : HttpContext) startTicks =
let msg =
match ctx.Session.GetMessages () with
match ctx.Session.messages with
| [] -> []
| x ->
ctx.Session.SetMessages []
ctx.Session.messages <- []
x
match tryCurrentUser ctx with
match ctx.Session.user with
| Some u ->
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the
// user back in transparently using this cookie. Every request resets the timer.
@@ -96,8 +87,8 @@ let viewInfo (ctx : HttpContext) startTicks =
version = appVersion
messages = msg
requestStart = startTicks
user = ctx.Session.GetUser ()
group = ctx.Session.GetSmallGroup ()
user = ctx.Session.user
group = ctx.Session.smallGroup
}
/// The view is the last parameter, so it can be composed
@@ -118,20 +109,17 @@ let fourOhFour next (ctx : HttpContext) =
/// Handler to validate CSRF prevention token
let validateCSRF : HttpHandler =
fun next ctx ->
let antiForgery = ctx.GetService<IAntiforgery> ()
task {
let! isValid = antiForgery.IsRequestValidAsync ctx
match isValid with
| true -> return! next ctx
| false ->
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
}
fun next ctx -> task {
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
| true -> return! next ctx
| false ->
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
}
/// Add a message to the session
let addUserMessage (ctx : HttpContext) msg =
msg :: ctx.Session.GetMessages () |> ctx.Session.SetMessages
ctx.Session.messages <- msg :: ctx.Session.messages
/// Convert a localized string to an HTML string
let htmlLocString (x : LocalizedString) =
@@ -142,19 +130,19 @@ let htmlString (x : LocalizedString) =
/// Add an error message to the session
let addError ctx msg =
addUserMessage ctx { UserMessage.Error with text = htmlLocString msg }
addUserMessage ctx { UserMessage.error with text = htmlLocString msg }
/// Add an informational message to the session
let addInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlLocString msg }
addUserMessage ctx { UserMessage.info with text = htmlLocString msg }
/// Add an informational HTML message to the session
let addHtmlInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlString msg }
addUserMessage ctx { UserMessage.info with text = htmlString msg }
/// Add a warning message to the session
let addWarning ctx msg =
addUserMessage ctx { UserMessage.Warning with text = htmlLocString msg }
addUserMessage ctx { UserMessage.warning with text = htmlLocString msg }
/// A level of required access
@@ -174,99 +162,94 @@ let requireAccess level : HttpHandler =
/// Is there currently a user logged on?
let isUserLoggedOn (ctx : HttpContext) =
ctx.Session.GetUser () |> Option.isSome
ctx.Session.user |> Option.isSome
/// Log a user on from the timeout cookie
let logOnUserFromTimeoutCookie (ctx : HttpContext) =
task {
// Make sure the cookie hasn't been tampered with
try
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with
| Some c when c.Password = saltedTimeoutHash c ->
let db = ctx.dbContext ()
let! user = db.TryUserById c.Id
match user with
| Some _ ->
ctx.Session.SetUser user
let! grp = db.TryGroupById c.GroupId
ctx.Session.SetSmallGroup grp
| _ -> ()
| _ -> ()
// If something above doesn't work, the user doesn't get logged in
with _ -> ()
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task {
// Make sure the cookie hasn't been tampered with
try
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with
| Some c when c.Password = saltedTimeoutHash c ->
let! user = ctx.db.TryUserById c.Id
match user with
| Some _ ->
ctx.Session.user <- user
let! grp = ctx.db.TryGroupById c.GroupId
ctx.Session.smallGroup <- grp
| _ -> ()
| _ -> ()
// If something above doesn't work, the user doesn't get logged in
with _ -> ()
}
/// Attempt to log the user on from their stored cookie
let logOnUserFromCookie (ctx : HttpContext) =
task {
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
| Some c ->
let db = ctx.dbContext ()
let! user = db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
match user with
| Some _ ->
ctx.Session.SetUser user
let! grp = db.TryGroupById c.GroupId
ctx.Session.SetSmallGroup grp
// Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
| _ -> ()
| _ -> ()
}
let logOnUserFromCookie (ctx : HttpContext) = task {
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
| Some c ->
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
match user with
| Some _ ->
ctx.Session.user <- user
let! grp = ctx.db.TryGroupById c.GroupId
ctx.Session.smallGroup <- grp
// Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
| _ -> ()
| _ -> ()
}
/// Is there currently a small group (or member thereof) logged on?
let isGroupLoggedOn (ctx : HttpContext) =
ctx.Session.GetSmallGroup () |> Option.isSome
ctx.Session.smallGroup |> Option.isSome
/// Attempt to log the small group on from their stored cookie
let logOnGroupFromCookie (ctx : HttpContext) =
task {
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
| Some c ->
let! grp = (ctx.dbContext ()).TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
match grp with
| Some _ ->
ctx.Session.SetSmallGroup grp
ctx.Session.smallGroup <- grp
// Rewrite the cookie to extend the expiration
ctx.Response.Cookies.Append (Key.Cookie.group, c.toPayload (), autoRefresh)
| None -> ()
| None -> ()
}
fun next ctx ->
task {
// Auto-logon user or class, if required
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromTimeoutCookie ctx
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromCookie ctx
match isGroupLoggedOn ctx with true -> () | false -> do! logOnGroupFromCookie ctx
fun next ctx -> FSharp.Control.Tasks.Affine.task {
// Auto-logon user or class, if required
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromTimeoutCookie ctx
match isUserLoggedOn ctx with
| true -> ()
| false ->
do! logOnUserFromCookie ctx
match isGroupLoggedOn ctx with true -> () | false -> do! logOnGroupFromCookie ctx
match true with
| _ when level |> List.contains Public -> return! next ctx
| _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Admin && isUserLoggedOn ctx ->
match (currentUser ctx).isAdmin with
| true -> return! next ctx
| false ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx
| _ when level |> List.contains User ->
// Redirect to the user log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/user/log-on" next ctx
| _ when level |> List.contains Group ->
// Redirect to the small group log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/small-group/log-on" next ctx
| _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx
}
match true with
| _ when level |> List.contains Public -> return! next ctx
| _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx
| _ when level |> List.contains Admin && isUserLoggedOn ctx ->
match (currentUser ctx).isAdmin with
| true -> return! next ctx
| false ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/web/unauthorized" next ctx
| _ when level |> List.contains User ->
// Redirect to the user log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/web/user/log-on" next ctx
| _ when level |> List.contains Group ->
// Redirect to the small group log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/web/small-group/log-on" next ctx
| _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/web/unauthorized" next ctx
}

View File

@@ -6,6 +6,7 @@ open System
open System.Security.Cryptography
open System.IO
// fsharplint:disable MemberNames
/// Cryptography settings to use for encrypting cookies
type CookieCrypto (key : string, iv : string) =
@@ -24,7 +25,7 @@ module private Crypto =
/// Encrypt a cookie payload
let encrypt (payload : string) =
use aes = new AesManaged ()
use aes = Aes.Create ()
use enc = aes.CreateEncryptor (crypto.Key, crypto.IV)
use ms = new MemoryStream ()
use cs = new CryptoStream (ms, enc, CryptoStreamMode.Write)
@@ -35,7 +36,7 @@ module private Crypto =
/// Decrypt a cookie payload
let decrypt payload =
use aes = new AesManaged ()
use aes = Aes.Create ()
use dec = aes.CreateDecryptor (crypto.Key, crypto.IV)
use ms = new MemoryStream (Convert.FromBase64String payload)
use cs = new CryptoStream (ms, dec, CryptoStreamMode.Read)
@@ -121,7 +122,7 @@ type UserCookie =
/// Create a salted hash to use to validate the idle timeout key
let saltedTimeoutHash (c : TimeoutCookie) =
sha1Hash (sprintf "Prayer%ATracker%AIdle%dTimeout" c.Id c.GroupId c.Until)
sha1Hash $"Prayer%A{c.Id}Tracker%A{c.GroupId}Idle%d{c.Until}Timeout"
/// Cookie options to push an expiration out by 100 days
let autoRefresh =

View File

@@ -1,26 +1,23 @@
/// Methods for sending e-mails
module PrayerTracker.Email
open FSharp.Control.Tasks.ContextInsensitive
open MailKit.Net.Smtp
open MailKit.Security
open Microsoft.Extensions.Localization
open MimeKit
open MimeKit.Text
open PrayerTracker.Entities
open System
/// The e-mail address from which e-mail is sent (must match Google account)
let private fromAddress = "prayer@djs-consulting.com"
/// The e-mail address from which e-mail is sent
let private fromAddress = "prayer@bitbadger.solutions"
/// Get an SMTP client connection
// FIXME: make host configurable
let getConnection () =
task {
let client = new SmtpClient ()
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
return client
}
let getConnection () = task {
let client = new SmtpClient ()
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
return client
}
/// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj =
@@ -33,9 +30,9 @@ let createMessage (grp : SmallGroup) subj =
/// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) =
let bodyText =
[ @"<!DOCTYPE html><html xmlns=""http://www.w3.org/1999/xhtml""><head><title></title></head><body>"
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
body
@"<hr><div style=""text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;"">"
"""<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
s.["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>"
s.["from Bit Badger Solutions"].Value
@@ -61,24 +58,20 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
msg
/// Send e-mails to a class
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s =
task {
let htmlMsg = createHtmlMessage grp subj html s
let plainTextMsg = createTextMessage grp subj text s
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
let htmlMsg = createHtmlMessage grp subj html s
let plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do
let emailType = match mbr.format with Some f -> f | None -> grp.preferences.defaultEmailType
let emailTo = MailboxAddress (mbr.memberName, mbr.email)
match emailType with
| EmailType.Html ->
htmlMsg.To.Add emailTo
do! client.SendAsync htmlMsg
htmlMsg.To.Clear ()
| EmailType.PlainText ->
plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg
plainTextMsg.To.Clear ()
| EmailType.AttachedPdf ->
raise <| NotImplementedException "Attached PDF format has not been implemented"
| _ -> invalidOp <| sprintf "Unknown e-mail type %s passed" emailType
}
for mbr in recipients do
let emailType = match mbr.format with Some f -> EmailFormat.fromCode f | None -> grp.preferences.defaultEmailType
let emailTo = MailboxAddress (mbr.memberName, mbr.email)
match emailType with
| HtmlFormat ->
htmlMsg.To.Add emailTo
do! client.SendAsync htmlMsg
htmlMsg.To.Clear ()
| PlainTextFormat ->
plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg
plainTextMsg.To.Clear ()
}

View File

@@ -2,11 +2,13 @@
module PrayerTracker.Extensions
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.FSharpLu
open Newtonsoft.Json
open PrayerTracker.Entities
open PrayerTracker.ViewModels
// fsharplint:disable MemberNames
type ISession with
/// Set an object in the session
@@ -19,28 +21,32 @@ type ISession with
| null -> Unchecked.defaultof<'T>
| v -> JsonConvert.DeserializeObject<'T> v
member this.GetSmallGroup () =
this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
member this.SetSmallGroup (group : SmallGroup option) =
match group with
| Some g -> this.SetObject Key.Session.currentGroup g
| None -> this.Remove Key.Session.currentGroup
/// The current small group for the session
member this.smallGroup
with get () = this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
and set (v : SmallGroup option) =
match v with
| Some group -> this.SetObject Key.Session.currentGroup group
| None -> this.Remove Key.Session.currentGroup
member this.GetUser () =
this.GetObject<User> Key.Session.currentUser |> Option.fromObject
member this.SetUser (user: User option) =
match user with
| Some u -> this.SetObject Key.Session.currentUser u
| None -> this.Remove Key.Session.currentUser
/// The current user for the session
member this.user
with get () = this.GetObject<User> Key.Session.currentUser |> Option.fromObject
and set (v : User option) =
match v with
| Some user -> this.SetObject Key.Session.currentUser user
| None -> this.Remove Key.Session.currentUser
member this.GetMessages () =
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with
| null -> List.empty<UserMessage>
| msgs -> unbox msgs
member this.SetMessages (messages : UserMessage list) =
this.SetObject Key.Session.userMessages messages
/// Current messages for the session
member this.messages
with get () =
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with
| null -> List.empty<UserMessage>
| msgs -> unbox msgs
and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
type HttpContext with
/// Get the EF database context from DI
member this.dbContext () : AppDbContext = downcast this.RequestServices.GetService typeof<AppDbContext>
/// The EF Core database context (via DI)
member this.db
with get () = this.RequestServices.GetRequiredService<AppDbContext> ()

View File

@@ -35,7 +35,7 @@ let language culture : HttpHandler =
| ""
| "en" -> "en-US"
| "es" -> "es-MX"
| _ -> sprintf "%s-%s" culture (culture.ToUpper ())
| _ -> $"{culture}-{culture.ToUpper ()}"
|> (CultureInfo >> Option.ofObj)
with
| :? CultureNotFoundException
@@ -47,7 +47,7 @@ let language culture : HttpHandler =
CookieRequestCultureProvider.MakeCookieValue (RequestCulture c),
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.Now.AddYears 1))))
| _ -> ()
let url = match string ctx.Request.Headers.["Referer"] with null | "" -> "/" | r -> r
let url = match string ctx.Request.Headers.["Referer"] with null | "" -> "/web/" | r -> r
redirectTo false url next ctx
@@ -78,7 +78,7 @@ let logOff : HttpHandler =
Key.Cookie.logOffCookies |> List.iter ctx.Response.Cookies.Delete
let s = Views.I18N.localizer.Force ()
addHtmlInfo ctx s.["Log Off Successful Have a nice day!"]
redirectTo false "/" next ctx
redirectTo false "/web/" next ctx
/// GET /unauthorized

View File

@@ -1,6 +1,5 @@
module PrayerTracker.Handlers.PrayerRequest
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
@@ -11,17 +10,15 @@ open System
open System.Threading.Tasks
/// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId =
task {
let! req = ctx.dbContext().TryRequestById reqId
match req with
| Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"]
return Error (redirectTo false "/unauthorized")
| None -> return Error fourOhFour
}
let private findRequest (ctx : HttpContext) reqId = task {
match! ctx.db.TryRequestById reqId with
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"]
return Error (redirectTo false "/web/unauthorized")
| None -> return Error fourOhFour
}
/// Generate a list of requests for the given date
let private generateRequestList ctx date =
@@ -31,12 +28,12 @@ let private generateRequestList ctx date =
match date with
| Some d -> d
| None -> grp.localDateNow clock
let reqs = ctx.dbContext().AllRequestsForSmallGroup grp clock (Some listDate) true
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
{ requests = reqs |> List.ofSeq
date = listDate
listGroup = grp
showHeader = true
canEmail = tryCurrentUser ctx |> Option.isSome
canEmail = ctx.Session.user |> Option.isSome
recipients = []
}
@@ -50,238 +47,230 @@ let private parseListDate (date : string option) =
/// GET /prayer-request/[request-id]/edit
let edit (reqId : PrayerRequestId) : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ())
task {
match reqId = Guid.Empty with
| true ->
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx
| false ->
let! result = findRequest ctx reqId
match result with
| Ok req ->
let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with
| true ->
{ UserMessage.Warning with
text = htmlLocString s.["This request is expired."]
description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
s.["Expire Immediately"], s.["Check to not update the date"]]
|> (htmlLocString >> Some)
}
|> addUserMessage ctx
| false -> ()
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|> renderHtml next ctx
| Error e -> return! e next ctx
}
match reqId = Guid.Empty with
| true ->
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx
| false ->
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with
| true ->
{ UserMessage.warning with
text = htmlLocString s.["This request is expired."]
description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
s.["Expire Immediately"], s.["Check to not update the date"]]
|> (htmlLocString >> Some)
}
|> addUserMessage ctx
| false -> ()
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|> renderHtml next ctx
| Error e -> return! e next ctx
}
/// GET /prayer-requests/email/[date]
let email date : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let listDate = parseListDate (Some date)
let grp = currentGroup ctx
task {
let list = generateRequestList ctx listDate
let! recipients = ctx.dbContext().AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
(list.asHtml s) (list.asText s) s
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.email { list with recipients = recipients }
|> renderHtml next ctx
}
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let listDate = parseListDate (Some date)
let grp = currentGroup ctx
let list = generateRequestList ctx listDate
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
(list.asHtml s) (list.asText s) s
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.email { list with recipients = recipients }
|> renderHtml next ctx
}
/// POST /prayer-request/[request-id]/delete
let delete reqId : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = findRequest ctx reqId
match result with
| Ok r ->
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
db.PrayerRequests.Remove r |> ignore
let! _ = db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"]
return! redirectTo false "/prayer-requests" next ctx
| Error e -> return! e next ctx
}
>=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.PrayerRequests.Remove req |> ignore
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
}
/// GET /prayer-request/[request-id]/expire
let expire reqId : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
task {
let! result = findRequest ctx reqId
match result with
| Ok r ->
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with isManuallyExpired = true }
let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Error e -> return! e next ctx
}
>=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Forced }
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
}
/// GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
task {
let! grp = db.TryGroupById groupId
match grp with
| Some g when g.preferences.isPublic ->
let clock = ctx.GetService<IClock> ()
let reqs = db.AllRequestsForSmallGroup g clock None true
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.list
{ requests = List.ofSeq reqs
date = g.localDateNow clock
listGroup = g
showHeader = true
canEmail = (tryCurrentUser >> Option.isSome) ctx
recipients = []
}
|> renderHtml next ctx
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["The request list for the group you tried to view is not public."]
return! redirectTo false "/unauthorized" next ctx
| None -> return! fourOhFour next ctx
}
match! ctx.db.TryGroupById groupId with
| Some grp when grp.preferences.isPublic ->
let clock = ctx.GetService<IClock> ()
let reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.list
{ requests = List.ofSeq reqs
date = grp.localDateNow clock
listGroup = grp
showHeader = true
canEmail = ctx.Session.user |> Option.isSome
recipients = []
}
|> renderHtml next ctx
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["The request list for the group you tried to view is not public."]
return! redirectTo false "/web/unauthorized" next ctx
| None -> return! fourOhFour next ctx
}
/// GET /prayer-requests/lists
let lists : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.dbContext().PublicAndProtectedGroups ()
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.lists grps
|> renderHtml next ctx
}
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.PublicAndProtectedGroups ()
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.lists grps
|> renderHtml next ctx
}
/// GET /prayer-requests[/inactive?]
/// - OR -
/// GET /prayer-requests?search=[search-query]
let maintain onlyActive : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
let grp = currentGroup ctx
task {
let reqs = db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain reqs grp onlyActive ctx
|> renderHtml next ctx
}
let pageNbr =
match ctx.GetQueryStringValue "page" with
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Error _ -> 1
let m =
match ctx.GetQueryStringValue "search" with
| Ok srch ->
{ MaintainRequests.empty with
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr
searchTerm = Some srch
pageNbr = Some pageNbr
}
| Error _ ->
{ MaintainRequests.empty with
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
onlyActive = Some onlyActive
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
}
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|> renderHtml next ctx
/// GET /prayer-request/print/[date]
let print date : HttpHandler =
requireAccess [ User; Group ]
>=> fun next ctx ->
let listDate = parseListDate (Some date)
task {
let list = generateRequestList ctx listDate
return!
Views.PrayerRequest.print list appVersion
|> renderHtml next ctx
}
let list = parseListDate (Some date) |> generateRequestList ctx
Views.PrayerRequest.print list appVersion
|> renderHtml next ctx
/// GET /prayer-request/[request-id]/restore
let restore reqId : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
task {
let! result = findRequest ctx reqId
match result with
| Ok r ->
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with isManuallyExpired = false; updatedDate = DateTime.Now }
let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Error e -> return! e next ctx
}
>=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
}
/// POST /prayer-request/save
let save : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<EditRequest> ()
match result with
| Ok m ->
let db = ctx.dbContext ()
let! req =
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m ->
let! req =
match m.isNew () with
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
| false -> ctx.db.TryRequestById m.requestId
match req with
| Some pr ->
let upd8 =
{ pr with
requestType = PrayerRequestType.fromCode m.requestType
requestor = match m.requestor with Some x when x.Trim () = "" -> None | x -> x
text = ckEditorToText m.text
expiration = Expiration.fromCode m.expiration
}
let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ())
match m.isNew () with
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
| false -> db.TryRequestById m.requestId
match req with
| Some pr ->
let upd8 =
{ pr with
requestType = m.requestType
requestor = m.requestor
text = ckEditorToText m.text
doNotExpire = m.expiration = "Y"
isManuallyExpired = m.expiration = "X"
| true ->
let dt = match m.enteredDate with Some x -> x | None -> now
{ upd8 with
smallGroupId = grp.smallGroupId
userId = (currentUser ctx).userId
enteredDate = dt
updatedDate = dt
}
let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ())
match m.isNew () with
| true ->
let dt = match m.enteredDate with Some x -> x | None -> now
{ upd8 with
smallGroupId = grp.smallGroupId
userId = (currentUser ctx).userId
enteredDate = dt
updatedDate = dt
}
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
| false -> { upd8 with updatedDate = now }
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = match m.isNew () with true -> "Added" | false -> "Updated"
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
| false -> { upd8 with updatedDate = now }
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = match m.isNew () with true -> "Added" | false -> "Updated"
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// GET /prayer-request/view/[date?]
@@ -289,11 +278,7 @@ let view date : HttpHandler =
requireAccess [ User; Group ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let listDate = parseListDate date
task {
let list = generateRequestList ctx listDate
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.view { list with showHeader = false }
|> renderHtml next ctx
}
let list = parseListDate date |> generateRequestList ctx
viewInfo ctx startTicks
|> Views.PrayerRequest.view { list with showHeader = false }
|> renderHtml next ctx

View File

@@ -1,11 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>netcoreapp2.2</TargetFramework>
<AssemblyVersion>7.2.0.0</AssemblyVersion>
<FileVersion>7.0.0.0</FileVersion>
<Authors></Authors>
<Company>Bit Badger Solutions</Company>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
@@ -27,11 +23,9 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="3.6.0" />
<PackageReference Include="Giraffe.TokenRouter" Version="1.0.0" />
<PackageReference Include="Microsoft.AspNetCore.App" />
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="2.2.3" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="2.2.0" />
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
</ItemGroup>
<ItemGroup>
@@ -39,8 +33,4 @@
<ProjectReference Include="..\PrayerTracker.UI\PrayerTracker.UI.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project>

View File

@@ -1,8 +1,7 @@
module PrayerTracker.Handlers.SmallGroup
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker
@@ -16,7 +15,7 @@ open System.Threading.Tasks
/// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), autoRefresh)
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh)
/// GET /small-group/announcement
@@ -33,69 +32,60 @@ let announcement : HttpHandler =
let delete groupId : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
task {
let! grp = db.TryGroupById groupId
match grp with
| Some g ->
let! reqs = db.CountRequestsBySmallGroup groupId
let! usrs = db.CountUsersBySmallGroup groupId
db.RemoveEntry g
let! _ = db.SaveChangesAsync ()
addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
g.name, reqs, usrs]
return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour next ctx
}
>=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupById groupId with
| Some grp ->
let! reqs = ctx.db.CountRequestsBySmallGroup groupId
let! usrs = ctx.db.CountUsersBySmallGroup groupId
ctx.db.RemoveEntry grp
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
}
/// POST /small-group/member/[member-id]/delete
let deleteMember memberId : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
let db = ctx.dbContext ()
>=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
task {
let! mbr = db.TryMemberById memberId
match mbr with
| Some m when m.smallGroupId = (currentGroup ctx).smallGroupId ->
db.RemoveEntry m
let! _ = db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", m.memberName]
return! redirectTo false "/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
}
match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
ctx.db.RemoveEntry mbr
let! _ = ctx.db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName]
return! redirectTo false "/web/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
}
/// GET /small-group/[group-id]/edit
let edit (groupId : SmallGroupId) : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
task {
let! churches = db.AllChurches ()
match groupId = Guid.Empty with
| true ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx
| false ->
let! grp = db.TryGroupById groupId
match grp with
| Some g ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! churches = ctx.db.AllChurches ()
match groupId = Guid.Empty with
| true ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx
| false ->
match! ctx.db.TryGroupById groupId with
| Some grp ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
/// GET /small-group/member/[member-id]/edit
@@ -103,7 +93,6 @@ let editMember (memberId : MemberId) : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
@@ -115,12 +104,11 @@ let editMember (memberId : MemberId) : HttpHandler =
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx
| false ->
let! mbr = db.TryMemberById memberId
match mbr with
| Some m when m.smallGroupId = grp.smallGroupId ->
match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
return!
viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|> renderHtml next ctx
| Some _
| None -> return! fourOhFour next ctx
@@ -133,8 +121,8 @@ let logOn (groupId : SmallGroupId option) : HttpHandler =
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.dbContext().ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
let! grps = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx
@@ -148,22 +136,20 @@ let logOnSubmit : HttpHandler =
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<GroupLogOn> ()
match result with
match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password
match grp with
| Some _ ->
ctx.Session.SetSmallGroup grp
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with
| Some grp ->
ctx.Session.smallGroup <- Some grp
match m.rememberMe with
| Some x when x -> (setGroupCookie ctx << Utils.sha1Hash) m.password
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
| _ -> ()
addInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]]
return! redirectTo false "/prayer-requests/view" next ctx
return! redirectTo false "/web/prayer-requests/view" next ctx
| None ->
addError ctx s.["Password incorrect - login unsuccessful"]
return! redirectTo false (sprintf "/small-group/log-on/%s" (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
}
@@ -174,7 +160,7 @@ let maintain : HttpHandler =
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.dbContext().AllGroups ()
let! grps = ctx.db.AllGroups ()
return!
viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx
@@ -187,11 +173,10 @@ let members : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
let grp = currentGroup ctx
let s = Views.I18N.localizer.Force ()
task {
let! mbrs = db.AllMembersForSmallGroup grp.smallGroupId
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
@@ -205,12 +190,11 @@ let overview : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
let clock = ctx.GetService<IClock> ()
task {
let reqs = db.AllRequestsForSmallGroup (currentGroup ctx) clock None true |> List.ofSeq
let! reqCount = db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let m =
{ totalActiveReqs = List.length reqs
allReqs = reqCount
@@ -236,7 +220,7 @@ let preferences : HttpHandler =
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! tzs = ctx.dbContext().AllTimeZones ()
let! tzs = ctx.db.AllTimeZones ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
@@ -251,26 +235,24 @@ let save : HttpHandler =
>=> fun next ctx ->
let s = Views.I18N.localizer.Force ()
task {
let! result = ctx.TryBindFormAsync<EditSmallGroup> ()
match result with
match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok m ->
let db = ctx.dbContext ()
let! grp =
let! group =
match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| false -> db.TryGroupById m.smallGroupId
match grp with
| Some g ->
m.populateGroup g
| false -> ctx.db.TryGroupById m.smallGroupId
match group with
| Some grp ->
m.populateGroup grp
|> function
| g when m.isNew () ->
db.AddEntry g
db.AddEntry { g.preferences with smallGroupId = g.smallGroupId }
| g -> db.UpdateEntry g
let! _ = db.SaveChangesAsync ()
| grp when m.isNew () ->
ctx.db.AddEntry grp
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
return! redirectTo false "/small-groups" next ctx
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
@@ -282,11 +264,9 @@ let saveMember : HttpHandler =
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<EditMember> ()
match result with
match! ctx.TryBindFormAsync<EditMember> () with
| Ok m ->
let grp = currentGroup ctx
let db = ctx.dbContext ()
let! mMbr =
match m.isNew () with
| true ->
@@ -296,7 +276,7 @@ let saveMember : HttpHandler =
memberId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
})
| false -> db.TryMemberById m.memberId
| false -> ctx.db.TryMemberById m.memberId
match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
{ mbr with
@@ -304,12 +284,12 @@ let saveMember : HttpHandler =
email = m.emailAddress
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
}
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync ()
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} group member", act]
return! redirectTo false "/small-group/members" next ctx
return! redirectTo false "/web/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
@@ -322,24 +302,21 @@ let savePreferences : HttpHandler =
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<EditPreferences> ()
match result with
match! ctx.TryBindFormAsync<EditPreferences> () with
| Ok m ->
let db = ctx.dbContext ()
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
// works, we can repopulate the session instance. That way, if the update fails, the page should still show
// the database values, not the then out-of-sync session ones.
let! grp = db.TryGroupById (currentGroup ctx).smallGroupId
match grp with
| Some g ->
let prefs = m.populatePreferences g.preferences
db.UpdateEntry prefs
let! _ = db.SaveChangesAsync ()
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
| Some grp ->
let prefs = m.populatePreferences grp.preferences
ctx.db.UpdateEntry prefs
let! _ = ctx.db.SaveChangesAsync ()
// Refresh session instance
ctx.Session.SetSmallGroup <| Some { g with preferences = prefs }
ctx.Session.smallGroup <- Some { grp with preferences = prefs }
let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Group preferences updated successfully"]
return! redirectTo false "/small-group/preferences" next ctx
return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
@@ -352,26 +329,24 @@ let sendAnnouncement : HttpHandler =
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! result = ctx.TryBindFormAsync<Announcement> ()
match result with
match! ctx.TryBindFormAsync<Announcement> () with
| Ok m ->
let grp = currentGroup ctx
let usr = currentUser ctx
let db = ctx.dbContext ()
let now = grp.localTimeNow (ctx.GetService<IClock> ())
let s = Views.I18N.localizer.Force ()
// Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text
let htmlText =
p [ _style (sprintf "font-family:%s;font-size:%dpt;" grp.preferences.listFonts grp.preferences.textFontSize) ]
p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ]
[ rawText requestText ]
|> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails
let! recipients =
match m.sendToClass with
| "N" when usr.isAdmin -> db.AllUsersAsMembers ()
| _ -> db.AllMembersForSmallGroup grp.smallGroupId
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers ()
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients grp
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}",
@@ -387,13 +362,13 @@ let sendAnnouncement : HttpHandler =
prayerRequestId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
userId = usr.userId
requestType = Option.get m.requestType
requestType = (Option.get >> PrayerRequestType.fromCode) m.requestType
text = requestText
enteredDate = now
updatedDate = now
}
|> db.AddEntry
let! _ = db.SaveChangesAsync ()
|> ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync ()
()
// Tell 'em what they've won, Johnny!
let toWhom =

View File

@@ -1,6 +1,5 @@
module PrayerTracker.Handlers.User
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http
@@ -18,207 +17,188 @@ open System.Threading.Tasks
let private setUserCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append (
Key.Cookie.user,
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(),
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (),
autoRefresh)
/// Retrieve a user from the database by password
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
let private findUserByPassword m (db : AppDbContext) =
task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
| Some u ->
match u.salt with
| Some salt ->
// Already upgraded; match = success
let pwHash = pbkdf2Hash salt m.password
match u.passwordHash = pwHash with
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
| _ ->
// Not upgraded; check against old hash
match u.passwordHash = sha1Hash m.password with
| true ->
// Upgrade 'em!
let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password
let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
| _ -> return None, ""
}
let private findUserByPassword m (db : AppDbContext) = task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
| Some u when Option.isSome u.salt ->
// Already upgraded; match = success
let pwHash = pbkdf2Hash (Option.get u.salt) m.password
match u.passwordHash = pwHash with
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
| Some u when u.passwordHash = sha1Hash m.password ->
// Not upgraded, but password is good; upgrade 'em!
// Upgrade 'em!
let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password
let upgraded = { u with salt = Some salt; passwordHash = pwHash }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, ""
}
/// POST /user/password/change
let changePassword : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<ChangePassword> ()
match result with
| Ok m ->
let s = Views.I18N.localizer.Force ()
let db = ctx.dbContext ()
let curUsr = currentUser ctx
let! dbUsr = db.TryUserById curUsr.userId
let! user =
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<ChangePassword> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
let curUsr = currentUser ctx
let! dbUsr = ctx.db.TryUserById curUsr.userId
let! user =
match dbUsr with
| Some usr ->
// Check the old password against a possibly non-salted hash
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
| _ -> Task.FromResult None
match user with
| Some _ when m.newPassword = m.newPasswordConfirm ->
match dbUsr with
| Some usr ->
// Check the old password against a possibly non-salted hash
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword
|> db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
| _ -> Task.FromResult None
match user with
| Some _ when m.newPassword = m.newPasswordConfirm ->
match dbUsr with
| Some usr ->
// Generate salt if it has not been already
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid ()
db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
let! _ = db.SaveChangesAsync ()
// If the user is remembered, update the cookie with the new hash
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with
| true -> setUserCookie ctx usr.passwordHash
| _ -> ()
addInfo ctx s.["Your password was changed successfully"]
| None -> addError ctx s.["Unable to change password"]
return! redirectTo false "/" next ctx
| Some _ ->
addError ctx s.["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx
| None ->
addError ctx s.["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx
| Error e -> return! bindError e next ctx
}
// Generate salt if it has not been already
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid ()
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
let! _ = ctx.db.SaveChangesAsync ()
// If the user is remembered, update the cookie with the new hash
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with
| true -> setUserCookie ctx usr.passwordHash
| _ -> ()
addInfo ctx s.["Your password was changed successfully"]
| None -> addError ctx s.["Unable to change password"]
return! redirectTo false "/web/" next ctx
| Some _ ->
addError ctx s.["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx
| None ->
addError ctx s.["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx
| Error e -> return! bindError e next ctx
}
/// POST /user/[user-id]/delete
let delete userId : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
task {
let db = ctx.dbContext ()
let! user = db.TryUserById userId
match user with
| Some u ->
db.RemoveEntry u
let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Successfully deleted user {0}", u.fullName]
return! redirectTo false "/users" next ctx
| _ -> return! fourOhFour next ctx
}
>=> fun next ctx -> task {
match! ctx.db.TryUserById userId with
| Some user ->
ctx.db.RemoveEntry user
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Successfully deleted user {0}", user.fullName]
return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx
}
/// POST /user/log-on
let doLogOn : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<UserLogOn> ()
match result with
| Ok m ->
let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force ()
let! usr, pwHash = findUserByPassword m db
let! grp = db.TryGroupById m.smallGroupId
let nextUrl =
match usr with
| Some _ ->
ctx.Session.SetUser usr
ctx.Session.SetSmallGroup grp
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
addHtmlInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]]
match m.redirectUrl with
| None -> "/small-group"
| Some x when x = "" -> "/small-group"
| Some x -> x
| _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.Error with
text = htmlLocString s.["Invalid credentials - log on unsuccessful"]
description =
[ s.["This is likely due to one of the following reasons"].Value
":<ul><li>"
s.["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value
"</li><li>"
s.["The password entered does not match the password for the given e-mail address."].Value
"</li><li>"
s.["You are not authorized to administer the group “{0}”.", WebUtility.HtmlEncode grpName].Value
"</li></ul>"
]
|> String.concat ""
|> (HtmlString >> Some)
}
|> addUserMessage ctx
"/user/log-on"
return! redirectTo false nextUrl next ctx
| Error e -> return! bindError e next ctx
}
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
let! usr, pwHash = findUserByPassword m ctx.db
let! grp = ctx.db.TryGroupById m.smallGroupId
let nextUrl =
match usr with
| Some _ ->
ctx.Session.user <- usr
ctx.Session.smallGroup <- grp
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
addHtmlInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]]
match m.redirectUrl with
| None -> "/web/small-group"
| Some x when x = "" -> "/web/small-group"
| Some x -> x
| _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.error with
text = htmlLocString s.["Invalid credentials - log on unsuccessful"]
description =
[ s.["This is likely due to one of the following reasons"].Value
":<ul><li>"
s.["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value
"</li><li>"
s.["The password entered does not match the password for the given e-mail address."].Value
"</li><li>"
s.["You are not authorized to administer the group “{0}”.", WebUtility.HtmlEncode grpName].Value
"</li></ul>"
]
|> String.concat ""
|> (HtmlString >> Some)
}
|> addUserMessage ctx
"/web/user/log-on"
return! redirectTo false nextUrl next ctx
| Error e -> return! bindError e next ctx
}
/// GET /user/[user-id]/edit
let edit (userId : UserId) : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
match userId = Guid.Empty with
| true ->
return!
viewInfo ctx startTicks
|> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx
| false ->
let! user = ctx.dbContext().TryUserById userId
match user with
| Some u ->
return!
viewInfo ctx startTicks
|> Views.User.edit (EditUser.fromUser u) ctx
|> renderHtml next ctx
| _ -> return! fourOhFour next ctx
}
match userId = Guid.Empty with
| true ->
return!
viewInfo ctx startTicks
|> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx
| false ->
match! ctx.db.TryUserById userId with
| Some user ->
return!
viewInfo ctx startTicks
|> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx
| _ -> return! fourOhFour next ctx
}
/// GET /user/log-on
let logOn : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
task {
let! groups = ctx.dbContext().GroupList ()
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
match url with
| Some _ ->
ctx.Session.Remove Key.Session.redirectUrl
addWarning ctx s.["The page you requested requires authentication; please log on below."]
| None -> ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx
|> renderHtml next ctx
}
let s = Views.I18N.localizer.Force ()
let! groups = ctx.db.GroupList ()
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
match url with
| Some _ ->
ctx.Session.Remove Key.Session.redirectUrl
addWarning ctx s.["The page you requested requires authentication; please log on below."]
| None -> ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx
|> renderHtml next ctx
}
/// GET /users
let maintain : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
task {
let! users = ctx.dbContext().AllUsers ()
return!
viewInfo ctx startTicks
|> Views.User.maintain users ctx
|> renderHtml next ctx
}
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! users = ctx.db.AllUsers ()
return!
viewInfo ctx startTicks
|> Views.User.maintain users ctx
|> renderHtml next ctx
}
/// GET /user/password
@@ -234,107 +214,98 @@ let password : HttpHandler =
let save : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<EditUser> ()
match result with
| Ok m ->
let db = ctx.dbContext ()
let! user =
match m.isNew () with
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
| false -> db.TryUserById m.userId
let saltedUser =
match user with
| Some u ->
match u.salt with
| None when m.password <> "" ->
// Generate salt so that a new password hash can be generated
Some { u with salt = Some (Guid.NewGuid ()) }
| _ ->
// Leave the user with no salt, so prior hash can be validated/upgraded
user
| _ -> user
match saltedUser with
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with
| Ok m ->
let! user =
match m.isNew () with
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
| false -> ctx.db.TryUserById m.userId
let saltedUser =
match user with
| Some u ->
m.populateUser u (pbkdf2Hash (Option.get u.salt))
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
match m.isNew () with
| true ->
let h = CommonFunctions.htmlString
{ UserMessage.Info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
description =
h s.[ "Please select at least one group for which this user ({0}) is authorized", u.fullName]
|> Some
}
|> addUserMessage ctx
return! redirectTo false (sprintf "/user/%s/small-groups" (flatGuid u.userId)) next ctx
| false ->
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()]
return! redirectTo false "/users" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
match u.salt with
| None when m.password <> "" ->
// Generate salt so that a new password hash can be generated
Some { u with salt = Some (Guid.NewGuid ()) }
| _ ->
// Leave the user with no salt, so prior hash can be validated/upgraded
user
| _ -> user
match saltedUser with
| Some u ->
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force ()
match m.isNew () with
| true ->
let h = CommonFunctions.htmlString
{ UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
description =
h s.["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName]
|> Some
}
|> addUserMessage ctx
return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx
| false ->
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// POST /user/small-groups/save
let saveGroups : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<AssignGroups> ()
match result with
| Ok m ->
let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with
| 0 ->
addError ctx s.["You must select at least one group to assign"]
return! redirectTo false (sprintf "/user/%s/small-groups" (flatGuid m.userId)) next ctx
| _ ->
let db = ctx.dbContext ()
let! user = db.TryUserByIdWithGroups m.userId
match user with
| Some u ->
let grps =
m.smallGroups.Split ','
|> Array.map Guid.Parse
|> List.ofArray
u.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> db.UserGroupXref.RemoveRange
grps
|> Seq.ofList
|> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x })
|> List.ofSeq
|> List.iter db.AddEntry
let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
return! redirectTo false "/users" next ctx
| _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with
| 0 ->
addError ctx s.["You must select at least one group to assign"]
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
| _ ->
match! ctx.db.TryUserByIdWithGroups m.userId with
| Some user ->
let grps =
m.smallGroups.Split ','
|> Array.map Guid.Parse
|> List.ofArray
user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> ctx.db.UserGroupXref.RemoveRange
grps
|> Seq.ofList
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq
|> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
/// GET /user/[user-id]/small-groups
let smallGroups userId : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
task {
let! user = db.TryUserByIdWithGroups userId
match user with
| Some u ->
let! grps = db.GroupList ()
let curGroups = u.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return!
viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
match! ctx.db.TryUserByIdWithGroups userId with
| Some user ->
let! grps = ctx.db.GroupList ()
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return!
viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}

View File

@@ -369,6 +369,12 @@ article.pt-overview section div p {
border-radius: 5px;
margin: auto;
}
.pt-search-form input,
.pt-search-form button,
.pt-search-form i.material-icons {
font-size: .8rem;
}
.pt-request-update {
font-style: italic;
}

3
src/Publish-App.ps1 Normal file
View File

@@ -0,0 +1,3 @@
Set-Location PrayerTracker
dotnet publish -c Release -r linux-x64 -p:PublishSingleFile=true --self-contained false
Set-Location bin\Release\net6.0\linux-x64\publish

27
src/search-sql.txt Normal file
View File

@@ -0,0 +1,27 @@
create extension pg_trgm;
set search_path=pt,public;
create index "IX_PrayerRequest_Requestor_TRGM" on "PrayerRequest" using GIN (COALESCE("Requestor", '') gin_trgm_ops);
create index "IX_PrayerRequest_Text_TRGM" on "PrayerRequest" using GIN ("Text" gin_trgm_ops);
alter table "ListPreference" add column "PageSize" int not null default 100;
alter table "ListPreference" add column "AsOfDateDisplay" varchar(1) not null default 'N';
/* RequestType to 1 character code */
update "PrayerRequest" set "RequestType" = 'C' where "RequestType" = 'Current';
update "PrayerRequest" set "RequestType" = 'L' where "RequestType" = 'Recurring';
update "PrayerRequest" set "RequestType" = 'P' where "RequestType" = 'Praise';
update "PrayerRequest" set "RequestType" = 'E' where "RequestType" = 'Expecting';
update "PrayerRequest" set "RequestType" = 'A' where "RequestType" = 'Announcement';
alter table "PrayerRequest" alter column "RequestType" set data type varchar(1);
/* Change expiration to a 1-character code field */
alter table "PrayerRequest" add column "Expiration" varchar(1);
update "PrayerRequest" set "Expiration" = case when "IsManuallyExpired" then 'F' when "DoNotExpire" then 'M' else 'A' end;
alter table "PrayerRequest" alter column "Expiration" set not null;
alter table "PrayerRequest" drop column "DoNotExpire";
alter table "PrayerRequest" drop column "IsManuallyExpired";
/* Change e-mail type to 1-character code field in list preferences and members */
update "ListPreference" set "DefaultEmailType" = 'H' where "DefaultEmailType" = 'Html';
update "ListPreference" set "DefaultEmailType" = 'P' where "DefaultEmailType" = 'Text';
alter table "ListPreference" alter column "DefaultEmailType" set default 'H';
alter table "ListPreference" alter column "DefaultEmailType" set data type varchar(1);
update "Member" set "Format" = 'H' where "Format" = 'Html';
update "Member" set "Format" = 'P' where "Format" = 'Text';
alter table "Member" alter column "Format" set data type varchar(1);