19 Commits
v7.3 ... v7.5

Author SHA1 Message Date
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
34 changed files with 1025 additions and 973 deletions

2
.gitignore vendored
View File

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

View File

@@ -1,6 +1,6 @@
# PrayerTracker # 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 ### Visit the Site

View File

@@ -1,13 +1,13 @@
GEM GEM
remote: https://rubygems.org/ remote: https://rubygems.org/
specs: specs:
activesupport (4.2.10) activesupport (4.2.11.1)
i18n (~> 0.7) i18n (~> 0.7)
minitest (~> 5.1) minitest (~> 5.1)
thread_safe (~> 0.3, >= 0.3.4) thread_safe (~> 0.3, >= 0.3.4)
tzinfo (~> 1.1) tzinfo (~> 1.1)
addressable (2.5.2) addressable (2.7.0)
public_suffix (>= 2.0.2, < 4.0) public_suffix (>= 2.0.2, < 5.0)
coffee-script (2.4.1) coffee-script (2.4.1)
coffee-script-source coffee-script-source
execjs execjs
@@ -15,8 +15,8 @@ GEM
colorator (1.1.0) colorator (1.1.0)
commonmarker (0.17.13) commonmarker (0.17.13)
ruby-enum (~> 0.5) ruby-enum (~> 0.5)
concurrent-ruby (1.1.4) concurrent-ruby (1.1.5)
dnsruby (1.61.2) dnsruby (1.61.3)
addressable (~> 2.5) addressable (~> 2.5)
em-websocket (0.5.1) em-websocket (0.5.1)
eventmachine (>= 0.12.9) eventmachine (>= 0.12.9)
@@ -24,19 +24,21 @@ GEM
ethon (0.12.0) ethon (0.12.0)
ffi (>= 1.3.0) ffi (>= 1.3.0)
eventmachine (1.2.7) eventmachine (1.2.7)
eventmachine (1.2.7-x64-mingw32)
execjs (2.7.0) execjs (2.7.0)
faraday (0.15.4) faraday (0.17.0)
multipart-post (>= 1.2, < 3) multipart-post (>= 1.2, < 3)
ffi (1.10.0) ffi (1.11.1)
ffi (1.11.1-x64-mingw32)
forwardable-extended (2.6.0) forwardable-extended (2.6.0)
gemoji (3.0.0) gemoji (3.0.1)
github-pages (197) github-pages (201)
activesupport (= 4.2.10) activesupport (= 4.2.11.1)
github-pages-health-check (= 1.16.1) github-pages-health-check (= 1.16.1)
jekyll (= 3.7.4) jekyll (= 3.8.5)
jekyll-avatar (= 0.6.0) jekyll-avatar (= 0.6.0)
jekyll-coffeescript (= 1.1.1) jekyll-coffeescript (= 1.1.1)
jekyll-commonmark-ghpages (= 0.1.5) jekyll-commonmark-ghpages (= 0.1.6)
jekyll-default-layout (= 0.1.4) jekyll-default-layout (= 0.1.4)
jekyll-feed (= 0.11.0) jekyll-feed (= 0.11.0)
jekyll-gist (= 1.5.0) jekyll-gist (= 1.5.0)
@@ -47,7 +49,7 @@ GEM
jekyll-readme-index (= 0.2.0) jekyll-readme-index (= 0.2.0)
jekyll-redirect-from (= 0.14.0) jekyll-redirect-from (= 0.14.0)
jekyll-relative-links (= 0.6.0) jekyll-relative-links (= 0.6.0)
jekyll-remote-theme (= 0.3.1) jekyll-remote-theme (= 0.4.0)
jekyll-sass-converter (= 1.5.2) jekyll-sass-converter (= 1.5.2)
jekyll-seo-tag (= 2.5.0) jekyll-seo-tag (= 2.5.0)
jekyll-sitemap (= 1.2.0) jekyll-sitemap (= 1.2.0)
@@ -72,8 +74,8 @@ GEM
listen (= 3.1.5) listen (= 3.1.5)
mercenary (~> 0.3) mercenary (~> 0.3)
minima (= 2.5.0) minima (= 2.5.0)
nokogiri (>= 1.8.5, < 2.0) nokogiri (>= 1.10.4, < 2.0)
rouge (= 2.2.1) rouge (= 3.11.0)
terminal-table (~> 1.4) terminal-table (~> 1.4)
github-pages-health-check (1.16.1) github-pages-health-check (1.16.1)
addressable (~> 2.3) addressable (~> 2.3)
@@ -81,13 +83,13 @@ GEM
octokit (~> 4.0) octokit (~> 4.0)
public_suffix (~> 3.0) public_suffix (~> 3.0)
typhoeus (~> 1.3) typhoeus (~> 1.3)
html-pipeline (2.10.0) html-pipeline (2.12.0)
activesupport (>= 2) activesupport (>= 2)
nokogiri (>= 1.4) nokogiri (>= 1.4)
http_parser.rb (0.6.0) http_parser.rb (0.6.0)
i18n (0.9.5) i18n (0.9.5)
concurrent-ruby (~> 1.0) concurrent-ruby (~> 1.0)
jekyll (3.7.4) jekyll (3.8.5)
addressable (~> 2.4) addressable (~> 2.4)
colorator (~> 1.0) colorator (~> 1.0)
em-websocket (~> 0.5) em-websocket (~> 0.5)
@@ -105,13 +107,13 @@ GEM
jekyll-coffeescript (1.1.1) jekyll-coffeescript (1.1.1)
coffee-script (~> 2.2) coffee-script (~> 2.2)
coffee-script-source (~> 1.11.1) coffee-script-source (~> 1.11.1)
jekyll-commonmark (1.2.0) jekyll-commonmark (1.3.1)
commonmarker (~> 0.14) commonmarker (~> 0.14)
jekyll (>= 3.0, < 4.0) jekyll (>= 3.7, < 5.0)
jekyll-commonmark-ghpages (0.1.5) jekyll-commonmark-ghpages (0.1.6)
commonmarker (~> 0.17.6) commonmarker (~> 0.17.6)
jekyll-commonmark (~> 1) jekyll-commonmark (~> 1.2)
rouge (~> 2) rouge (>= 2.0, < 4.0)
jekyll-default-layout (0.1.4) jekyll-default-layout (0.1.4)
jekyll (~> 3.0) jekyll (~> 3.0)
jekyll-feed (0.11.0) jekyll-feed (0.11.0)
@@ -133,7 +135,8 @@ GEM
jekyll (~> 3.3) jekyll (~> 3.3)
jekyll-relative-links (0.6.0) jekyll-relative-links (0.6.0)
jekyll (~> 3.3) jekyll (~> 3.3)
jekyll-remote-theme (0.3.1) jekyll-remote-theme (0.4.0)
addressable (~> 2.0)
jekyll (~> 3.5) jekyll (~> 3.5)
rubyzip (>= 1.2.1, < 3.0) rubyzip (>= 1.2.1, < 3.0)
jekyll-sass-converter (1.5.2) jekyll-sass-converter (1.5.2)
@@ -185,7 +188,7 @@ GEM
jekyll-seo-tag (~> 2.0) jekyll-seo-tag (~> 2.0)
jekyll-titles-from-headings (0.5.1) jekyll-titles-from-headings (0.5.1)
jekyll (~> 3.3) jekyll (~> 3.3)
jekyll-watch (2.1.2) jekyll-watch (2.2.1)
listen (~> 3.0) listen (~> 3.0)
jemoji (0.10.2) jemoji (0.10.2)
gemoji (~> 3.0) gemoji (~> 3.0)
@@ -194,38 +197,43 @@ GEM
kramdown (1.17.0) kramdown (1.17.0)
liquid (4.0.0) liquid (4.0.0)
listen (3.1.5) listen (3.1.5)
rb-fsevent (~> 0.9, >= 0.9.4)
rb-inotify (~> 0.9, >= 0.9.7) rb-inotify (~> 0.9, >= 0.9.7)
ruby_dep (~> 1.2)
mercenary (0.3.6) mercenary (0.3.6)
mini_portile2 (2.4.0) mini_portile2 (2.4.0)
minima (2.5.0) minima (2.5.0)
jekyll (~> 3.5) jekyll (~> 3.5)
jekyll-feed (~> 0.9) jekyll-feed (~> 0.9)
jekyll-seo-tag (~> 2.1) jekyll-seo-tag (~> 2.1)
minitest (5.11.3) minitest (5.12.2)
multipart-post (2.0.0) multipart-post (2.1.1)
nokogiri (1.10.1) nokogiri (1.10.8)
mini_portile2 (~> 2.4.0) mini_portile2 (~> 2.4.0)
octokit (4.13.0) nokogiri (1.10.8-x64-mingw32)
mini_portile2 (~> 2.4.0)
octokit (4.14.0)
sawyer (~> 0.8.0, >= 0.5.3) sawyer (~> 0.8.0, >= 0.5.3)
pathutil (0.16.2) pathutil (0.16.2)
forwardable-extended (~> 2.6) forwardable-extended (~> 2.6)
public_suffix (3.0.3) public_suffix (3.1.1)
rb-fsevent (0.10.3) rb-fsevent (0.10.3)
rb-inotify (0.10.0) rb-inotify (0.10.0)
ffi (~> 1.0) ffi (~> 1.0)
rouge (2.2.1) rouge (3.11.0)
ruby-enum (0.7.2) ruby-enum (0.7.2)
i18n i18n
rubyzip (1.2.2) ruby_dep (1.5.0)
rubyzip (2.0.0)
safe_yaml (1.0.5) safe_yaml (1.0.5)
sass (3.7.3) sass (3.7.4)
sass-listen (~> 4.0.0) sass-listen (~> 4.0.0)
sass-listen (4.0.0) sass-listen (4.0.0)
rb-fsevent (~> 0.9, >= 0.9.4) rb-fsevent (~> 0.9, >= 0.9.4)
rb-inotify (~> 0.9, >= 0.9.7) rb-inotify (~> 0.9, >= 0.9.7)
sawyer (0.8.1) sawyer (0.8.2)
addressable (>= 2.3.5, < 2.6) addressable (>= 2.3.5)
faraday (~> 0.8, < 1.0) faraday (> 0.8, < 2.0)
terminal-table (1.8.0) terminal-table (1.8.0)
unicode-display_width (~> 1.1, >= 1.1.1) unicode-display_width (~> 1.1, >= 1.1.1)
thread_safe (0.3.6) thread_safe (0.3.6)
@@ -233,14 +241,17 @@ GEM
ethon (>= 0.9.0) ethon (>= 0.9.0)
tzinfo (1.2.5) tzinfo (1.2.5)
thread_safe (~> 0.1) thread_safe (~> 0.1)
unicode-display_width (1.4.1) tzinfo-data (1.2019.3)
tzinfo (>= 1.0.0)
unicode-display_width (1.6.0)
PLATFORMS PLATFORMS
ruby ruby
x64-mingw32
DEPENDENCIES DEPENDENCIES
github-pages github-pages
tzinfo-data tzinfo-data
BUNDLED WITH BUNDLED WITH
2.0.1 2.0.2

View File

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

View File

