27 Commits
v7.3 ... 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
37 changed files with 1682 additions and 1696 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

@@ -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,9 +1,7 @@
[<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
@@ -11,17 +9,29 @@ 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 (query : IQueryable<PrayerRequest>) =
let reqSort sort (q : IQueryable<PrayerRequest>) =
match sort with
| SortByDate ->
query.OrderByDescending(fun pr -> pr.updatedDate)
.ThenByDescending(fun pr -> pr.enteredDate)
.ThenBy(fun pr -> pr.requestor)
query {
for req in q do
sortByDescending req.updatedDate
thenByDescending req.enteredDate
thenBy req.requestor
}
| SortByRequestor ->
query.OrderBy(fun pr -> pr.requestor)
.ThenByDescending(fun pr -> pr.updatedDate)
.ThenByDescending(fun pr -> pr.enteredDate)
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
@@ -44,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
}
@@ -60,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
}
@@ -84,32 +106,44 @@ type AppDbContext with
/// 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
// 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
| query when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query.Where(fun pr ->
( pr.updatedDate > asOf
|| pr.expiration = Manual
|| pr.requestType = LongTermRequest
|| pr.requestType = Expecting)
&& pr.expiration <> Forced)
| query -> query
|> reqSort grp.preferences.requestSort
|> function
| query ->
match activeOnly with
| true -> query.Skip 0
| false -> query.Skip((pageNbr - 1) * grp.preferences.pageSize).Take grp.preferences.pageSize)
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 =
@@ -120,57 +154,63 @@ type AppDbContext with
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 skip = (pageNbr - 1) * pgSz
let sql =
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}"""
|> RawSqlString
let like = sprintf "%%%s%%"
upcast (
this.PrayerRequests.FromSql(sql, grp.smallGroupId, like searchTerm).AsNoTracking ()
|> reqSort grp.preferences.requestSort
|> function query -> (query.Skip skip).Take pgSz)
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
}
@@ -190,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
}
@@ -233,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
}
@@ -249,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,6 +6,8 @@ open NodaTime
open System
open System.Collections.Generic
// fsharplint:disable RecordFieldNames MemberNames
(*-- SUPPORT TYPES --*)
/// How as-of dates should (or should not) be displayed with requests
@@ -545,13 +547,13 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
match this.requestType with
| LongTermRequest
| Expecting -> false
| _ -> curr.AddDays(-(float expDays)) > this.updatedDate // Automatic expiration
| _ -> 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
| 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) =

View File

@@ -10,6 +10,7 @@ open PrayerTracker
open PrayerTracker.Entities
open System
// fsharplint:disable RecordFieldNames
type ChurchTable =
{ churchId : OperationBuilder<AddColumnOperation>

View File

@@ -1,9 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<AssemblyVersion>7.3.0.0</AssemblyVersion>
<FileVersion>7.3.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

@@ -171,33 +171,42 @@ let prayerRequestTests =
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 expiration = Forced }
Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update"
}
test "updateRequired returns false when an update is not required for an active request" {
let now = DateTime.Now
let req =
{ PrayerRequest.empty with
requestType = LongTermRequest
updatedDate = DateTime.Now.AddDays -14.
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 = LongTermRequest
updatedDate = DateTime.Now.AddDays -34.
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)"
}
]

View File

@@ -2,9 +2,7 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>netcoreapp2.2</TargetFramework>
<AssemblyVersion>7.3.0.0</AssemblyVersion>
<FileVersion>7.3.0.0</FileVersion>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
@@ -17,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>
@@ -28,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

@@ -660,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 delAction = $"/web/church/{chId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Church"].Value.ToLower ()) ch.name]
$"""{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 (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 []
@@ -179,8 +179,8 @@ let maintain m (ctx : HttpContext) vi =
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 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() ]
@@ -192,49 +192,48 @@ let maintain m (ctx : HttpContext) vi =
|> String.concat ""
tr [] [
td [] [
yield a [ _href (sprintf "/prayer-request/%s/edit" reqId); _title l.["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 m.smallGroup.preferences.daysToExpire with
| true ->
yield a [ _href (sprintf "/prayer-request/%s/restore" reqId)
_title l.["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 l.["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 l.["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.[0..59])
match reqText.Length with
| len when len < 60 -> rawText reqText
| _ -> rawText $"{reqText.[0..59]}&hellip;"
]
])
|> List.ofSeq
[ yield div [ _class "pt-center-text" ] [
yield br []
yield a [ _href (sprintf "/prayer-request/%s/edit" emptyGuid); _title s.["Add a New Request"].Value ]
[ div [ _class "pt-center-text" ] [
br []
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"] ]
yield rawText " &nbsp; &nbsp; &nbsp; "
yield a [ _href "/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ]
match m.searchTerm with
| Some _ ->
yield rawText " &nbsp; &nbsp; &nbsp; "
yield a [ _href "/prayer-requests"; _title l.["Clear Search Criteria"].Value ]
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 form [ _action "/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [
form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [
input [ _type "text"
_name "search"
_placeholder l.["Search requests..."].Value
@@ -243,12 +242,12 @@ let maintain m (ctx : HttpContext) vi =
space
submit [] "search" s.["Search"]
]
yield br []
yield tableSummary requests.Length s
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"] ]
@@ -260,40 +259,41 @@ let maintain m (ctx : HttpContext) vi =
]
tbody [] requests
]
yield div [ _class "pt-center-text" ] [
yield br []
div [ _class "pt-center-text" ] [
br []
match m.onlyActive with
| Some true ->
yield raw l.["Inactive requests are currently not shown"]
yield br []
yield a [ _href "/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ]
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 ->
yield raw l.["Inactive requests are currently shown"]
yield br []
yield a [ _href "/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ]
yield br []
yield br []
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 -> yield "search", s | None -> () ]
let url = match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/prayer-requests%s"
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
yield a [ _href (makeUrl url withPage) ]
a [ _href (makeUrl url withPage) ]
[ icon "keyboard_arrow_left"; space; raw l.["Previous Page"] ]
yield rawText " &nbsp; &nbsp; "
rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with
| true ->
yield a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ]
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 (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
@@ -302,14 +302,14 @@ let maintain m (ctx : HttpContext) vi =
/// 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 ]
@@ -323,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 ->
@@ -344,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.3.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>
@@ -63,8 +62,4 @@
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project>

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,15 +32,14 @@ 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
@@ -49,7 +48,7 @@ let announcement isAdmin ctx vi =
|> 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 delAction = $"/web/small-group/{grpId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
sprintf "%s (%s)" (s.["Small Group"].Value.ToLower ()) g.name].Value
$"""{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,18 +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 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("?", sprintf " (%s)?" mbr.memberName)
.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 ]
@@ -267,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 []
@@ -292,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 [] [
@@ -305,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"]
@@ -334,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"] ]
]
]
]
@@ -349,7 +348,7 @@ 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" ] [
[ 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 [] [
@@ -406,7 +405,7 @@ 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
"", selectDefault s.["Select"].Value
yield! ReferenceList.emailTypeList HtmlFormat s
|> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
@@ -424,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 ]
]
]
]
@@ -444,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 ]
]
]
]
@@ -483,7 +482,7 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [
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 ]
@@ -502,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)"] ]
@@ -526,8 +525,8 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
|> selectList "asOfDate" m.asOfDate [ _required ]
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Preferences"] ]
]
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 delAction = $"/web/user/{userId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
(sprintf "%s (%s)" (s.["User"].Value.ToLower()) user.fullName)].Value
$"""{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
@@ -202,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

@@ -25,16 +25,16 @@ module ReferenceList =
| HtmlFormat -> s.["HTML Format"].Value
| PlainTextFormat -> s.["Plain-Text Format"].Value
seq {
yield "", LocalizedString ("", sprintf "%s (%s)" s.["Group Default"].Value defaultType)
yield HtmlFormat.code, s.["HTML Format"]
yield PlainTextFormat.code, 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 =
[ yield Automatic.code, s.["Expire Normally"]
yield Manual.code, s.["Request Never Expires"]
match includeExpireNow with true -> yield Forced.code, s.["Expire Immediately"] | false -> ()
[ 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
@@ -46,6 +46,7 @@ module ReferenceList =
Announcement, s.["Announcements"]
]
// fsharplint:disable RecordFieldNames MemberNames
/// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>]
@@ -57,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
@@ -98,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
@@ -139,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 = ""
@@ -177,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
@@ -206,6 +189,25 @@ 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
@@ -221,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
@@ -282,32 +285,6 @@ type EditPreferences =
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.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
}
/// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw =
@@ -335,6 +312,34 @@ with
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
}
/// Form for adding or editing prayer requests
@@ -357,8 +362,11 @@ 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 = CurrentRequest.code
enteredDate = None
@@ -368,16 +376,14 @@ with
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.code
requestor = req.requestor
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
@@ -391,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
@@ -411,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
@@ -432,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
@@ -462,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
@@ -476,8 +484,9 @@ 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
@@ -498,8 +507,9 @@ type MaintainRequests =
/// The page number of the results
pageNbr : int option
}
with
static member empty =
module MaintainRequests =
/// An empty instance
let empty =
{ requests = Seq.empty
smallGroup = SmallGroup.empty
onlyActive = None
@@ -536,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
@@ -546,7 +557,7 @@ with
}
open Giraffe.GiraffeViewEngine
open Giraffe.ViewEngine
/// This represents a list of requests
type RequestList =
@@ -583,18 +594,18 @@ with
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
@@ -604,54 +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
match prefs.asOfDateDisplay with
| NoDisplay -> ()
| ShortDate
| LongDate ->
let dt =
match prefs.asOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString ()
| _ -> ""
yield i [ _style (sprintf "font-size:%.2fpt" asOfSize) ] [
rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")"
]
])
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
@@ -661,24 +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
match this.listGroup.preferences.asOfDateDisplay with
| NoDisplay -> ""
| _ ->
let dt =
match this.listGroup.preferences.asOfDateDisplay with
| ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString ()
| _ -> ""
sprintf " (%s %s)" s.["as of"].Value dt
|> sprintf " %s %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,21 +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 -> 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 ()
}
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 0
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,143 +47,130 @@ 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 expiration = Forced }
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 0
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?]
@@ -196,110 +180,97 @@ let maintain onlyActive : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext ()
let grp = currentGroup ctx
task {
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 = db.SearchRequestsForSmallGroup grp srch pageNbr
searchTerm = Some srch
pageNbr = Some pageNbr
}
| Error _ ->
{ MaintainRequests.empty with
requests = db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
onlyActive = Some onlyActive
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
}
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with smallGroup = grp } 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 expiration = Automatic; 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 = PrayerRequestType.fromCode m.requestType
requestor = m.requestor
text = ckEditorToText m.text
expiration = Expiration.fromCode m.expiration
| 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?]
@@ -307,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.3.0.0</AssemblyVersion>
<FileVersion>7.3.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 0 |> 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}",
@@ -392,8 +367,8 @@ let sendAnnouncement : HttpHandler =
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
}

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