@@ -3,7 +3,6 @@ module PrayerTracker.DataAccess
open FSharp.Control.Tasks.ContextInsensitive open FSharp.Control.Tasks.ContextInsensitive
open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore
open Microsoft.FSharpLu
open PrayerTracker.Entities open PrayerTracker.Entities
open System.Collections.Generic open System.Collections.Generic
open System.Linq open System.Linq
@@ -11,17 +10,29 @@ open System.Linq
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open Microsoft.FSharpLu
open System.Threading.Tasks
/// Central place to append sort criteria for prayer request queries /// 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 match sort with
| SortByDate -> | SortByDate ->
query.OrderByDescending(fun pr -> pr.updatedDate) query {
.ThenByDescending(fun pr -> pr.enteredDate) for req in q do
.ThenBy(fun pr -> pr.requestor) sortByDescending req.updatedDate
thenByDescending req.enteredDate
thenBy req.requestor
}
| SortByRequestor -> | SortByRequestor ->
query.OrderBy(fun pr -> pr.requestor) query {
.ThenByDescending(fun pr -> pr.updatedDate) for req in q do
.ThenByDescending(fun pr -> pr.enteredDate) 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 type AppDbContext with
@@ -44,15 +55,22 @@ type AppDbContext with
/// Find a church by its Id /// Find a church by its Id
member this.TryChurchById cId = member this.TryChurchById cId =
task { query {
let! church = this.Churches.AsNoTracking().FirstOrDefaultAsync (fun c -> c.churchId = cId) for ch in this.Churches.AsNoTracking () do
return Option.fromObject church where (ch.churchId = cId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Find all churches /// Find all churches
member this.AllChurches () = member this.AllChurches () =
task { 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 return List.ofSeq churches
} }
@@ -60,19 +78,24 @@ type AppDbContext with
/// Get a small group member by its Id /// Get a small group member by its Id
member this.TryMemberById mId = member this.TryMemberById mId =
task { query {
let! mbr = this.Members.AsNoTracking().FirstOrDefaultAsync (fun m -> m.memberId = mId) for mbr in this.Members.AsNoTracking () do
return Option.fromObject mbr where (mbr.memberId = mId)
select mbr
exactlyOneOrDefault
} }
|> toOptionTask
/// Find all members for a small group /// Find all members for a small group
member this.AllMembersForSmallGroup gId = member this.AllMembersForSmallGroup gId =
task { task {
let! mbrs = let q =
this.Members.AsNoTracking() query {
.Where(fun m -> m.smallGroupId = gId) for mbr in this.Members.AsNoTracking () do
.OrderBy(fun m -> m.memberName) where (mbr.smallGroupId = gId)
.ToListAsync () sortBy mbr.memberName
}
let! mbrs = q.ToListAsync ()
return List.ofSeq mbrs return List.ofSeq mbrs
} }
@@ -84,32 +107,44 @@ type AppDbContext with
/// Get a prayer request by its Id /// Get a prayer request by its Id
member this.TryRequestById reqId = member this.TryRequestById reqId =
task { query {
let! req = this.PrayerRequests.AsNoTracking().FirstOrDefaultAsync (fun pr -> pr.prayerRequestId = reqId) for req in this.PrayerRequests.AsNoTracking () do
return Option.fromObject req where (req.prayerRequestId = reqId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
// 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 = member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr : PrayerRequest seq =
let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock
upcast ( query {
this.PrayerRequests.AsNoTracking().Where(fun pr -> pr.smallGroupId = grp.smallGroupId) for req in this.PrayerRequests.AsNoTracking () do
where (req.smallGroupId = grp.smallGroupId)
}
|> function |> function
| query when activeOnly -> | q when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query.Where(fun pr -> query {
( pr.updatedDate > asOf for req in q do
|| pr.expiration = Manual where ( ( req.updatedDate > asOf
|| pr.requestType = LongTermRequest || req.expiration = Manual
|| pr.requestType = Expecting) || req.requestType = LongTermRequest
&& pr.expiration <> Forced) || req.requestType = Expecting)
| query -> query && req.expiration <> Forced)
}
| q -> q
|> reqSort grp.preferences.requestSort |> reqSort grp.preferences.requestSort
|> function |> function
| query -> | q ->
match activeOnly with match activeOnly with
| true -> query.Skip 0 | true -> upcast q
| false -> query.Skip((pageNbr - 1) * grp.preferences.pageSize).Take grp.preferences.pageSize) | 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 /// Count prayer requests for the given small group Id
member this.CountRequestsBySmallGroup gId = member this.CountRequestsBySmallGroup gId =
@@ -120,57 +155,63 @@ type AppDbContext with
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId) this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId)
/// Get all (or active) requests for a small group as of now or the specified date /// 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 = member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr : PrayerRequest seq =
let pgSz = grp.preferences.pageSize let pgSz = grp.preferences.pageSize
let skip = (pageNbr - 1) * pgSz let toSkip = (pageNbr - 1) * pgSz
let sql = let sql =
""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1} """ SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
UNION UNION
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}"""
|> RawSqlString
let like = sprintf "%%%s%%" let like = sprintf "%%%s%%"
upcast ( this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm).AsNoTracking ()
this.PrayerRequests.FromSql(sql, grp.smallGroupId, like searchTerm).AsNoTracking ()
|> reqSort grp.preferences.requestSort |> reqSort grp.preferences.requestSort
|> function query -> (query.Skip skip).Take pgSz) |> function
| q ->
upcast query {
for req in q do
skip toSkip
take pgSz
}
(*-- SMALL GROUP EXTENSIONS --*) (*-- SMALL GROUP EXTENSIONS --*)
/// Find a small group by its Id /// Find a small group by its Id
member this.TryGroupById gId = member this.TryGroupById gId =
task { query {
let! grp = for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.preferences) do
this.SmallGroups.AsNoTracking() where (grp.smallGroupId = gId)
.Include(fun sg -> sg.preferences) exactlyOneOrDefault
.FirstOrDefaultAsync (fun sg -> sg.smallGroupId = gId)
return Option.fromObject grp
} }
|> toOptionTask
/// Get small groups that are public or password protected /// Get small groups that are public or password protected
member this.PublicAndProtectedGroups () = member this.PublicAndProtectedGroups () =
task { task {
let! grps = let smallGroups = this.SmallGroups.AsNoTracking().Include(fun sg -> sg.preferences).Include (fun sg -> sg.church)
this.SmallGroups.AsNoTracking() let q =
.Include(fun sg -> sg.preferences) query {
.Include(fun sg -> sg.church) for grp in smallGroups do
.Where(fun sg -> where ( grp.preferences.isPublic
sg.preferences.isPublic || (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")) || (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> ""))
.OrderBy(fun sg -> sg.church.name) sortBy grp.church.name
.ThenBy(fun sg -> sg.name) thenBy grp.name
.ToListAsync () }
let! grps = q.ToListAsync ()
return List.ofSeq grps return List.ofSeq grps
} }
/// Get small groups that are password protected /// Get small groups that are password protected
member this.ProtectedGroups () = member this.ProtectedGroups () =
task { task {
let! grps = let q =
this.SmallGroups.AsNoTracking() query {
.Include(fun sg -> sg.church) for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
.Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "") where (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> "")
.OrderBy(fun sg -> sg.church.name) sortBy grp.church.name
.ThenBy(fun sg -> sg.name) thenBy grp.name
.ToListAsync () }
let! grps = q.ToListAsync ()
return List.ofSeq grps return List.ofSeq grps
} }
@@ -190,38 +231,37 @@ type AppDbContext with
/// Get a small group list by their Id, with their church prepended to their name /// Get a small group list by their Id, with their church prepended to their name
member this.GroupList () = member this.GroupList () =
task { task {
let! grps = let q =
this.SmallGroups.AsNoTracking() query {
.Include(fun sg -> sg.church) for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
.OrderBy(fun sg -> sg.church.name) sortBy grp.church.name
.ThenBy(fun sg -> sg.name) thenBy grp.name
.ToListAsync () }
let! grps = q.ToListAsync ()
return grps 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 |> List.ofSeq
} }
/// Log on a small group /// Log on a small group
member this.TryGroupLogOnByPassword gId pw = member this.TryGroupLogOnByPassword gId pw =
task { task {
let! grp = this.TryGroupById gId match! this.TryGroupById gId with
match grp with
| None -> return None | None -> return None
| Some g -> | Some grp ->
match pw = g.preferences.groupPassword with match pw = grp.preferences.groupPassword with
| true -> return grp | true -> return Some grp
| _ -> return None | _ -> return None
} }
/// Check a cookie log on for a small group /// Check a cookie log on for a small group
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) =
task { task {
let! grp = this.TryGroupById gId match! this.TryGroupById gId with
match grp with
| None -> return None | None -> return None
| Some g -> | Some grp ->
match pwHash = hasher g.preferences.groupPassword with match pwHash = hasher grp.preferences.groupPassword with
| true -> return grp | true -> return Some grp
| _ -> return None | _ -> return None
} }
@@ -233,15 +273,22 @@ type AppDbContext with
/// Get a time zone by its Id /// Get a time zone by its Id
member this.TryTimeZoneById tzId = member this.TryTimeZoneById tzId =
task { query {
let! tz = this.TimeZones.FirstOrDefaultAsync (fun t -> t.timeZoneId = tzId) for tz in this.TimeZones do
return Option.fromObject tz where (tz.timeZoneId = tzId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get all time zones /// Get all time zones
member this.AllTimeZones () = member this.AllTimeZones () =
task { 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 return List.ofSeq tzs
} }
@@ -249,67 +296,79 @@ type AppDbContext with
/// Find a user by its Id /// Find a user by its Id
member this.TryUserById uId = member this.TryUserById uId =
task { query {
let! user = this.Users.AsNoTracking().FirstOrDefaultAsync (fun u -> u.userId = uId) for usr in this.Users.AsNoTracking () do
return Option.fromObject user where (usr.userId = uId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Find a user by its e-mail address and authorized small group /// Find a user by its e-mail address and authorized small group
member this.TryUserByEmailAndGroup email gId = member this.TryUserByEmailAndGroup email gId =
task { query {
let! user = for usr in this.Users.AsNoTracking () do
this.Users.AsNoTracking().FirstOrDefaultAsync (fun u -> where (usr.emailAddress = email && usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
u.emailAddress = email exactlyOneOrDefault
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
return Option.fromObject user
} }
|> toOptionTask
/// Find a user by its Id (tracked entity), eagerly loading the user's groups /// Find a user by its Id (tracked entity), eagerly loading the user's groups
member this.TryUserByIdWithGroups uId = member this.TryUserByIdWithGroups uId =
task { query {
let! user = this.Users.Include(fun u -> u.smallGroups).FirstOrDefaultAsync (fun u -> u.userId = uId) for usr in this.Users.AsNoTracking().Include (fun u -> u.smallGroups) do
return Option.fromObject user where (usr.userId = uId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get a list of all users /// Get a list of all users
member this.AllUsers () = member this.AllUsers () =
task { 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 return List.ofSeq usrs
} }
/// Get all PrayerTracker users as members (used to send e-mails) /// Get all PrayerTracker users as members (used to send e-mails)
member this.AllUsersAsMembers () = member this.AllUsersAsMembers () =
task { task {
let! usrs = let q =
this.Users.AsNoTracking().OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync () query {
return usrs for usr in this.Users.AsNoTracking () do
|> Seq.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName }) sortBy usr.lastName
|> List.ofSeq thenBy usr.firstName
select { Member.empty with email = usr.emailAddress; memberName = usr.fullName }
}
let! usrs = q.ToListAsync ()
return List.ofSeq usrs
} }
/// Find a user based on their credentials /// Find a user based on their credentials
member this.TryUserLogOnByPassword email pwHash gId = member this.TryUserLogOnByPassword email pwHash gId =
task { query {
let! user = for usr in this.Users.AsNoTracking () do
this.Users.FirstOrDefaultAsync (fun u -> where ( usr.emailAddress = email
u.emailAddress = email && usr.passwordHash = pwHash
&& u.passwordHash = pwHash && usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) exactlyOneOrDefault
return Option.fromObject user
} }
|> toOptionTask
/// Find a user based on credentials stored in a cookie /// Find a user based on credentials stored in a cookie
member this.TryUserLogOnByCookie uId gId pwHash = member this.TryUserLogOnByCookie uId gId pwHash =
task { task {
let! user = this.TryUserByIdWithGroups uId match! this.TryUserByIdWithGroups uId with
match user with
| None -> return None | None -> return None
| Some u -> | Some usr ->
match pwHash = u.passwordHash && u.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with match pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with
| true -> | true ->
this.Entry<User>(u).State <- EntityState.Detached this.Entry<User>(usr).State <- EntityState.Detached
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() } return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }
| _ -> return None | _ -> return None
} }

View File

@@ -545,13 +545,13 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
match this.requestType with match this.requestType with
| LongTermRequest | LongTermRequest
| Expecting -> false | 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? /// Is an update required for this long-term request?
member this.updateRequired curr expDays updWeeks = member this.updateRequired curr expDays updWeeks =
match this.isExpired curr expDays with match this.isExpired curr expDays with
| true -> false | 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 /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =

View File

@@ -1,9 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework> <TargetFramework>net5.0</TargetFramework>
<AssemblyVersion>7.3.0.0</AssemblyVersion>
<FileVersion>7.3.0.0</FileVersion>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -16,14 +14,10 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" /> <PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
<PackageReference Include="Microsoft.FSharpLu" Version="0.10.30" /> <PackageReference Include="Microsoft.FSharpLu" Version="0.11.6" />
<PackageReference Include="NodaTime" Version="2.4.4" /> <PackageReference Include="NodaTime" Version="2.4.7" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="2.2.0" /> <PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.1.2" />
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" /> <PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project> </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" Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired"
} }
test "isExpired returns false for non-expired requests" { test "isExpired returns false for non-expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddDays -5. } let now = DateTime.Now
Expect.isFalse (req.isExpired DateTime.Now 7) "A request updated 5 days ago should not be considered expired" 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" { test "isExpired returns true for expired requests" {
let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddDays -8. } let now = DateTime.Now
Expect.isTrue (req.isExpired DateTime.Now 7) "A request updated 8 days ago should be considered expired" 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" { test "updateRequired returns false for expired requests" {
let req = { PrayerRequest.empty with expiration = Forced } let req = { PrayerRequest.empty with expiration = Forced }
Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update" Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update"
} }
test "updateRequired returns false when an update is not required for an active request" { test "updateRequired returns false when an update is not required for an active request" {
let now = DateTime.Now
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = LongTermRequest 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" "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" { test "updateRequired returns true when an update is required for an active request" {
let now = DateTime.Now
let req = let req =
{ PrayerRequest.empty with { PrayerRequest.empty with
requestType = LongTermRequest 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)" "An active request updated 34 days ago should require an update (past 28 days)"
} }
] ]

View File

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

View File

@@ -660,19 +660,19 @@ let userLogOnTests =
let userMessageTests = let userMessageTests =
testList "UserMessage" [ testList "UserMessage" [
test "Error is constructed properly" { test "Error is constructed properly" {
let msg = UserMessage.Error let msg = UserMessage.error
Expect.equal msg.level "ERROR" "Incorrect message level" Expect.equal msg.level "ERROR" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"
} }
test "Warning is constructed properly" { test "Warning is constructed properly" {
let msg = UserMessage.Warning let msg = UserMessage.warning
Expect.equal msg.level "WARNING" "Incorrect message level" Expect.equal msg.level "WARNING" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"
} }
test "Info is constructed properly" { test "Info is constructed properly" {
let msg = UserMessage.Info let msg = UserMessage.info
Expect.equal msg.level "Info" "Incorrect message level" Expect.equal msg.level "Info" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"

View File

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

View File

@@ -28,7 +28,7 @@ let space = rawText " "
let icon name = i [ _class "material-icons" ] [ rawText name ] let icon name = i [ _class "material-icons" ] [ rawText name ]
/// Generate a Material Design icon, specifying the point size (must be defined in CSS) /// 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 /// Generate a CSRF prevention token
let csrfToken (ctx : HttpContext) = let csrfToken (ctx : HttpContext) =
@@ -52,27 +52,27 @@ let tableSummary itemCount (s : IStringLocalizer) =
let namedColorList name selected attrs (s : IStringLocalizer) = let namedColorList name selected attrs (s : IStringLocalizer) =
/// The list of HTML named colors (name, display, text color) /// The list of HTML named colors (name, display, text color)
seq { seq {
yield ("aqua", s.["Aqua"], "black") ("aqua", s.["Aqua"], "black")
yield ("black", s.["Black"], "white") ("black", s.["Black"], "white")
yield ("blue", s.["Blue"], "white") ("blue", s.["Blue"], "white")
yield ("fuchsia", s.["Fuchsia"], "black") ("fuchsia", s.["Fuchsia"], "black")
yield ("gray", s.["Gray"], "white") ("gray", s.["Gray"], "white")
yield ("green", s.["Green"], "white") ("green", s.["Green"], "white")
yield ("lime", s.["Lime"], "black") ("lime", s.["Lime"], "black")
yield ("maroon", s.["Maroon"], "white") ("maroon", s.["Maroon"], "white")
yield ("navy", s.["Navy"], "white") ("navy", s.["Navy"], "white")
yield ("olive", s.["Olive"], "white") ("olive", s.["Olive"], "white")
yield ("purple", s.["Purple"], "white") ("purple", s.["Purple"], "white")
yield ("red", s.["Red"], "black") ("red", s.["Red"], "black")
yield ("silver", s.["Silver"], "black") ("silver", s.["Silver"], "black")
yield ("teal", s.["Teal"], "white") ("teal", s.["Teal"], "white")
yield ("white", s.["White"], "black") ("white", s.["White"], "black")
yield ("yellow", s.["Yellow"], "black") ("yellow", s.["Yellow"], "black")
} }
|> Seq.map (fun color -> |> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color let (colorName, dispText, txtColor) = color
option [ yield _value colorName 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 -> () ] [ match colorName = selected with true -> yield _selected | false -> () ] [
encodedText (dispText.Value.ToLower ()) encodedText (dispText.Value.ToLower ())
]) ])
@@ -81,23 +81,23 @@ let namedColorList name selected attrs (s : IStringLocalizer) =
/// Generate an input[type=radio] that is selected if its value is the current value /// Generate an input[type=radio] that is selected if its value is the current value
let radio name domId value current = let radio name domId value current =
input [ yield _type "radio" input [ _type "radio"
yield _name name _name name
yield _id domId _id domId
yield _value value _value value
match value = current with true -> yield _checked | false -> () ] match value = current with true -> _checked | false -> () ]
/// Generate a select list with the current value selected /// Generate a select list with the current value selected
let selectList name selected attrs items = let selectList name selected attrs items =
items items
|> Seq.map (fun (value, text) -> |> Seq.map (fun (value, text) ->
option [ yield _value value option [ _value value
match value = selected with true -> yield _selected | false -> () ] [ encodedText text ]) match value = selected with true -> _selected | false -> () ] [ encodedText text ])
|> List.ofSeq |> List.ofSeq
|> select (List.concat [ [ _name name; _id name ]; attrs ]) |> select (List.concat [ [ _name name; _id name ]; attrs ])
/// Generate the text for a default entry at the top of a select list /// 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 /// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
@@ -115,7 +115,7 @@ let blockquote = tag "blockquote"
/// role attribute /// role attribute
let _role = attr "role" let _role = attr "role"
/// aria-* attribute /// aria-* attribute
let _aria typ = attr (sprintf "aria-%s" typ) let _aria typ = attr $"aria-{typ}"
/// onclick attribute /// onclick attribute
let _onclick = attr "onclick" let _onclick = attr "onclick"
/// onsubmit attribute /// onsubmit attribute

View File

@@ -32,12 +32,12 @@ let error code vi =
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]] raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]]
] ]
] ]
yield br [] br []
yield hr [] hr []
yield div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [ 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"]) img [ _src $"""/img/%A{s.["footer_en"]}.png"""
_alt (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"]) _alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_title (sprintf "%A %A" s.["PrayerTracker"] s.["from Bit Badger Solutions"]) _title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ] _style "vertical-align:text-bottom;" ]
str vi.version str vi.version
] ]
@@ -203,7 +203,7 @@ let termsOfService vi =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let ppLink = let ppLink =
a [ _href "/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ] a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|> (renderHtmlNode >> HtmlString) |> (renderHtmlNode >> HtmlString)
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ] [ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]

View File

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

View File

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

View File

@@ -15,18 +15,18 @@ open System.Text
let edit (m : EditRequest) today ctx vi = let edit (m : EditRequest) today ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Request" | false -> "Edit Request" 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 csrfToken ctx
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ] input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
yield div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ] label [ _for "requestType" ] [ locStr s.["Request Type"] ]
ReferenceList.requestTypeList s ReferenceList.requestTypeList s
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" m.requestType [ _required; _autofocus ] |> selectList "requestType" m.requestType [ _required; _autofocus ]
] ]
yield div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ] label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ]
input [ _type "text" input [ _type "text"
_name "requestor" _name "requestor"
@@ -35,12 +35,12 @@ let edit (m : EditRequest) today ctx vi =
] ]
match m.isNew () with match m.isNew () with
| true -> | true ->
yield div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "enteredDate" ] [ locStr s.["Date"] ] label [ _for "enteredDate" ] [ locStr s.["Date"] ]
input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ] input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ]
] ]
| false -> | false ->
yield div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
br [] br []
input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ] input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ]
@@ -55,7 +55,7 @@ let edit (m : EditRequest) today ctx vi =
label [] [ locStr s.["Expiration"] ] label [] [ locStr s.["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ()) ReferenceList.expirationList s ((m.isNew >> not) ())
|> List.map (fun exp -> |> List.map (fun exp ->
let radioId = sprintf "expiration_%s" (fst exp) let radioId = $"expiration_{fst exp}"
span [ _class "text-nowrap" ] [ span [ _class "text-nowrap" ] [
radio "expiration" radioId (fst exp) m.expiration radio "expiration" radioId (fst exp) m.expiration
label [ _for radioId ] [ locStr (snd exp) ] 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 /// View for the request e-mail results page
let email m vi = let email m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = 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 prefs = m.listGroup.preferences
let addresses = let addresses =
m.recipients m.recipients
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email)) |> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
(StringBuilder ()) (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"] locStr s.["The request list was sent to the following people, via individual e-mails"]
rawText ":" rawText ":"
br [] br []
@@ -118,7 +118,7 @@ let lists (grps : SmallGroup list) vi =
let l = I18N.forView "Requests/Lists" let l = I18N.forView "Requests/Lists"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ yield p [] [ [ p [] [
raw l.["The groups listed below have either public or password-protected request lists."] raw l.["The groups listed below have either public or password-protected request lists."]
space space
raw l.["Those with list icons are public, and those with log on icons are password-protected."] 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."] raw l.["Click the appropriate icon to log on or view the request list."]
] ]
match grps.Length with 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 -> | count ->
yield tableSummary count s tableSummary count s
yield table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s.["Actions"] ]
@@ -143,9 +143,9 @@ let lists (grps : SmallGroup list) vi =
tr [] [ tr [] [
match grp.preferences.isPublic with match grp.preferences.isPublic with
| true -> | 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 -> | 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" ] [ icon "verified_user" ]
|> List.singleton |> List.singleton
|> td [] |> td []
@@ -179,8 +179,8 @@ let maintain m (ctx : HttpContext) vi =
m.requests m.requests
|> Seq.map (fun req -> |> Seq.map (fun req ->
let reqId = flatGuid req.prayerRequestId let reqId = flatGuid req.prayerRequestId
let reqText = Utils.htmlToPlainText req.text let reqText = htmlToPlainText req.text
let delAction = sprintf "/prayer-request/%s/delete" reqId let delAction = $"/web/prayer-request/{reqId}/delete"
let delPrompt = let delPrompt =
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.", [ s.["Are you sure you want to delete this {0}? This action cannot be undone.",
s.["Prayer Request"].Value.ToLower() ] s.["Prayer Request"].Value.ToLower() ]
@@ -192,49 +192,48 @@ let maintain m (ctx : HttpContext) vi =
|> String.concat "" |> String.concat ""
tr [] [ tr [] [
td [] [ 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" ] [ icon "edit" ]
match req.isExpired now m.smallGroup.preferences.daysToExpire with match req.isExpired now m.smallGroup.preferences.daysToExpire with
| true -> | true ->
yield a [ _href (sprintf "/prayer-request/%s/restore" reqId) a [ _href $"/web/prayer-request/{reqId}/restore"
_title l.["Restore This Inactive Request"].Value ] _title l.["Restore This Inactive Request"].Value ]
[ icon "visibility" ] [ icon "visibility" ]
| false -> | false ->
yield a [ _href (sprintf "/prayer-request/%s/expire" reqId) a [ _href $"/web/prayer-request/{reqId}/expire"
_title l.["Expire This Request Immediately"].Value ] _title l.["Expire This Request Immediately"].Value ]
[ icon "visibility_off" ] [ icon "visibility_off" ]
yield a [ _href delAction; _title l.["Delete This Request"].Value; a [ _href delAction; _title l.["Delete This Request"].Value;
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [ updReq req ] [ 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 [] [ locStr typs.[req.requestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
td [] [ td [] [
yield match reqText.Length with
match 60 > reqText.Length with | len when len < 60 -> rawText reqText
| true -> rawText reqText | _ -> rawText $"{reqText.[0..59]}&hellip;"
| false -> rawText (sprintf "%s&hellip;" reqText.[0..59])
] ]
]) ])
|> List.ofSeq |> List.ofSeq
[ yield div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
yield br [] br []
yield a [ _href (sprintf "/prayer-request/%s/edit" emptyGuid); _title s.["Add a New Request"].Value ] a [ _href $"/web/prayer-request/{emptyGuid}/edit"; _title s.["Add a New Request"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ]
yield rawText " &nbsp; &nbsp; &nbsp; " rawText " &nbsp; &nbsp; &nbsp; "
yield a [ _href "/prayer-requests/view"; _title s.["View Prayer Request List"].Value ] a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ] [ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ]
match m.searchTerm with match m.searchTerm with
| Some _ -> | Some _ ->
yield rawText " &nbsp; &nbsp; &nbsp; " rawText " &nbsp; &nbsp; &nbsp; "
yield a [ _href "/prayer-requests"; _title l.["Clear Search Criteria"].Value ] a [ _href "/web/prayer-requests"; _title l.["Clear Search Criteria"].Value ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ] [ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ]
| None -> () | 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" input [ _type "text"
_name "search" _name "search"
_placeholder l.["Search requests..."].Value _placeholder l.["Search requests..."].Value
@@ -243,12 +242,12 @@ let maintain m (ctx : HttpContext) vi =
space space
submit [] "search" s.["Search"] submit [] "search" s.["Search"]
] ]
yield br [] br []
yield tableSummary requests.Length s tableSummary requests.Length s
match requests.Length with match requests.Length with
| 0 -> () | 0 -> ()
| _ -> | _ ->
yield table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s.["Actions"] ]
@@ -260,40 +259,41 @@ let maintain m (ctx : HttpContext) vi =
] ]
tbody [] requests tbody [] requests
] ]
yield div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
yield br [] br []
match m.onlyActive with match m.onlyActive with
| Some true -> | Some true ->
yield raw l.["Inactive requests are currently not shown"] raw l.["Inactive requests are currently not shown"]
yield br [] br []
yield a [ _href "/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ] a [ _href "/web/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ]
| _ -> | _ ->
match Option.isSome m.onlyActive with match Option.isSome m.onlyActive with
| true -> | true ->
yield raw l.["Inactive requests are currently shown"] raw l.["Inactive requests are currently shown"]
yield br [] br []
yield a [ _href "/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ] a [ _href "/web/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ]
yield br [] br []
yield br [] br []
| false -> () | false -> ()
let srch = [ match m.searchTerm with Some s -> yield "search", s | None -> () ] let srch = [ match m.searchTerm with Some s -> "search", s | None -> () ]
let url = match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/prayer-requests%s"
let pg = defaultArg m.pageNbr 1 let pg = defaultArg m.pageNbr 1
let url =
match m.onlyActive with Some true | None -> "" | _ -> "/inactive" |> sprintf "/web/prayer-requests%s"
match pg with match pg with
| 1 -> () | 1 -> ()
| _ -> | _ ->
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] // button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch let withPage = match pg with 2 -> 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"] ] [ icon "keyboard_arrow_left"; space; raw l.["Previous Page"] ]
yield rawText " &nbsp; &nbsp; " rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with match requests.Length = m.smallGroup.preferences.pageSize with
| true -> | 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" ] [ raw l.["Next Page"]; space; icon "keyboard_arrow_right" ]
| false -> () | false -> ()
] ]
yield form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ] form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
] ]
|> Layout.Content.wide |> Layout.Content.wide
|> Layout.standard vi (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests") |> Layout.standard vi (match m.searchTerm with Some _ -> "Search Results" | None -> "Maintain Requests")
@@ -302,14 +302,14 @@ let maintain m (ctx : HttpContext) vi =
/// View for the printable prayer request list /// View for the printable prayer request list
let print m version = let print m version =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s %s" s.["Prayer Requests"].Value m.listGroup.name let pageTitle = $"""{s.["Prayer Requests"].Value} {m.listGroup.name}"""
let imgAlt = sprintf "%s %s" s.["PrayerTracker"].Value s.["from Bit Badger Solutions"].Value let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}"""
article [] [ article [] [
rawText (m.asHtml s) rawText (m.asHtml s)
br [] br []
hr [] hr []
div [ _style "font-size:70%;font-family:@Model.ListGroup.preferences.listFonts;" ] [ div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
img [ _src (sprintf "/img/%s.png" s.["footer_en"].Value) img [ _src $"""/img/{s.["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;" _style "vertical-align:text-bottom;"
_alt imgAlt _alt imgAlt
_title imgAlt ] _title imgAlt ]
@@ -323,19 +323,19 @@ let print m version =
/// View for the prayer request list /// View for the prayer request list
let view m vi = let view m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = 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 spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = m.date.ToString "yyyy-MM-dd" let dtString = m.date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
yield br [] br []
yield a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/print/%s" dtString) _href $"/web/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [ _title s.["View Printable"].Value ] [
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"] icon "print"; rawText " &nbsp;"; locStr s.["View Printable"]
] ]
match m.canEmail with match m.canEmail with
| true -> | true ->
yield spacer spacer
match m.date.DayOfWeek = DayOfWeek.Sunday with match m.date.DayOfWeek = DayOfWeek.Sunday with
| true -> () | true -> ()
| false -> | false ->
@@ -344,21 +344,21 @@ let view m vi =
| true -> date | true -> date
| false -> findSunday (date.AddDays 1.) | false -> findSunday (date.AddDays 1.)
let sunday = findSunday m.date let sunday = findSunday m.date
yield a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/view/%s" (sunday.ToString "yyyy-MM-dd")) _href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s.["List for Next Sunday"].Value ] [ _title s.["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"] 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 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" a [ _class "pt-icon-link"
_href (sprintf "/prayer-requests/email/%s" dtString) _href $"/web/prayer-requests/email/{dtString}"
_title s.["Send via E-mail"].Value _title s.["Send via E-mail"].Value
_onclick (sprintf "return PT.requests.view.promptBeforeEmail('%s')" emailPrompt) ] [ _onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"] icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"]
] ]
yield spacer spacer
yield a [ _class "pt-icon-link"; _href "/prayer-requests"; _title s.["Maintain Prayer Requests"].Value ] [ 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"] icon "compare_arrows"; rawText " &nbsp;"; locStr s.["Maintain Prayer Requests"]
] ]
| false -> () | false -> ()

View File

@@ -1,9 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework> <TargetFramework>net5.0</TargetFramework>
<AssemblyVersion>7.3.0.0</AssemblyVersion>
<FileVersion>7.0.0.0</FileVersion>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -20,13 +18,13 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="3.6.0" /> <PackageReference Include="Giraffe" Version="4.0.1" />
<PackageReference Include="MailKit" Version="2.1.3" /> <PackageReference Include="MailKit" Version="2.5.1" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="Newtonsoft.Json" Version="12.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="12.0.3" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -63,8 +61,4 @@
</EmbeddedResource> </EmbeddedResource>
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.6.2" />
</ItemGroup>
</Project> </Project>

View File

@@ -11,9 +11,9 @@ open System.IO
let announcement isAdmin ctx vi = let announcement isAdmin ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let reqTypes = ReferenceList.requestTypeList s let reqTypes = ReferenceList.requestTypeList s
[ form [ _action "/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [ [ form [ _action "/web/small-group/announcement/send"; _method "post"; _class "pt-center-columns" ] [
yield csrfToken ctx csrfToken ctx
yield div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [ div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s.["Announcement Text"] ] label [ _for "text" ] [ locStr s.["Announcement Text"] ]
textarea [ _name "text"; _id "text"; _autofocus ] [] textarea [ _name "text"; _id "text"; _autofocus ] []
@@ -21,7 +21,7 @@ let announcement isAdmin ctx vi =
] ]
match isAdmin with match isAdmin with
| true -> | true ->
yield div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s.["Send Announcement to"]; rawText ":" ] label [] [ locStr s.["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
@@ -32,15 +32,14 @@ let announcement isAdmin ctx vi =
] ]
] ]
] ]
| false -> | false -> input [ _type "hidden"; _name "sendToClass"; _value "Y" ]
yield input [ _type "hidden"; _name "sendToClass"; _value "Y" ] div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
yield div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ] input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ]
label [ _for "addToRequestList" ] [ locStr s.["Add to Request List"] ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ] label [ _for "requestType" ] [ locStr s.["Request Type"] ]
reqTypes reqTypes
@@ -49,7 +48,7 @@ let announcement isAdmin ctx vi =
|> selectList "requestType" "Announcement" [] |> 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)" ] 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 edit (m : EditSmallGroup) (churches : Church list) ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group" | false -> "Edit Group" let pageTitle = 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 csrfToken ctx
input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ] input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
@@ -88,7 +87,7 @@ let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s.["Church"] ] label [ _for "churchId" ] [ locStr s.["Church"] ]
seq { seq {
yield "", selectDefault s.["Select Church"].Value "", selectDefault s.["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name) yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name)
} }
|> selectList "churchId" (flatGuid m.churchId) [ _required ] |> selectList "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 editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Group Member" | false -> "Edit Group Member" let pageTitle = 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; }" ] style [ _scoped ] [ rawText "#memberName { width: 15rem; } #emailAddress { width: 20rem; }" ]
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "memberId"; _value (flatGuid m.memberId) ] 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 /// View for the small group log on page
let logOn (grps : SmallGroup list) grpId ctx vi = let logOn (grps : SmallGroup list) grpId ctx vi =
let s = I18N.localizer.Force () 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 csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ] label [ _for "smallGroupId" ] [ locStr s.["Group"] ]
seq { seq {
match grps.Length with 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 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 ] |> selectList "smallGroupId" grpId [ _required ]
] ]
@@ -191,15 +190,15 @@ let maintain (grps : SmallGroup list) ctx vi =
grps grps
|> List.map (fun g -> |> List.map (fun g ->
let grpId = flatGuid g.smallGroupId 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.", 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 [] [ tr [] [
td [] [ 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 a [ _href delAction
_title s.["Delete This Group"].Value _title s.["Delete This Group"].Value
_onclick (sprintf "return PT.confirmDelete('%s','%s')" delAction delPrompt) ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str g.name ] td [] [ str g.name ]
@@ -210,7 +209,7 @@ let maintain (grps : SmallGroup list) ctx vi =
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] 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" icon "add_circle"
rawText " &nbsp;" rawText " &nbsp;"
locStr s.["Add a New Group"] locStr s.["Add a New Group"]
@@ -245,18 +244,18 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
mbrs mbrs
|> List.map (fun mbr -> |> List.map (fun mbr ->
let mbrId = flatGuid mbr.memberId let mbrId = flatGuid mbr.memberId
let delAction = sprintf "/small-group/member/%s/delete" mbrId let delAction = $"/web/small-group/member/{mbrId}/delete"
let delPrompt = let delPrompt =
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]] s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]]
.Value .Value
.Replace("?", sprintf " (%s)?" mbr.memberName) .Replace("?", $" ({mbr.memberName})?")
tr [] [ tr [] [
td [] [ 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" ] [ icon "edit" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This Group Member"].Value _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" ] [ icon "delete_forever" ]
] ]
td [] [ str mbr.memberName ] td [] [ str mbr.memberName ]
@@ -267,7 +266,7 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
] ]
[ div [ _class"pt-center-text" ] [ [ div [ _class"pt-center-text" ] [
br [] 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"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Group Member"] ]
br [] br []
br [] br []
@@ -292,11 +291,11 @@ let overview m vi =
locStr s.["Quick Actions"] locStr s.["Quick Actions"]
] ]
div [] [ 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 [] 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 [] 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 [] [ section [] [
@@ -305,21 +304,21 @@ let overview m vi =
locStr s.["Prayer Requests"] locStr s.["Prayer Requests"]
] ]
div [] [ div [] [
yield p [ _class "pt-center-text" ] [ p [ _class "pt-center-text" ] [
strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s.["Active Requests"] ] strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s.["Active Requests"] ]
] ]
yield hr [] hr []
for cat in m.activeReqsByCat do for cat in m.activeReqsByCat do
yield str (cat.Value.ToString "N0") str (cat.Value.ToString "N0")
yield space space
yield locStr typs.[cat.Key] locStr typs.[cat.Key]
yield br [] br []
yield br [] br []
yield str (m.allReqs.ToString "N0") str (m.allReqs.ToString "N0")
yield space space
yield locStr s.["Total Requests"] locStr s.["Total Requests"]
yield hr [] hr []
yield a [ _href "/prayer-requests/maintain" ] [ a [ _href "/web/prayer-requests/maintain" ] [
icon "compare_arrows" icon "compare_arrows"
linkSpacer linkSpacer
locStr s.["Maintain Prayer Requests"] locStr s.["Maintain Prayer Requests"]
@@ -334,7 +333,7 @@ let overview m vi =
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s.["Members"] ] strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s.["Members"] ]
hr [] 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" let l = I18N.forView "SmallGroup/Preferences"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw 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%; } }" ] 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 csrfToken ctx
fieldset [] [ fieldset [] [
@@ -406,7 +405,7 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s.["E-mail Format"] ] label [ _for "defaultEmailType" ] [ locStr s.["E-mail Format"] ]
seq { seq {
yield "", selectDefault s.["Select"].Value "", selectDefault s.["Select"].Value
yield! ReferenceList.emailTypeList HtmlFormat s yield! ReferenceList.emailTypeList HtmlFormat s
|> Seq.skip 1 |> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value) |> 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 radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType
label [ _for "headingLineType_Name" ] [ locStr s.["Named Color"] ] label [ _for "headingLineType_Name" ] [ locStr s.["Named Color"] ]
namedColorList "headingLineColor" m.headingLineColor namedColorList "headingLineColor" m.headingLineColor
[ yield _id "headingLineColor_Select" [ _id "headingLineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> yield _disabled | false -> () ] s match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ())
radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType
label [ _for "headingLineType_RGB" ] [ locStr s.["Custom Color"] ] label [ _for "headingLineType_RGB" ] [ locStr s.["Custom Color"] ]
input [ yield _type "color" input [ _type "color"
yield _name "headingLineColor" _name "headingLineColor"
yield _id "headingLineColor_Color" _id "headingLineColor_Color"
yield _value m.headingLineColor _value m.headingLineColor
match m.headingLineColor.StartsWith "#" with true -> () | false -> yield _disabled ] 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 radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType
label [ _for "headingTextType_Name" ] [ locStr s.["Named Color"] ] label [ _for "headingTextType_Name" ] [ locStr s.["Named Color"] ]
namedColorList "headingTextColor" m.headingTextColor namedColorList "headingTextColor" m.headingTextColor
[ yield _id "headingTextColor_Select" [ _id "headingTextColor_Select"
match m.headingTextColor.StartsWith "#" with true -> yield _disabled | false -> () ] s match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ())
radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType
label [ _for "headingTextType_RGB" ] [ locStr s.["Custom Color"] ] label [ _for "headingTextType_RGB" ] [ locStr s.["Custom Color"] ]
input [ yield _type "color" input [ _type "color"
yield _name "headingTextColor" _name "headingTextColor"
yield _id "headingTextColor_Color" _id "headingTextColor_Color"
yield _value m.headingTextColor _value m.headingTextColor
match m.headingTextColor.StartsWith "#" with true -> () | false -> yield _disabled ] 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" ] [ div [ _class "pt-field" ] [
label [ _for "timeZone" ] [ locStr s.["Time Zone"] ] label [ _for "timeZone" ] [ locStr s.["Time Zone"] ]
seq { seq {
yield "", selectDefault s.["Select"].Value "", selectDefault s.["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value) yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
} }
|> selectList "timeZone" m.timeZone [ _required ] |> selectList "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"] ] label [ _for "viz_Password" ] [ locStr s.["Password Protected"] ]
] ]
] ]
div [ yield _id "divClassPassword" div [ _id "divClassPassword"
match m.listVisibility = RequestVisibility.passwordProtected with match m.listVisibility = RequestVisibility.passwordProtected with
| true -> yield _class "pt-field-row pt-fadeable pt-show" | true -> _class "pt-field-row pt-fadeable pt-show"
| false -> yield _class "pt-field-row pt-fadeable" | false -> _class "pt-field-row pt-fadeable"
] [ ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "groupPassword" ] [ locStr s.["Group Password (Used to Read Online)"] ] label [ _for "groupPassword" ] [ locStr s.["Group Password (Used to Read Online)"] ]
@@ -526,8 +525,8 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
|> selectList "asOfDate" m.asOfDate [ _required ] |> 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 [] [ p [] [
rawText "** " rawText "** "

View File

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

View File

@@ -30,17 +30,15 @@ module String =
/// string.Replace() /// string.Replace()
let replace (find : string) repl (str : string) = str.Replace (find, repl) 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 /// Replace the first occurrence of a string with a second string within a given string
let replaceFirst (needle : string) replacement (haystack : string) = let replaceFirst (needle : string) replacement (haystack : string) =
match haystack.IndexOf needle with match haystack.IndexOf needle with
| -1 -> haystack | -1 -> haystack
| idx -> | idx ->
seq { [ haystack.[0..idx - 1]
yield haystack.[0..idx - 1] replacement
yield replacement haystack.[idx + needle.Length..]
yield haystack.[idx + needle.Length..] ]
}
|> String.concat "" |> String.concat ""
@@ -56,9 +54,9 @@ let stripTags allowedTags input =
|> List.fold |> List.fold
(fun acc t -> (fun acc t ->
acc acc
|| htmlTag.IndexOf (sprintf "<%s>" t) = 0 || htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf (sprintf "<%s " t) = 0 || htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf (sprintf "</%s" t) = 0) false || htmlTag.IndexOf $"</{t}" = 0) false
match isAllowed with match isAllowed with
| true -> () | true -> ()
| false -> output <- String.replaceFirst tag.Value "" output | false -> output <- String.replaceFirst tag.Value "" output
@@ -202,7 +200,7 @@ module Help =
/// Help link for user password change page /// Help link for user password change page
let changePassword = "user/password" let changePassword = "user/password"
/// Create a full link for a help page /// 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 /// This class serves as a common anchor for resources
type Common () = type Common () =

View File

@@ -25,16 +25,16 @@ module ReferenceList =
| HtmlFormat -> s.["HTML Format"].Value | HtmlFormat -> s.["HTML Format"].Value
| PlainTextFormat -> s.["Plain-Text Format"].Value | PlainTextFormat -> s.["Plain-Text Format"].Value
seq { seq {
yield "", LocalizedString ("", sprintf "%s (%s)" s.["Group Default"].Value defaultType) "", LocalizedString ("", $"""{s.["Group Default"].Value} ({defaultType})""")
yield HtmlFormat.code, s.["HTML Format"] HtmlFormat.code, s.["HTML Format"]
yield PlainTextFormat.code, s.["Plain-Text Format"] PlainTextFormat.code, s.["Plain-Text Format"]
} }
/// A list of expiration options /// A list of expiration options
let expirationList (s : IStringLocalizer) includeExpireNow = let expirationList (s : IStringLocalizer) includeExpireNow =
[ yield Automatic.code, s.["Expire Normally"] [ Automatic.code, s.["Expire Normally"]
yield Manual.code, s.["Request Never Expires"] Manual.code, s.["Request Never Expires"]
match includeExpireNow with true -> yield Forced.code, s.["Expire Immediately"] | false -> () match includeExpireNow with true -> Forced.code, s.["Expire Immediately"] | false -> ()
] ]
/// A list of request types /// A list of request types
@@ -46,6 +46,7 @@ module ReferenceList =
Announcement, s.["Announcements"] Announcement, s.["Announcements"]
] ]
// fsharplint:disable RecordFieldNames MemberNames
/// This is used to create a message that is displayed to the user /// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
@@ -57,21 +58,21 @@ type UserMessage =
/// The description (further information) /// The description (further information)
description : HtmlString option description : HtmlString option
} }
with module UserMessage =
/// Error message template /// Error message template
static member Error = let error =
{ level = "ERROR" { level = "ERROR"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Warning message template /// Warning message template
static member Warning = let warning =
{ level = "WARNING" { level = "WARNING"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Info message template /// Info message template
static member Info = let info =
{ level = "Info" { level = "Info"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
@@ -98,9 +99,9 @@ type AppViewInfo =
/// The currently logged on small group, if there is one /// The currently logged on small group, if there is one
group : SmallGroup option group : SmallGroup option
} }
with module AppViewInfo =
/// A fresh version that can be populated to process the current request /// A fresh version that can be populated to process the current request
static member fresh = let fresh =
{ style = [] { style = []
script = [] script = []
helpLink = None helpLink = None
@@ -139,9 +140,9 @@ type AssignGroups =
/// The Ids of the small groups to which the user is authorized /// The Ids of the small groups to which the user is authorized
smallGroups : string smallGroups : string
} }
with module AssignGroups =
/// Create an instance of this form from an existing user /// Create an instance of this form from an existing user
static member fromUser (u : User) = let fromUser (u : User) =
{ userId = u.userId { userId = u.userId
userName = u.fullName userName = u.fullName
smallGroups = "" smallGroups = ""
@@ -177,24 +178,6 @@ type EditChurch =
interfaceAddress : string option interfaceAddress : string option
} }
with 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? /// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId member this.isNew () = Guid.Empty = this.churchId
/// Populate a church from this form /// Populate a church from this form
@@ -206,6 +189,25 @@ with
hasInterface = match this.hasInterface with Some x -> x | None -> false hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
} }
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 /// Form for adding/editing small group members
@@ -221,22 +223,23 @@ type EditMember =
emailType : string emailType : string
} }
with with
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
module EditMember =
/// Create an instance from an existing member /// Create an instance from an existing member
static member fromMember (m : Member) = let fromMember (m : Member) =
{ memberId = m.memberId { memberId = m.memberId
memberName = m.memberName memberName = m.memberName
emailAddress = m.email emailAddress = m.email
emailType = match m.format with Some f -> f | None -> "" emailType = match m.format with Some f -> f | None -> ""
} }
/// An empty instance /// An empty instance
static member empty = let empty =
{ memberId = Guid.Empty { memberId = Guid.Empty
memberName = "" memberName = ""
emailAddress = "" emailAddress = ""
emailType = "" emailType = ""
} }
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
/// This form allows the user to set class preferences /// This form allows the user to set class preferences
@@ -282,32 +285,6 @@ type EditPreferences =
asOfDate : string asOfDate : string
} }
with 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 /// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) = member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw = let isPublic, grpPw =
@@ -335,6 +312,34 @@ with
pageSize = this.pageSize pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate 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 /// Form for adding or editing prayer requests
@@ -357,8 +362,11 @@ type EditRequest =
text : string text : string
} }
with with
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
module EditRequest =
/// An empty instance to use for new requests /// An empty instance to use for new requests
static member empty = let empty =
{ requestId = Guid.Empty { requestId = Guid.Empty
requestType = CurrentRequest.code requestType = CurrentRequest.code
enteredDate = None enteredDate = None
@@ -368,16 +376,14 @@ with
text = "" text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
static member fromRequest req = let fromRequest req =
{ EditRequest.empty with { empty with
requestId = req.prayerRequestId requestId = req.prayerRequestId
requestType = req.requestType.code requestType = req.requestType.code
requestor = req.requestor requestor = req.requestor
expiration = req.expiration.code expiration = req.expiration.code
text = req.text text = req.text
} }
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
/// Form for the admin-level editing of small groups /// Form for the admin-level editing of small groups
@@ -391,18 +397,6 @@ type EditSmallGroup =
churchId : ChurchId churchId : ChurchId
} }
with 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? /// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId member this.isNew () = Guid.Empty = this.smallGroupId
/// Populate a small group from this form /// Populate a small group from this form
@@ -411,6 +405,19 @@ with
name = this.name name = this.name
churchId = this.churchId 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 /// Form for the user edit page
@@ -432,25 +439,6 @@ type EditUser =
isAdmin : bool option isAdmin : bool option
} }
with 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? /// Is this a new user?
member this.isNew () = Guid.Empty = this.userId member this.isNew () = Guid.Empty = this.userId
/// Populate a user from the form /// Populate a user from the form
@@ -462,8 +450,28 @@ with
isAdmin = match this.isAdmin with Some x -> x | None -> false isAdmin = match this.isAdmin with Some x -> x | None -> false
} }
|> function |> function
| u when this.password = null || this.password = "" -> u | u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password } | u -> { u with passwordHash = hasher this.password }
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 /// Form for the small group log on page
@@ -476,8 +484,9 @@ type GroupLogOn =
/// Whether to remember the login /// Whether to remember the login
rememberMe : bool option rememberMe : bool option
} }
with module GroupLogOn =
static member empty = /// An empty instance
let empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
password = "" password = ""
rememberMe = None rememberMe = None
@@ -498,8 +507,9 @@ type MaintainRequests =
/// The page number of the results /// The page number of the results
pageNbr : int option pageNbr : int option
} }
with module MaintainRequests =
static member empty = /// An empty instance
let empty =
{ requests = Seq.empty { requests = Seq.empty
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
onlyActive = None onlyActive = None
@@ -536,8 +546,9 @@ type UserLogOn =
/// The URL to which the user should be redirected once login is successful /// The URL to which the user should be redirected once login is successful
redirectUrl : string option redirectUrl : string option
} }
with module UserLogOn =
static member empty = /// An empty instance
let empty =
{ emailAddress = "" { emailAddress = ""
password = "" password = ""
smallGroupId = Guid.Empty smallGroupId = Guid.Empty
@@ -583,18 +594,18 @@ with
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2) let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2)
[ match this.showHeader with [ match this.showHeader with
| true -> | true ->
yield div [ _style (sprintf "text-align:center;font-family:%s" prefs.listFonts) ] [ div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [
span [ _style (sprintf "font-size:%ipt;" prefs.headingFontSize) ] [ span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
strong [] [ str s.["Prayer Requests"].Value ] strong [] [ str s.["Prayer Requests"].Value ]
] ]
br [] br []
span [ _style (sprintf "font-size:%ipt;" prefs.textFontSize) ] [ span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
strong [] [ str this.listGroup.name ] strong [] [ str this.listGroup.name ]
br [] br []
str (this.date.ToString s.["MMMM d, yyyy"].Value) str (this.date.ToString s.["MMMM d, yyyy"].Value)
] ]
] ]
yield br [] br []
| false -> () | false -> ()
let typs = ReferenceList.requestTypeList s let typs = ReferenceList.requestTypeList s
for cat in for cat in
@@ -604,29 +615,26 @@ with
|> Seq.filter (fun c -> 0 < (this.requests |> List.filter (fun req -> req.requestType = c) |> List.length)) do |> Seq.filter (fun c -> 0 < (this.requests |> List.filter (fun req -> req.requestType = c) |> List.length)) do
let reqs = this.requestsInCategory cat let reqs = this.requestsInCategory cat
let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd
yield div [ _style "padding-left:10px;padding-bottom:.5em;" ] [ div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style (sprintf "font-family:%s;page-break-inside:avoid;" prefs.listFonts) ] [ table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [
tr [] [ 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;" 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;" ] [
prefs.headingFontSize prefs.headingColor prefs.lineColor prefs.lineColor) ] [
rawText "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; " rawText "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; "
] ]
] ]
] ]
] ]
yield
reqs reqs
|> List.map (fun req -> |> List.map (fun req ->
let bullet = match this.isNew req with true -> "circle" | false -> "disc" 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;" li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [
bullet prefs.listFonts prefs.textFontSize) ] [
match req.requestor with match req.requestor with
| Some rqstr when rqstr <> "" -> | Some rqstr when rqstr <> "" ->
yield strong [] [ str rqstr ] strong [] [ str rqstr ]
yield rawText " &mdash; " rawText " &mdash; "
| Some _ -> () | Some _ -> ()
| None -> () | None -> ()
yield rawText req.text rawText req.text
match prefs.asOfDateDisplay with match prefs.asOfDateDisplay with
| NoDisplay -> () | NoDisplay -> ()
| ShortDate | ShortDate
@@ -636,22 +644,22 @@ with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
yield i [ _style (sprintf "font-size:%.2fpt" asOfSize) ] [ i [ _style $"font-size:%.2f{asOfSize}pt" ] [
rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")" rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")"
] ]
]) ])
|> ul [] |> ul []
yield br [] br []
] ]
|> renderHtmlNodes |> renderHtmlNodes
/// Generate this list as plain text /// Generate this list as plain text
member this.asText (s : IStringLocalizer) = member this.asText (s : IStringLocalizer) =
seq { seq {
yield this.listGroup.name this.listGroup.name
yield s.["Prayer Requests"].Value s.["Prayer Requests"].Value
yield this.date.ToString s.["MMMM d, yyyy"].Value this.date.ToString s.["MMMM d, yyyy"].Value
yield " " " "
let typs = ReferenceList.requestTypeList s let typs = ReferenceList.requestTypeList s
for cat in for cat in
typs typs
@@ -661,13 +669,12 @@ with
let reqs = this.requestsInCategory cat let reqs = this.requestsInCategory cat
let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value
let dashes = String.replicate (typ.Length + 4) "-" let dashes = String.replicate (typ.Length + 4) "-"
yield dashes dashes
yield sprintf @" %s" (typ.ToUpper ()) $" {typ.ToUpper ()}"
yield dashes dashes
for req in reqs do for req in reqs do
let bullet = match this.isNew req with true -> "+" | false -> "-" let bullet = match this.isNew req with true -> "+" | false -> "-"
let requestor = match req.requestor with Some r -> sprintf "%s - " r | None -> "" let requestor = match req.requestor with Some r -> sprintf "%s - " r | None -> ""
yield
match this.listGroup.preferences.asOfDateDisplay with match this.listGroup.preferences.asOfDateDisplay with
| NoDisplay -> "" | NoDisplay -> ""
| _ -> | _ ->
@@ -676,9 +683,9 @@ with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
sprintf " (%s %s)" s.["as of"].Value dt $""" ({s.["as of"].Value} {dt})"""
|> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text) |> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text)
yield " " " "
} }
|> String.concat "\n" |> String.concat "\n"
|> wordWrap 74 |> wordWrap 74

View File

@@ -1,7 +1,7 @@
 
Microsoft Visual Studio Solution File, Format Version 12.00 Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 15 # Visual Studio Version 16
VisualStudioVersion = 15.0.26228.4 VisualStudioVersion = 16.0.29411.108
MinimumVisualStudioVersion = 10.0.40219.1 MinimumVisualStudioVersion = 10.0.40219.1
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTracker\PrayerTracker.fsproj", "{63780D3F-D811-4BFB-9FB0-C28A83CCE28F}" Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTracker\PrayerTracker.fsproj", "{63780D3F-D811-4BFB-9FB0-C28A83CCE28F}"
EndProject EndProject
@@ -11,6 +11,12 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "Pray
EndProject EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "PrayerTracker.Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}" Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "PrayerTracker.Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}"
EndProject 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
global.json = global.json
EndProjectSection
EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU 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

@@ -15,6 +15,7 @@ module Configure =
open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
@@ -25,7 +26,7 @@ module Configure =
let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) = let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .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() .AddEnvironmentVariables()
|> ignore |> ignore
@@ -55,18 +56,20 @@ module Configure =
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
svc.AddDbContext<AppDbContext>( svc.AddDbContext<AppDbContext>(
fun options -> fun options ->
options.UseNpgsql(config.GetConnectionString "PrayerTracker") |> ignore) options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore)
|> ignore |> ignore
/// Routes for PrayerTracker /// Routes for PrayerTracker
let webApp = let webApp =
router Handlers.CommonFunctions.fourOhFour [ router Handlers.CommonFunctions.fourOhFour [
// Traditional web app routes
subRoute"/web" [
GET [ GET [
subRoute "/church" [ subRoute "/church" [
route "es" Handlers.Church.maintain route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit routef "/%O/edit" Handlers.Church.edit
] ]
route "/class/logon" (redirectTo true "/small-group/log-on") route "/class/logon" (redirectTo true "/web/small-group/log-on")
routef "/error/%s" Handlers.Home.error routef "/error/%s" Handlers.Home.error
routef "/language/%s" Handlers.Home.language routef "/language/%s" Handlers.Home.language
subRoute "/legal" [ subRoute "/legal" [
@@ -80,7 +83,7 @@ module Configure =
route "s/inactive" (Handlers.PrayerRequest.maintain false) route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/lists" Handlers.PrayerRequest.lists route "s/lists" Handlers.PrayerRequest.lists
routef "s/%O/list" Handlers.PrayerRequest.list routef "s/%O/list" Handlers.PrayerRequest.list
route "s/maintain" (redirectTo true "/prayer-requests") route "s/maintain" (redirectTo true "/web/prayer-requests")
routef "s/print/%s" Handlers.PrayerRequest.print routef "s/print/%s" Handlers.PrayerRequest.print
route "s/view" (Handlers.PrayerRequest.view None) route "s/view" (Handlers.PrayerRequest.view None)
routef "s/view/%s" (Some >> Handlers.PrayerRequest.view) routef "s/view/%s" (Some >> Handlers.PrayerRequest.view)
@@ -95,7 +98,7 @@ module Configure =
routef "/%O/edit" Handlers.SmallGroup.edit routef "/%O/edit" Handlers.SmallGroup.edit
route "/log-on" (Handlers.SmallGroup.logOn None) route "/log-on" (Handlers.SmallGroup.logOn None)
routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn) routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn)
route "/logon" (redirectTo true "/small-group/log-on") route "/logon" (redirectTo true "/web/small-group/log-on")
routef "/member/%O/edit" Handlers.SmallGroup.editMember routef "/member/%O/edit" Handlers.SmallGroup.editMember
route "/members" Handlers.SmallGroup.members route "/members" Handlers.SmallGroup.members
route "/preferences" Handlers.SmallGroup.preferences route "/preferences" Handlers.SmallGroup.preferences
@@ -106,7 +109,7 @@ module Configure =
routef "/%O/edit" Handlers.User.edit routef "/%O/edit" Handlers.User.edit
routef "/%O/small-groups" Handlers.User.smallGroups routef "/%O/small-groups" Handlers.User.smallGroups
route "/log-on" Handlers.User.logOn route "/log-on" Handlers.User.logOn
route "/logon" (redirectTo true "/user/log-on") route "/logon" (redirectTo true "/web/user/log-on")
route "/password" Handlers.User.password route "/password" Handlers.User.password
] ]
route "/" Handlers.Home.homePage route "/" Handlers.Home.homePage
@@ -138,6 +141,9 @@ module Configure =
] ]
] ]
] ]
// Temp redirect to new URLs
route "/" (redirectTo false "/web/")
]
let errorHandler (ex : exn) (logger : ILogger) = let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
@@ -145,7 +151,7 @@ module Configure =
/// Configure logging /// Configure logging
let logging (log : ILoggingBuilder) = let logging (log : ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IHostingEnvironment> () let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> ()
match env.IsDevelopment () with match env.IsDevelopment () with
| true -> log | true -> log
| false -> log.AddFilter (fun l -> l > LogLevel.Information) | false -> log.AddFilter (fun l -> l > LogLevel.Information)
@@ -153,8 +159,7 @@ module Configure =
|> ignore |> ignore
let app (app : IApplicationBuilder) = let app (app : IApplicationBuilder) =
let env = app.ApplicationServices.GetRequiredService<IHostingEnvironment>() let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
let log = app.ApplicationServices.GetRequiredService<ILoggerFactory>()
(match env.IsDevelopment () with (match env.IsDevelopment () with
| true -> | true ->
app.UseDeveloperExceptionPage () app.UseDeveloperExceptionPage ()

View File

@@ -26,17 +26,16 @@ let delete churchId : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
let! _, stats = findStats db churchId let! _, stats = findStats db churchId
db.RemoveEntry ch db.RemoveEntry church
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
ch.name, stats.smallGroups, stats.prayerRequests, stats.users] church.name, stats.smallGroups, stats.prayerRequests, stats.users]
return! redirectTo false "/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -55,12 +54,11 @@ let edit churchId : HttpHandler =
|> renderHtml next ctx |> renderHtml next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.edit (EditChurch.fromChurch ch) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -71,17 +69,14 @@ let maintain : HttpHandler =
requireAccess [ Admin ] requireAccess [ Admin ]
>=> fun next ctx -> >=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let await = Async.AwaitTask >> Async.RunSynchronously
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! churches = db.AllChurches () let! churches = db.AllChurches ()
let! stats = let stats = churches |> List.map (fun c -> await (findStats db c.churchId))
churches
|> Seq.ofList
|> Seq.map (fun c -> findStats db c.churchId)
|> Task.WhenAll
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.maintain churches (stats |> Map.ofArray) ctx |> Views.Church.maintain churches (stats |> Map.ofList) ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@@ -92,8 +87,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditChurch> () match! ctx.TryBindFormAsync<EditChurch> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = let! church =
@@ -108,7 +102,7 @@ let save : HttpHandler =
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower () let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name] addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
return! redirectTo false "/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }

View File

@@ -24,7 +24,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
[ match withDefault with [ match withDefault with
| true -> | true ->
let s = PrayerTracker.Views.I18N.localizer.Force () 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)) yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
] ]
@@ -41,15 +41,15 @@ let toSelectListWithDefault<'T> valFunc textFunc (items : 'T seq) =
let appVersion = let appVersion =
let v = Assembly.GetExecutingAssembly().GetName().Version let v = Assembly.GetExecutingAssembly().GetName().Version
#if (DEBUG) #if (DEBUG)
sprintf "v%A" v $"v{v}"
#else #else
seq { seq {
yield sprintf "v%d" v.Major $"v%d{v.Major}"
match v.Minor with 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 $".%d{v.Minor}"
match v.Build with 0 -> () | _ -> yield sprintf ".%d" v.Build match v.Build with 0 -> () | _ -> $".%d{v.Build}"
} }
|> String.concat "" |> String.concat ""
#endif #endif
@@ -142,19 +142,19 @@ let htmlString (x : LocalizedString) =
/// Add an error message to the session /// Add an error message to the session
let addError ctx msg = let addError ctx msg =
addUserMessage ctx { UserMessage.Error with text = htmlLocString msg } addUserMessage ctx { UserMessage.error with text = htmlLocString msg }
/// Add an informational message to the session /// Add an informational message to the session
let addInfo ctx msg = let addInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlLocString msg } addUserMessage ctx { UserMessage.info with text = htmlLocString msg }
/// Add an informational HTML message to the session /// Add an informational HTML message to the session
let addHtmlInfo ctx msg = let addHtmlInfo ctx msg =
addUserMessage ctx { UserMessage.Info with text = htmlString msg } addUserMessage ctx { UserMessage.info with text = htmlString msg }
/// Add a warning message to the session /// Add a warning message to the session
let addWarning ctx msg = let addWarning ctx msg =
addUserMessage ctx { UserMessage.Warning with text = htmlLocString msg } addUserMessage ctx { UserMessage.warning with text = htmlLocString msg }
/// A level of required access /// A level of required access
@@ -256,17 +256,17 @@ let requireAccess level : HttpHandler =
| false -> | false ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."] addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
| _ when level |> List.contains User -> | _ when level |> List.contains User ->
// Redirect to the user log on page // Redirect to the user log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ()) ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/user/log-on" next ctx return! redirectTo false "/web/user/log-on" next ctx
| _ when level |> List.contains Group -> | _ when level |> List.contains Group ->
// Redirect to the small group log on page // Redirect to the small group log on page
ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ()) ctx.Session.SetString (Key.Session.redirectUrl, ctx.Request.GetEncodedUrl ())
return! redirectTo false "/small-group/log-on" next ctx return! redirectTo false "/web/small-group/log-on" next ctx
| _ -> | _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."] addError ctx s.["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
} }

View File

@@ -121,7 +121,7 @@ type UserCookie =
/// Create a salted hash to use to validate the idle timeout key /// Create a salted hash to use to validate the idle timeout key
let saltedTimeoutHash (c : TimeoutCookie) = 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 /// Cookie options to push an expiration out by 100 days
let autoRefresh = let autoRefresh =

View File

@@ -8,10 +8,9 @@ open Microsoft.Extensions.Localization
open MimeKit open MimeKit
open MimeKit.Text open MimeKit.Text
open PrayerTracker.Entities open PrayerTracker.Entities
open System
/// The e-mail address from which e-mail is sent (must match Google account) /// The e-mail address from which e-mail is sent
let private fromAddress = "prayer@djs-consulting.com" let private fromAddress = "prayer@bitbadger.solutions"
/// Get an SMTP client connection /// Get an SMTP client connection
// FIXME: make host configurable // FIXME: make host configurable
@@ -33,9 +32,9 @@ let createMessage (grp : SmallGroup) subj =
/// Create an HTML-format e-mail message /// Create an HTML-format e-mail message
let createHtmlMessage grp subj body (s : IStringLocalizer) = let createHtmlMessage grp subj body (s : IStringLocalizer) =
let bodyText = 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 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 s.["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>" "<br><small>"
s.["from Bit Badger Solutions"].Value s.["from Bit Badger Solutions"].Value

View File

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

View File

@@ -13,13 +13,12 @@ open System.Threading.Tasks
/// Retrieve a prayer request, and ensure that it belongs to the current class /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = let private findRequest (ctx : HttpContext) reqId =
task { task {
let! req = ctx.dbContext().TryRequestById reqId match! ctx.dbContext().TryRequestById reqId with
match req with | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
| Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"] addError ctx s.["The prayer request you tried to access is not assigned to your group"]
return Error (redirectTo false "/unauthorized") return Error (redirectTo false "/web/unauthorized")
| None -> return Error fourOhFour | None -> return Error fourOhFour
} }
@@ -62,13 +61,12 @@ let edit (reqId : PrayerRequestId) : HttpHandler =
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with match req.isExpired now grp.preferences.daysToExpire with
| true -> | true ->
{ UserMessage.Warning with { UserMessage.warning with
text = htmlLocString s.["This request is expired."] text = htmlLocString s.["This request is expired."]
description = description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
@@ -113,15 +111,14 @@ let delete reqId : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.PrayerRequests.Remove r |> ignore db.PrayerRequests.Remove req |> ignore
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"] addInfo ctx s.["The prayer request was deleted successfully"]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
@@ -131,15 +128,14 @@ let expire reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with expiration = Forced } db.UpdateEntry { req with expiration = Forced }
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
@@ -151,17 +147,16 @@ let list groupId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp when grp.preferences.isPublic ->
| Some g when g.preferences.isPublic ->
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let reqs = db.AllRequestsForSmallGroup g clock None true 0 let reqs = db.AllRequestsForSmallGroup grp clock None true 0
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ requests = List.ofSeq reqs { requests = List.ofSeq reqs
date = g.localDateNow clock date = grp.localDateNow clock
listGroup = g listGroup = grp
showHeader = true showHeader = true
canEmail = (tryCurrentUser >> Option.isSome) ctx canEmail = (tryCurrentUser >> Option.isSome) ctx
recipients = [] recipients = []
@@ -170,7 +165,7 @@ let list groupId : HttpHandler =
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The request list for the group you tried to view is not public."] addError ctx s.["The request list for the group you tried to view is not public."]
return! redirectTo false "/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -242,15 +237,14 @@ let restore reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with expiration = Automatic; updatedDate = DateTime.Now } db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
@@ -261,8 +255,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditRequest> () match! ctx.TryBindFormAsync<EditRequest> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! req = let! req =
@@ -274,7 +267,7 @@ let save : HttpHandler =
let upd8 = let upd8 =
{ pr with { pr with
requestType = PrayerRequestType.fromCode m.requestType requestType = PrayerRequestType.fromCode m.requestType
requestor = m.requestor requestor = match m.requestor with Some x when x.Trim () = "" -> None | x -> x
text = ckEditorToText m.text text = ckEditorToText m.text
expiration = Expiration.fromCode m.expiration expiration = Expiration.fromCode m.expiration
} }
@@ -296,7 +289,7 @@ let save : HttpHandler =
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = match m.isNew () with true -> "Added" | false -> "Updated" let act = match m.isNew () with true -> "Added" | false -> "Updated"
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }

View File

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

View File

@@ -16,7 +16,7 @@ open System.Threading.Tasks
/// Set a small group "Remember Me" cookie /// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash = let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), autoRefresh) (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh)
/// GET /small-group/announcement /// GET /small-group/announcement
@@ -37,17 +37,16 @@ let delete groupId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
let! reqs = db.CountRequestsBySmallGroup groupId let! reqs = db.CountRequestsBySmallGroup groupId
let! usrs = db.CountUsersBySmallGroup groupId let! usrs = db.CountUsersBySmallGroup groupId
db.RemoveEntry g db.RemoveEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
g.name, reqs, usrs] grp.name, reqs, usrs]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -60,13 +59,12 @@ let deleteMember memberId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
| Some m when m.smallGroupId = (currentGroup ctx).smallGroupId -> db.RemoveEntry mbr
db.RemoveEntry m
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", m.memberName] addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -87,12 +85,11 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@@ -115,12 +112,11 @@ let editMember (memberId : MemberId) : HttpHandler =
|> Views.SmallGroup.editMember EditMember.empty typs ctx |> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
| Some m when m.smallGroupId = grp.smallGroupId ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@@ -148,22 +144,20 @@ let logOnSubmit : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<GroupLogOn> () match! ctx.TryBindFormAsync<GroupLogOn> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password match! ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password with
match grp with | Some grp ->
| Some _ -> (Some >> ctx.Session.SetSmallGroup) grp
ctx.Session.SetSmallGroup grp
match m.rememberMe with 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"]] 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 -> | None ->
addError ctx s.["Password incorrect - login unsuccessful"] 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 | Error e -> return! bindError e next ctx
} }
@@ -251,26 +245,25 @@ let save : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! result = ctx.TryBindFormAsync<EditSmallGroup> () match! ctx.TryBindFormAsync<EditSmallGroup> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! grp = let! group =
match m.isNew () with match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) | true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| false -> db.TryGroupById m.smallGroupId | false -> db.TryGroupById m.smallGroupId
match grp with match group with
| Some g -> | Some grp ->
m.populateGroup g m.populateGroup grp
|> function |> function
| g when m.isNew () -> | grp when m.isNew () ->
db.AddEntry g db.AddEntry grp
db.AddEntry { g.preferences with smallGroupId = g.smallGroupId } db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| g -> db.UpdateEntry g | grp -> db.UpdateEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name] addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -282,8 +275,7 @@ let saveMember : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditMember> () match! ctx.TryBindFormAsync<EditMember> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let db = ctx.dbContext () let db = ctx.dbContext ()
@@ -309,7 +301,7 @@ let saveMember : HttpHandler =
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} group member", act] addInfo ctx s.["Successfully {0} group member", act]
return! redirectTo false "/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
@@ -322,24 +314,22 @@ let savePreferences : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditPreferences> () match! ctx.TryBindFormAsync<EditPreferences> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that // 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 // 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. // the database values, not the then out-of-sync session ones.
let! grp = db.TryGroupById (currentGroup ctx).smallGroupId match! db.TryGroupById (currentGroup ctx).smallGroupId with
match grp with | Some grp ->
| Some g -> let prefs = m.populatePreferences grp.preferences
let prefs = m.populatePreferences g.preferences
db.UpdateEntry prefs db.UpdateEntry prefs
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
// Refresh session instance // Refresh session instance
ctx.Session.SetSmallGroup <| Some { g with preferences = prefs } ctx.Session.SetSmallGroup <| Some { grp with preferences = prefs }
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Group preferences updated successfully"] addInfo ctx s.["Group preferences updated successfully"]
return! redirectTo false "/small-group/preferences" next ctx return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -352,8 +342,7 @@ let sendAnnouncement : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task { task {
let! result = ctx.TryBindFormAsync<Announcement> () match! ctx.TryBindFormAsync<Announcement> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let usr = currentUser ctx let usr = currentUser ctx
@@ -363,7 +352,7 @@ let sendAnnouncement : HttpHandler =
// Reformat the text to use the class's font stylings // Reformat the text to use the class's font stylings
let requestText = ckEditorToText m.text let requestText = ckEditorToText m.text
let htmlText = let htmlText =
p [ _style (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 ] [ rawText requestText ]
|> renderHtmlNode |> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText

View File

@@ -18,7 +18,7 @@ open System.Threading.Tasks
let private setUserCookie (ctx : HttpContext) pwHash = let private setUserCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ( ctx.Response.Cookies.Append (
Key.Cookie.user, Key.Cookie.user,
{ Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), { Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (),
autoRefresh) autoRefresh)
/// Retrieve a user from the database by password /// Retrieve a user from the database by password
@@ -26,18 +26,14 @@ let private setUserCookie (ctx : HttpContext) pwHash =
let private findUserByPassword m (db : AppDbContext) = let private findUserByPassword m (db : AppDbContext) =
task { task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
| Some u -> | Some u when Option.isSome u.salt ->
match u.salt with
| Some salt ->
// Already upgraded; match = success // Already upgraded; match = success
let pwHash = pbkdf2Hash salt m.password let pwHash = pbkdf2Hash (Option.get u.salt) m.password
match u.passwordHash = pwHash with match u.passwordHash = pwHash with
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash | true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
| _ -> | Some u when u.passwordHash = sha1Hash m.password ->
// Not upgraded; check against old hash // Not upgraded, but password is good; upgrade 'em!
match u.passwordHash = sha1Hash m.password with
| true ->
// Upgrade 'em! // Upgrade 'em!
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password let pwHash = pbkdf2Hash salt m.password
@@ -46,7 +42,6 @@ let private findUserByPassword m (db : AppDbContext) =
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
| _ -> return None, ""
} }
@@ -56,8 +51,7 @@ let changePassword : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<ChangePassword> () match! ctx.TryBindFormAsync<ChangePassword> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let db = ctx.dbContext () let db = ctx.dbContext ()
@@ -84,13 +78,13 @@ let changePassword : HttpHandler =
| _ -> () | _ -> ()
addInfo ctx s.["Your password was changed successfully"] addInfo ctx s.["Your password was changed successfully"]
| None -> addError ctx s.["Unable to change password"] | None -> addError ctx s.["Unable to change password"]
return! redirectTo false "/" next ctx return! redirectTo false "/web/" next ctx
| Some _ -> | Some _ ->
addError ctx s.["The new passwords did not match - your password was NOT changed"] addError ctx s.["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx return! redirectTo false "/web/user/password" next ctx
| None -> | None ->
addError ctx s.["The old password was incorrect - your password was NOT changed"] addError ctx s.["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx return! redirectTo false "/web/user/password" next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -102,14 +96,13 @@ let delete userId : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserById userId match! db.TryUserById userId with
match user with | Some user ->
| Some u -> db.RemoveEntry user
db.RemoveEntry u
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Successfully deleted user {0}", u.fullName] addInfo ctx s.["Successfully deleted user {0}", user.fullName]
return! redirectTo false "/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@@ -120,8 +113,7 @@ let doLogOn : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<UserLogOn> () match! ctx.TryBindFormAsync<UserLogOn> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@@ -135,12 +127,12 @@ let doLogOn : HttpHandler =
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> () match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
addHtmlInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]] addHtmlInfo ctx s.["Log On Successful Welcome to {0}", s.["PrayerTracker"]]
match m.redirectUrl with match m.redirectUrl with
| None -> "/small-group" | None -> "/web/small-group"
| Some x when x = "" -> "/small-group" | Some x when x = "" -> "/web/small-group"
| Some x -> x | Some x -> x
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.Error with { UserMessage.error with
text = htmlLocString s.["Invalid credentials - log on unsuccessful"] text = htmlLocString s.["Invalid credentials - log on unsuccessful"]
description = description =
[ s.["This is likely due to one of the following reasons"].Value [ s.["This is likely due to one of the following reasons"].Value
@@ -156,7 +148,7 @@ let doLogOn : HttpHandler =
|> (HtmlString >> Some) |> (HtmlString >> Some)
} }
|> addUserMessage ctx |> addUserMessage ctx
"/user/log-on" "/web/user/log-on"
return! redirectTo false nextUrl next ctx return! redirectTo false nextUrl next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -175,12 +167,11 @@ let edit (userId : UserId) : HttpHandler =
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! user = ctx.dbContext().TryUserById userId match! ctx.dbContext().TryUserById userId with
match user with | Some user ->
| Some u ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.edit (EditUser.fromUser u) ctx |> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@@ -236,8 +227,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditUser> () match! ctx.TryBindFormAsync<EditUser> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = let! user =
@@ -257,24 +247,25 @@ let save : HttpHandler =
| _ -> user | _ -> user
match saltedUser with match saltedUser with
| Some u -> | Some u ->
m.populateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry) updatedUser |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match m.isNew () with match m.isNew () with
| true -> | true ->
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.Info with { UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
description = description =
h s.[ "Please select at least one group for which this user ({0}) is authorized", u.fullName] h s.["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName]
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
return! redirectTo false (sprintf "/user/%s/small-groups" (flatGuid u.userId)) next ctx return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx
| false -> | false ->
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()] addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()]
return! redirectTo false "/users" next ctx return! redirectTo false "/web/users" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -286,35 +277,33 @@ let saveGroups : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<AssignGroups> () match! ctx.TryBindFormAsync<AssignGroups> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with match Seq.length m.smallGroups with
| 0 -> | 0 ->
addError ctx s.["You must select at least one group to assign"] addError ctx s.["You must select at least one group to assign"]
return! redirectTo false (sprintf "/user/%s/small-groups" (flatGuid m.userId)) next ctx return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserByIdWithGroups m.userId match! db.TryUserByIdWithGroups m.userId with
match user with | Some user ->
| Some u ->
let grps = let grps =
m.smallGroups.Split ',' m.smallGroups.Split ','
|> Array.map Guid.Parse |> Array.map Guid.Parse
|> List.ofArray |> List.ofArray
u.smallGroups user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId))) |> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> db.UserGroupXref.RemoveRange |> db.UserGroupXref.RemoveRange
grps grps
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x }) |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq |> List.ofSeq
|> List.iter db.AddEntry |> List.iter db.AddEntry
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName] addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
return! redirectTo false "/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
@@ -327,14 +316,13 @@ let smallGroups userId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! user = db.TryUserByIdWithGroups userId match! db.TryUserByIdWithGroups userId with
match user with | Some user ->
| Some u ->
let! grps = db.GroupList () let! grps = db.GroupList ()
let curGroups = u.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour 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\net5.0\linux-x64\publish